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

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

@ -127,6 +127,12 @@ digestMd5 :: Text -- ^ Authentication identity (authcid or username) @@ -127,6 +127,12 @@ digestMd5 :: Text -- ^ Authentication identity (authcid or username)
-> Maybe Text -- ^ Authorization identity (authzid)
-> Text -- ^ Password
-> SaslHandler
digestMd5 authcid authzid password = ( "DIGEST-MD5"
, xmppDigestMd5 authcid authzid password
digestMd5 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) @@ -77,4 +77,12 @@ plain :: Text.Text -- ^ authentication ID (username)
-> Maybe Text.Text -- ^ authorization ID
-> Text.Text -- ^ password
-> 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
)

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

@ -164,6 +164,11 @@ scramSha1 :: Text.Text -- ^ username @@ -164,6 +164,11 @@ scramSha1 :: Text.Text -- ^ username
-> Text.Text -- ^ password
-> SaslHandler
scramSha1 authcid authzid passwd =
("SCRAM-SHA-1"
, scram (hashToken :: Crypto.SHA1) authcid authzid passwd
( "SCRAM-SHA-1"
, 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)] @@ -34,4 +34,4 @@ type Pairs = [(ByteString, ByteString)]
-- | Tuple defining the SASL Handler's name, and a SASL mechanism computation.
-- The SASL mechanism is a stateful @Stream@ computation, which has the
-- 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