Remove SaslM

While short, I do believe that `SaslM' type makes the code
significantly less understandable. This is at least the case for me.
This patch removes it and changes the types to read the full `ErrorT
AuthFailure (StateT Stream IO) a' type instead.

source/Network/Xmpp/Internal.hs

@@ -31,7 +31,6 @@ module Network.Xmpp.Internal
   , pickleElem
   , unpickleElem
   , xpLangTag
-  , SaslM(..)
   , SaslHandler(..)
   , prepCredentials
   , saslInit

source/Network/Xmpp/Sasl/Common.hs

@@ -29,7 +29,9 @@ import           Network.Xmpp.Marshal
 
 import qualified System.Random as Random
 
---makeNonce :: SaslM BS.ByteString
+import           Control.Monad.State.Strict
+
+--makeNonce :: ErrorT AuthFailure (StateT Stream IO) BS.ByteString
 makeNonce :: IO BS.ByteString
 makeNonce = do
     g <- liftIO Random.newStdGen
@@ -106,7 +108,7 @@ xpSaslElement = xpAlt saslSel
 quote :: BS.ByteString -> BS.ByteString
 quote x = BS.concat ["\"",x,"\""]
 
-saslInit :: Text.Text -> Maybe BS.ByteString -> SaslM Bool
+saslInit :: Text.Text -> Maybe BS.ByteString -> ErrorT AuthFailure (StateT Stream IO) Bool
 saslInit mechanism payload = do
     r <- lift . pushElement . saslInitE mechanism $
         Text.decodeUtf8 . B64.encode <$> payload
@@ -115,7 +117,7 @@ saslInit mechanism payload = do
         Right b -> return b
 
 -- | Pull the next element.
-pullSaslElement :: SaslM SaslElement
+pullSaslElement :: ErrorT AuthFailure (StateT Stream IO) SaslElement
 pullSaslElement = do
     r <- lift $ pullUnpickle (xpEither xpFailure xpSaslElement)
     case r of
@@ -124,7 +126,7 @@ pullSaslElement = do
         Right (Right r) -> return r
 
 -- | Pull the next element, checking that it is a challenge.
-pullChallenge :: SaslM (Maybe BS.ByteString)
+pullChallenge :: ErrorT AuthFailure (StateT Stream IO) (Maybe BS.ByteString)
 pullChallenge = do
   e <- pullSaslElement
   case e of
@@ -135,12 +137,12 @@ pullChallenge = do
       _ -> throwError AuthChallengeFailure
 
 -- | Extract value from Just, failing with AuthChallengeFailure on Nothing.
-saslFromJust :: Maybe a -> SaslM a
+saslFromJust :: Maybe a -> ErrorT AuthFailure (StateT Stream IO) a
 saslFromJust Nothing = throwError $ AuthChallengeFailure
 saslFromJust (Just d) = return d
 
 -- | Pull the next element and check that it is success.
-pullSuccess :: SaslM (Maybe Text.Text)
+pullSuccess :: ErrorT AuthFailure (StateT Stream IO) (Maybe Text.Text)
 pullSuccess = do
     e <- pullSaslElement
     case e of
@@ -149,7 +151,7 @@ pullSuccess = do
 
 -- | Pull the next element. When it's success, return it's payload.
 -- If it's a challenge, send an empty response and pull success.
-pullFinalMessage :: SaslM (Maybe BS.ByteString)
+pullFinalMessage :: ErrorT AuthFailure (StateT Stream IO) (Maybe BS.ByteString)
 pullFinalMessage = do
     challenge2 <- pullSaslElement
     case challenge2 of
@@ -165,13 +167,13 @@ pullFinalMessage = do
         Right x -> return $ Just x
 
 -- | Extract p=q pairs from a challenge.
-toPairs :: BS.ByteString -> SaslM Pairs
+toPairs :: BS.ByteString -> ErrorT AuthFailure (StateT Stream IO) Pairs
 toPairs ctext = case pairs ctext of
     Left _e -> throwError AuthChallengeFailure
     Right r -> return r
 
 -- | Send a SASL response element. The content will be base64-encoded.
-respond :: Maybe BS.ByteString -> SaslM Bool
+respond :: Maybe BS.ByteString -> ErrorT AuthFailure (StateT Stream IO) Bool
 respond m = do
     r <- lift . pushElement . saslResponseE . fmap (Text.decodeUtf8 . B64.encode) $ m
     case r of
@@ -182,7 +184,7 @@ respond m = do
 -- | Run the appropriate stringprep profiles on the credentials.
 -- May fail with 'AuthStringPrepFailure'
 prepCredentials :: Text.Text -> Maybe Text.Text -> Text.Text
-                -> SaslM (Text.Text, Maybe Text.Text, Text.Text)
+                -> ErrorT AuthFailure (StateT Stream IO) (Text.Text, Maybe Text.Text, Text.Text)
 prepCredentials authcid authzid password = case credentials of
     Nothing -> throwError $ AuthStringPrepFailure
     Just creds -> return creds

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

@@ -42,15 +42,15 @@ import           Network.Xmpp.Sasl.Types
 xmppDigestMd5 ::  Text -- ^ Authentication identity (authzid or username)
                -> Maybe Text -- ^ Authorization identity (authcid)
                -> Text -- ^ Password (authzid)
-               -> SaslM ()
+               -> ErrorT AuthFailure (StateT Stream IO) ()
 xmppDigestMd5 authcid authzid password = do
     (ac, az, pw) <- prepCredentials authcid authzid password
     hn <- gets streamHostname
     xmppDigestMd5' (fromJust hn) ac az pw
   where
-    xmppDigestMd5' :: Text -> Text -> Maybe Text -> Text -> SaslM ()
+    xmppDigestMd5' :: Text -> Text -> Maybe Text -> Text -> ErrorT AuthFailure (StateT Stream IO) ()
     xmppDigestMd5' hostname authcid authzid password = do
-        -- Push element and receive the challenge (in SaslM).
+        -- Push element and receive the challenge.
         _ <- saslInit "DIGEST-MD5" Nothing -- TODO: Check boolean?
         pairs <- toPairs =<< saslFromJust =<< pullChallenge
         cnonce <- liftIO $ makeNonce

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

@@ -50,7 +50,7 @@ import           Network.Xmpp.Sasl.Types
 xmppPlain :: Text.Text -- ^ Password
           -> Maybe Text.Text -- ^ Authorization identity (authzid)
           -> Text.Text -- ^ Authentication identity (authcid)
-          -> SaslM ()
+          -> ErrorT AuthFailure (StateT Stream IO) ()
 xmppPlain authcid authzid password  = do
     (ac, az, pw) <- prepCredentials authcid authzid password
     _ <- saslInit "PLAIN" ( Just $ plainMessage ac az pw)

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

@@ -29,6 +29,10 @@ import           Data.Word(Word8)
 import           Network.Xmpp.Sasl.Common
 import           Network.Xmpp.Sasl.StringPrep
 import           Network.Xmpp.Sasl.Types
+import           Network.Xmpp.Types
+
+
+import           Control.Monad.State.Strict
 
 -- | A nicer name for undefined, for use as a dummy token to determin
 -- the hash function to use
@@ -45,7 +49,7 @@ scram :: (Crypto.Hash ctx hash)
       -> Text.Text       -- ^ Authentication ID (user name)
       -> Maybe Text.Text -- ^ Authorization ID
       -> Text.Text       -- ^ Password
-      -> SaslM ()
+      -> ErrorT AuthFailure (StateT Stream IO) ()
 scram hashToken authcid authzid password = do
     (ac, az, pw) <- prepCredentials authcid authzid password
     scramhelper hashToken ac az pw
@@ -94,7 +98,7 @@ scram hashToken authcid authzid password = do
 
         fromPairs :: Pairs
                   -> BS.ByteString
-                  -> SaslM (BS.ByteString, BS.ByteString, Integer)
+                  -> ErrorT AuthFailure (StateT Stream IO) (BS.ByteString, BS.ByteString, Integer)
         fromPairs pairs cnonce | Just nonce <- lookup "r" pairs
                                , cnonce `BS.isPrefixOf` nonce
                                , Just salt' <- lookup "s" pairs

source/Network/Xmpp/Sasl/Types.hs

@@ -27,11 +27,9 @@ instance Error AuthFailure where
 data SaslElement = SaslSuccess   (Maybe Text.Text)
                  | SaslChallenge (Maybe Text.Text)
 
--- | SASL mechanism Stream computation, with the possibility of throwing
--- an authentication error.
-type SaslM a = ErrorT AuthFailure (StateT Stream IO) a
-
 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.
-type SaslHandler = (Text.Text, SaslM ())
+-- 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) ())