diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index 83c8947..3c9a233 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -165,7 +165,7 @@ auth :: Text.Text -- ^ The username -- assign one -> XmppConMonad (Either AuthError Text.Text) auth username passwd resource = runErrorT $ do - ErrorT $ xmppSASL [DIGEST_MD5Credentials Nothing username passwd] + ErrorT $ xmppSasl [DigestMD5Credentials Nothing username passwd] res <- lift $ xmppBind resource lift $ xmppStartSession return res diff --git a/source/Network/Xmpp/Sasl.hs b/source/Network/Xmpp/Sasl.hs index 569d2f3..14a77ec 100644 --- a/source/Network/Xmpp/Sasl.hs +++ b/source/Network/Xmpp/Sasl.hs @@ -39,29 +39,29 @@ import Network.Xmpp.Sasl.Types -- XmppConMonad state with non-password credentials and restarts the stream upon -- success. This computation wraps an ErrorT computation, which means that -- catchError can be used to catch any errors. -xmppSASL :: [SASLCredentials] -- ^ Acceptable authentication mechanisms and +xmppSasl :: [SaslCredentials] -- ^ Acceptable authentication mechanisms and -- their corresponding credentials -> XmppConMonad (Either AuthError ()) -xmppSASL creds = runErrorT $ do +xmppSasl creds = runErrorT $ do -- Chooses the first mechanism that is acceptable by both the client and the -- server. mechanisms <- gets $ saslMechanisms . sFeatures let cred = L.find (\cred -> credsToName cred `elem` mechanisms) creds unless (isJust cred) (throwError $ AuthMechanismError mechanisms) case fromJust cred of - DIGEST_MD5Credentials authzid authcid passwd -> ErrorT $ xmppDigestMD5 + DigestMD5Credentials authzid authcid passwd -> ErrorT $ xmppDigestMD5 authzid authcid passwd - PLAINCredentials authzid authcid passwd -> ErrorT $ xmppPLAIN + PlainCredentials authzid authcid passwd -> ErrorT $ xmppPLAIN authzid authcid passwd - _ -> error "xmppSASL: Mechanism not caught" + _ -> error "xmppSasl: Mechanism not caught" where -- Converts the credentials to the appropriate mechanism name, corresponding to -- the XMPP mechanism attribute. - credsToName :: SASLCredentials -> Text - credsToName (DIGEST_MD5Credentials _ _ _) = "DIGEST-MD5" - credsToName (PLAINCredentials _ _ _) = "PLAIN" + credsToName :: SaslCredentials -> Text + credsToName (DigestMD5Credentials _ _ _) = "DIGEST-MD5" + credsToName (PlainCredentials _ _ _) = "PLAIN" credsToName c = error $ "credsToName failed for " ++ (show c) \ No newline at end of file diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 4be0af5..f7d278e 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -22,8 +22,8 @@ module Network.Xmpp.Types , PresenceType(..) , SaslError(..) , SaslFailure(..) - , SASLMechanism (..) - , SASLCredentials (..) + , SaslMechanism (..) + , SaslCredentials (..) , ServerFeatures(..) , Stanza(..) , StanzaError(..) @@ -402,18 +402,18 @@ instance Read StanzaErrorCondition where -- OTHER STUFF -- ============================================================================= -data SASLCredentials = DIGEST_MD5Credentials (Maybe Text) Text Text - | PLAINCredentials (Maybe Text) Text Text +data SaslCredentials = DigestMD5Credentials (Maybe Text) Text Text + | PlainCredentials (Maybe Text) Text Text -instance Show SASLCredentials where - show (DIGEST_MD5Credentials authzid authcid _) = "DIGEST_MD5Credentials " ++ +instance Show SaslCredentials where + show (DigestMD5Credentials authzid authcid _) = "DIGEST_MD5Credentials " ++ (Text.unpack $ fromMaybe "" authzid) ++ " " ++ (Text.unpack authcid) ++ " (password hidden)" - show (PLAINCredentials authzid authcid _) = "PLAINCredentials " ++ + show (PlainCredentials authzid authcid _) = "PLAINCredentials " ++ (Text.unpack $ fromMaybe "" authzid) ++ " " ++ (Text.unpack authcid) ++ " (password hidden)" -data SASLMechanism = DIGEST_MD5 deriving Show +data SaslMechanism = DigestMD5 deriving Show data SaslFailure = SaslFailure { saslFailureCondition :: SaslError , saslFailureText :: Maybe ( Maybe LangTag