Browse Source

Unwrap the ErrorT type in the SaslHandler type

master
Jon Kristensen 13 years ago
parent
commit
f5acd5843d
  1. 12
      source/Network/Xmpp/Sasl.hs
  2. 10
      source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs
  3. 10
      source/Network/Xmpp/Sasl/Mechanisms/Plain.hs
  4. 7
      source/Network/Xmpp/Sasl/Mechanisms/Scram.hs
  5. 2
      source/Network/Xmpp/Sasl/Types.hs

12
source/Network/Xmpp/Sasl.hs

@ -78,13 +78,13 @@ xmppSasl handlers = withStream $ do
cs <- gets streamState cs <- gets streamState
case cs of case cs of
Closed -> return . Left $ XmppNoStream Closed -> return . Left $ XmppNoStream
_ -> do _ -> runErrorT $ do
r <- runErrorT handler r <- ErrorT handler
case r of case r of
Left ae -> return $ Right $ Just ae Just ae -> return $ Just ae
Right a -> do Nothing -> do
_ <- runErrorT $ ErrorT restartStream _ <- ErrorT restartStream
return $ Right $ Nothing return Nothing
-- | Authenticate to the server using the first matching method and bind a -- | Authenticate to the server using the first matching method and bind a
-- resource. -- resource.

10
source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs

@ -127,6 +127,12 @@ digestMd5 :: Text -- ^ Authentication identity (authcid or username)
-> Maybe Text -- ^ Authorization identity (authzid) -> Maybe Text -- ^ Authorization identity (authzid)
-> Text -- ^ Password -> Text -- ^ Password
-> SaslHandler -> SaslHandler
digestMd5 authcid authzid password = ( "DIGEST-MD5" digestMd5 authcid authzid password =
, xmppDigestMd5 authcid authzid password ( "DIGEST-MD5"
, do
r <- runErrorT $ xmppDigestMd5 authcid authzid password
case r of
Left (AuthStreamFailure e) -> return $ Left e
Left e -> return $ Right $ Just e
Right () -> return $ Right Nothing
) )

10
source/Network/Xmpp/Sasl/Mechanisms/Plain.hs

@ -77,4 +77,12 @@ plain :: Text.Text -- ^ authentication ID (username)
-> Maybe Text.Text -- ^ authorization ID -> Maybe Text.Text -- ^ authorization ID
-> Text.Text -- ^ password -> Text.Text -- ^ password
-> SaslHandler -> SaslHandler
plain authcid authzid passwd = ("PLAIN", xmppPlain authcid authzid passwd) plain authcid authzid passwd =
( "PLAIN"
, do
r <- runErrorT $ xmppPlain authcid authzid passwd
case r of
Left (AuthStreamFailure e) -> return $ Left e
Left e -> return $ Right $ Just e
Right () -> return $ Right Nothing
)

7
source/Network/Xmpp/Sasl/Mechanisms/Scram.hs

@ -165,5 +165,10 @@ scramSha1 :: Text.Text -- ^ username
-> SaslHandler -> SaslHandler
scramSha1 authcid authzid passwd = scramSha1 authcid authzid passwd =
( "SCRAM-SHA-1" ( "SCRAM-SHA-1"
, scram (hashToken :: Crypto.SHA1) authcid authzid passwd , do
r <- runErrorT $ scram (hashToken :: Crypto.SHA1) authcid authzid passwd
case r of
Left (AuthStreamFailure e) -> return $ Left e
Left e -> return $ Right $ Just e
Right () -> return $ Right Nothing
) )

2
source/Network/Xmpp/Sasl/Types.hs

@ -34,4 +34,4 @@ type Pairs = [(ByteString, ByteString)]
-- | Tuple defining the SASL Handler's name, and a SASL mechanism computation. -- | Tuple defining the SASL Handler's name, and a SASL mechanism computation.
-- The SASL mechanism is a stateful @Stream@ computation, which has the -- The SASL mechanism is a stateful @Stream@ computation, which has the
-- possibility of resulting in an authentication error. -- possibility of resulting in an authentication error.
type SaslHandler = (Text.Text, ErrorT AuthFailure (StateT Stream IO) ()) type SaslHandler = (Text.Text, StateT Stream IO (Either XmppFailure (Maybe AuthFailure)))

Loading…
Cancel
Save