Browse Source

rename more occurences of DIGEST_MD5 and PLAIN to DigestMD5 and Plain respectively

master
Philipp Balzarek 14 years ago
parent
commit
97b08fa277
  1. 2
      source/Network/Xmpp.hs
  2. 16
      source/Network/Xmpp/Sasl.hs
  3. 16
      source/Network/Xmpp/Types.hs

2
source/Network/Xmpp.hs

@ -165,7 +165,7 @@ auth :: Text.Text -- ^ The username
-- assign one -- assign one
-> XmppConMonad (Either AuthError Text.Text) -> XmppConMonad (Either AuthError Text.Text)
auth username passwd resource = runErrorT $ do auth username passwd resource = runErrorT $ do
ErrorT $ xmppSASL [DIGEST_MD5Credentials Nothing username passwd] ErrorT $ xmppSasl [DigestMD5Credentials Nothing username passwd]
res <- lift $ xmppBind resource res <- lift $ xmppBind resource
lift $ xmppStartSession lift $ xmppStartSession
return res return res

16
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 -- XmppConMonad state with non-password credentials and restarts the stream upon
-- success. This computation wraps an ErrorT computation, which means that -- success. This computation wraps an ErrorT computation, which means that
-- catchError can be used to catch any errors. -- catchError can be used to catch any errors.
xmppSASL :: [SASLCredentials] -- ^ Acceptable authentication mechanisms and xmppSasl :: [SaslCredentials] -- ^ Acceptable authentication mechanisms and
-- their corresponding credentials -- their corresponding credentials
-> XmppConMonad (Either AuthError ()) -> XmppConMonad (Either AuthError ())
xmppSASL creds = runErrorT $ do xmppSasl creds = runErrorT $ do
-- Chooses the first mechanism that is acceptable by both the client and the -- Chooses the first mechanism that is acceptable by both the client and the
-- server. -- server.
mechanisms <- gets $ saslMechanisms . sFeatures mechanisms <- gets $ saslMechanisms . sFeatures
let cred = L.find (\cred -> credsToName cred `elem` mechanisms) creds let cred = L.find (\cred -> credsToName cred `elem` mechanisms) creds
unless (isJust cred) (throwError $ AuthMechanismError mechanisms) unless (isJust cred) (throwError $ AuthMechanismError mechanisms)
case fromJust cred of case fromJust cred of
DIGEST_MD5Credentials authzid authcid passwd -> ErrorT $ xmppDigestMD5 DigestMD5Credentials authzid authcid passwd -> ErrorT $ xmppDigestMD5
authzid authzid
authcid authcid
passwd passwd
PLAINCredentials authzid authcid passwd -> ErrorT $ xmppPLAIN PlainCredentials authzid authcid passwd -> ErrorT $ xmppPLAIN
authzid authzid
authcid authcid
passwd passwd
_ -> error "xmppSASL: Mechanism not caught" _ -> error "xmppSasl: Mechanism not caught"
where where
-- Converts the credentials to the appropriate mechanism name, corresponding to -- Converts the credentials to the appropriate mechanism name, corresponding to
-- the XMPP mechanism attribute. -- the XMPP mechanism attribute.
credsToName :: SASLCredentials -> Text credsToName :: SaslCredentials -> Text
credsToName (DIGEST_MD5Credentials _ _ _) = "DIGEST-MD5" credsToName (DigestMD5Credentials _ _ _) = "DIGEST-MD5"
credsToName (PLAINCredentials _ _ _) = "PLAIN" credsToName (PlainCredentials _ _ _) = "PLAIN"
credsToName c = error $ "credsToName failed for " ++ (show c) credsToName c = error $ "credsToName failed for " ++ (show c)

16
source/Network/Xmpp/Types.hs

@ -22,8 +22,8 @@ module Network.Xmpp.Types
, PresenceType(..) , PresenceType(..)
, SaslError(..) , SaslError(..)
, SaslFailure(..) , SaslFailure(..)
, SASLMechanism (..) , SaslMechanism (..)
, SASLCredentials (..) , SaslCredentials (..)
, ServerFeatures(..) , ServerFeatures(..)
, Stanza(..) , Stanza(..)
, StanzaError(..) , StanzaError(..)
@ -402,18 +402,18 @@ instance Read StanzaErrorCondition where
-- OTHER STUFF -- OTHER STUFF
-- ============================================================================= -- =============================================================================
data SASLCredentials = DIGEST_MD5Credentials (Maybe Text) Text Text data SaslCredentials = DigestMD5Credentials (Maybe Text) Text Text
| PLAINCredentials (Maybe Text) Text Text | PlainCredentials (Maybe Text) Text Text
instance Show SASLCredentials where instance Show SaslCredentials where
show (DIGEST_MD5Credentials authzid authcid _) = "DIGEST_MD5Credentials " ++ show (DigestMD5Credentials authzid authcid _) = "DIGEST_MD5Credentials " ++
(Text.unpack $ fromMaybe "" authzid) ++ " " ++ (Text.unpack authcid) ++ (Text.unpack $ fromMaybe "" authzid) ++ " " ++ (Text.unpack authcid) ++
" (password hidden)" " (password hidden)"
show (PLAINCredentials authzid authcid _) = "PLAINCredentials " ++ show (PlainCredentials authzid authcid _) = "PLAINCredentials " ++
(Text.unpack $ fromMaybe "" authzid) ++ " " ++ (Text.unpack authcid) ++ (Text.unpack $ fromMaybe "" authzid) ++ " " ++ (Text.unpack authcid) ++
" (password hidden)" " (password hidden)"
data SASLMechanism = DIGEST_MD5 deriving Show data SaslMechanism = DigestMD5 deriving Show
data SaslFailure = SaslFailure { saslFailureCondition :: SaslError data SaslFailure = SaslFailure { saslFailureCondition :: SaslError
, saslFailureText :: Maybe ( Maybe LangTag , saslFailureText :: Maybe ( Maybe LangTag

Loading…
Cancel
Save