Merge remote-tracking branch 'nejla/master'

Conflicts:
	source/Network/Xmpp.hs
	source/Network/Xmpp/Sasl.hs
	source/Network/Xmpp/Sasl/Plain.hs
	source/Network/Xmpp/Sasl/Scram.hs
	source/Network/Xmpp/Sasl/Types.hs

fix DigestMd5.hs filename
make DigestMd5 compile again

pontarius.cabal

@@ -62,7 +62,7 @@ Library
                  , Network.Xmpp.Presence
                  , Network.Xmpp.Sasl
                  , Network.Xmpp.Sasl.Plain
-                 , Network.Xmpp.Sasl.DigestMD5
+                 , Network.Xmpp.Sasl.DigestMd5
                  , Network.Xmpp.Sasl.Scram
                  , Network.Xmpp.Sasl.Types
                  , Network.Xmpp.Session
@@ -70,7 +70,7 @@ Library
                  , Network.Xmpp.TLS
                  , Network.Xmpp.Types
   Other-modules:
-                 Network.Xmpp.JID
+                 Network.Xmpp.Jid
                  , Network.Xmpp.Concurrent.Types
                  , Network.Xmpp.Concurrent.IQ
                  , Network.Xmpp.Concurrent.Threads

source/Network/Xmpp/IM/Message.hs

@@ -67,7 +67,7 @@ body m = ms
 
 -- | Generate a new instant message
 newIM
-  :: JID
+  :: Jid
      -> Maybe StanzaId
      -> Maybe LangTag
      -> MessageType
@@ -90,7 +90,7 @@ newIM t i lang tp sbj thrd bdy payload = Message
     }
 
 -- | Generate a simple instance message
-simpleIM :: JID -> Text -> Message
+simpleIM :: Jid -> Text -> Message
 simpleIM t bd = newIM
                   t
                   Nothing

source/Network/Xmpp/Sasl.hs

@@ -32,30 +32,24 @@ import qualified System.Random as Random
 
 import Network.Xmpp.Sasl.Types
 
-
-runSasl :: SaslM a -> XmppConMonad (Either AuthError a)
-runSasl authAction = runErrorT $ do
-    cs <- gets sConnectionState
-    case cs of
-        XmppConnectionClosed -> throwError AuthConnectionError
-        _ -> do
-            r <- authAction
-            _ <- ErrorT $ left AuthStreamError <$> xmppRestartStream
-            return r
-
-
 -- Uses the first supported mechanism to authenticate, if any. Updates the
 -- 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 :: [SaslHandler] -- ^ Acceptable authentication
+xmppSasl :: [SaslHandler] -- ^ Acceptable authentication mechanisms and their
-                                        -- mechanisms and their corresponding
+                       -- corresponding handlers
-                                        -- handlers
          -> XmppConMonad (Either AuthError ())
 xmppSasl handlers = do
     -- Chooses the first mechanism that is acceptable by both the client and the
     -- server.
     mechanisms <- gets $ saslMechanisms . sFeatures
-    case (filter (\(name,_) -> name `elem` mechanisms)) handlers of
+    case (filter (\(name, _) -> name `elem` mechanisms)) handlers of
         [] -> return . Left $ AuthNoAcceptableMechanism mechanisms
-        (_name, handler):_ -> runSasl handler
+        (_name, handler):_ -> runErrorT $ do
+            cs <- gets sConnectionState
+            case cs of
+                XmppConnectionClosed -> throwError AuthConnectionError
+                _ -> do
+                    r <- handler
+                    _ <- ErrorT $ left AuthStreamError <$> xmppRestartStream
+                    return r

source/Network/Xmpp/Sasl/Common.hs

@@ -26,9 +26,6 @@ import           Network.Xmpp.Sasl.Types
 
 import qualified System.Random as Random
 
-data SaslElement = SaslSuccess   (Maybe Text.Text)
-                 | SaslChallenge (Maybe Text.Text)
-
 --makeNonce :: SaslM BS.ByteString
 makeNonce :: IO BS.ByteString
 makeNonce = do
@@ -53,9 +50,10 @@ saslResponseE resp =
     []
     (maybeToList $ NodeContent . ContentText <$> resp)
 
+-- The <success xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/> element.
 xpSuccess :: PU [Node] (Maybe Text.Text)
 xpSuccess = xpElemNodes "{urn:ietf:params:xml:ns:xmpp-sasl}success"
-              (xpOption $ xpContent xpId)
+    (xpOption $ xpContent xpId)
 
 -- Parses the incoming SASL data to a mapped list of pairs.
 pairs :: BS.ByteString -> Either String Pairs
@@ -91,7 +89,7 @@ xpChallenge :: PU [Node] (Maybe Text.Text)
 xpChallenge = xpElemNodes "{urn:ietf:params:xml:ns:xmpp-sasl}challenge"
                       (xpOption $ xpContent xpId)
 
--- | pickler for SaslElement
+-- | Pickler for SaslElement.
 xpSaslElement :: PU [Node] SaslElement
 xpSaslElement = xpAlt saslSel
                 [ xpWrap SaslSuccess   (\(SaslSuccess x)   -> x) xpSuccess
@@ -101,7 +99,7 @@ xpSaslElement = xpAlt saslSel
     saslSel (SaslSuccess   _) = 0
     saslSel (SaslChallenge _) = 1
 
--- | Add quotationmarks around a byte string
+-- | Add quotationmarks around a byte string.
 quote :: BS.ByteString -> BS.ByteString
 quote x = BS.concat ["\"",x,"\""]
 
@@ -109,7 +107,7 @@ saslInit :: Text.Text -> Maybe BS.ByteString -> SaslM Bool
 saslInit mechanism payload = lift . pushElement . saslInitE mechanism $
                                Text.decodeUtf8 . B64.encode <$> payload
 
--- | Pull the next element
+-- | Pull the next element.
 pullSaslElement :: SaslM SaslElement
 pullSaslElement = do
     el <- lift $ pullPickle (xpEither xpFailure xpSaslElement)
@@ -117,7 +115,7 @@ pullSaslElement = do
         Left e ->throwError $ AuthSaslFailure e
         Right r -> return r
 
--- | Pull the next element, checking that it is a challenge
+-- | Pull the next element, checking that it is a challenge.
 pullChallenge :: SaslM (Maybe BS.ByteString)
 pullChallenge = do
   e <- pullSaslElement
@@ -128,12 +126,12 @@ pullChallenge = do
              -> return $ Just sc
       _ -> throwError AuthChallengeError
 
--- | Extract value from Just, failing with AuthChallengeError on Nothing
+-- | Extract value from Just, failing with AuthChallengeError on Nothing.
 saslFromJust :: Maybe a -> SaslM a
 saslFromJust Nothing = throwError $ AuthChallengeError
 saslFromJust (Just d) = return d
 
--- | Pull the next element and check that it is success
+-- | Pull the next element and check that it is success.
 pullSuccess :: SaslM (Maybe Text.Text)
 pullSuccess = do
     e <- pullSaslElement
@@ -142,7 +140,7 @@ pullSuccess = do
         _ -> throwError $ AuthXmlError
 
 -- | Pull the next element. When it's success, return it's payload.
--- If it's a challenge, send an empty response and pull success
+-- If it's a challenge, send an empty response and pull success.
 pullFinalMessage :: SaslM (Maybe BS.ByteString)
 pullFinalMessage = do
     challenge2 <- pullSaslElement
@@ -158,14 +156,13 @@ pullFinalMessage = do
         Left _e -> throwError $ AuthChallengeError
         Right x -> return $ Just x
 
--- | Extract p=q pairs from a challenge
+-- | Extract p=q pairs from a challenge.
 toPairs :: BS.ByteString -> SaslM Pairs
 toPairs ctext = case pairs ctext of
     Left _e -> throwError AuthChallengeError
     Right r -> return r
 
--- | Send a SASL response element. The content will be base64-encoded  for you
+-- | Send a SASL response element. The content will be base64-encoded.
 respond :: Maybe BS.ByteString -> SaslM Bool
 respond = lift . pushElement . saslResponseE .
-              fmap (Text.decodeUtf8 . B64.encode)
+    fmap (Text.decodeUtf8 . B64.encode)
-

source/Network/Xmpp/Sasl/DigestMd5

@@ -1,134 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Network.Xmpp.Sasl.DigestMd5 where
-
-import           Control.Applicative
-import           Control.Arrow (left)
-import           Control.Monad
-import           Control.Monad.Error
-import           Control.Monad.State.Strict
-import           Data.Maybe (fromJust, isJust)
-
-import qualified Crypto.Classes as CC
-
-import qualified Data.Binary as Binary
-import qualified Data.ByteString.Base64 as B64
-import qualified Data.ByteString.Char8 as BS8
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Digest.Pure.MD5 as MD5
-import qualified Data.List as L
-
-import qualified Data.Text as Text
-import           Data.Text (Text)
-import qualified Data.Text.Encoding as Text
-
-import Data.XML.Pickle
-
-import qualified Data.ByteString as BS
-
-import Data.XML.Types
-
-import           Network.Xmpp.Monad
-import           Network.Xmpp.Stream
-import           Network.Xmpp.Types
-import           Network.Xmpp.Pickle
-
-
-import Network.Xmpp.Sasl.Common
-import Network.Xmpp.Sasl.Types
-
-
-
-xmppDigestMd5 :: Maybe Text -- Authorization identity (authzid)
-               -> Text -- Authentication identity (authzid)
-               -> Text -- Password (authzid)
-               -> SaslM ()
-xmppDigestMd5 authzid authcid passwd = do
-    hn <- gets sHostname
-    case hn of
-        Just hn' -> do
-            xmppDigestMD5' hn'
-            -- TODO: Save authzid
-            modify (\s -> s{sUsername = Just authcid})
-        Nothing -> throwError AuthConnectionError
-  where
-    xmppDigestMD5' :: Text -> SaslM ()
-    xmppDigestMD5' hostname = do
-        -- Push element and receive the challenge (in SaslM).
-        _ <- saslInit "DIGEST-MD5" Nothing -- TODO: Check boolean?
-        pairs <- toPairs =<< saslFromJust =<< pullChallenge
-        cnonce <- liftIO $ makeNonce
-        _b <- respond . Just $ createResponse hostname pairs cnonce
-        challenge2 <- pullFinalMessage
-        _ <- ErrorT $ left AuthStreamError <$> xmppRestartStream
-        return ()
-    -- Produce the response to the challenge.
-    createResponse :: Text
-                   -> Pairs
-                   -> BS.ByteString -- nonce
-                   -> BS.ByteString
-    createResponse hostname pairs cnonce = let
-        Just qop   = L.lookup "qop" pairs -- TODO: proper handling
-        Just nonce = L.lookup "nonce" pairs
-        uname_     = Text.encodeUtf8 authcid
-        passwd_    = Text.encodeUtf8 passwd
-        -- Using Int instead of Word8 for random 1.0.0.0 (GHC 7) compatibility.
-
-        nc         = "00000001"
-        digestURI  = "xmpp/" `BS.append` Text.encodeUtf8 hostname
-        digest     = md5Digest
-            uname_
-            (lookup "realm" pairs)
-            passwd_
-            digestURI
-            nc
-            qop
-            nonce
-            cnonce
-        response = BS.intercalate "," . map (BS.intercalate "=") $
-            [["username", quote uname_]] ++
-                case L.lookup "realm" pairs of
-                    Just realm -> [["realm" , quote realm ]]
-                    Nothing -> [] ++
-                        [ ["nonce"     , quote nonce    ]
-                        , ["cnonce"    , quote cnonce   ]
-                        , ["nc"        ,       nc       ]
-                        , ["qop"       ,       qop      ]
-                        , ["digest-uri", quote digestURI]
-                        , ["response"  ,       digest   ]
-                        , ["charset"   ,       "utf-8"  ]
-                        ]
-        in B64.encode response
-    hash :: [BS8.ByteString] -> BS8.ByteString
-    hash = BS8.pack . show
-           . (CC.hash' :: BS.ByteString -> MD5.MD5Digest) . BS.intercalate (":")
-    hashRaw :: [BS8.ByteString] -> BS8.ByteString
-    hashRaw = toStrict . Binary.encode .
-        (CC.hash' :: BS.ByteString -> MD5.MD5Digest) . BS.intercalate (":")
-    toStrict :: BL.ByteString -> BS8.ByteString
-    toStrict = BS.concat . BL.toChunks
-    -- TODO: this only handles MD5-sess
-    md5Digest :: BS8.ByteString
-              -> Maybe BS8.ByteString
-              -> BS8.ByteString
-              -> BS8.ByteString
-              -> BS8.ByteString
-              -> BS8.ByteString
-              -> BS8.ByteString
-              -> BS8.ByteString
-              -> BS8.ByteString
-    md5Digest uname realm password digestURI nc qop nonce cnonce =
-      let ha1 = hash [ hashRaw [uname, maybe "" id realm, password]
-                     , nonce
-                     , cnonce
-                     ]
-          ha2 = hash ["AUTHENTICATE", digestURI]
-      in hash [ha1, nonce, nc, cnonce, qop, ha2]
-
-digestMd5 :: Maybe Text -- Authorization identity (authzid)
-          -> Text -- Authentication identity (authzid)
-          -> Text -- Password (authzid)
-          -> SaslHandler
-digestMd5 authzid authcid password = ( "DIGEST-MD5"
-                                     , xmppDigestMd5 authzid authcid password
-                                     )

source/Network/Xmpp/Sasl/DigestMd5.hs

@@ -0,0 +1,146 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.Xmpp.Sasl.DigestMd5 where
+
+import           Control.Applicative
+import           Control.Arrow (left)
+import           Control.Monad
+import           Control.Monad.Error
+import           Control.Monad.State.Strict
+import           Data.Maybe (fromJust, isJust)
+
+import qualified Crypto.Classes as CC
+
+import qualified Data.Binary as Binary
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as BS8
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Digest.Pure.MD5 as MD5
+import qualified Data.List as L
+
+import qualified Data.Text as Text
+import           Data.Text (Text)
+import qualified Data.Text.Encoding as Text
+
+import           Data.XML.Pickle
+
+import qualified Data.ByteString as BS
+
+import           Data.XML.Types
+
+import           Network.Xmpp.Monad
+import           Network.Xmpp.Pickle
+import           Network.Xmpp.Stream
+import           Network.Xmpp.Types
+
+
+import           Network.Xmpp.Sasl.Common
+import           Network.Xmpp.Sasl.StringPrep
+import           Network.Xmpp.Sasl.Types
+
+
+
+xmppDigestMd5 :: Maybe Text -- Authorization identity (authzid)
+               -> Text -- Authentication identity (authzid)
+               -> Text -- Password (authzid)
+               -> SaslM ()
+xmppDigestMd5 authzid authcid password = do
+    case credentials of
+        Nothing -> throwError $ AuthStringPrepError
+        Just (ac, az, pw) -> do
+        hn <- gets sHostname
+        case hn of
+            Just hn' -> do
+                xmppDigestMd5' hn' ac az pw
+            Nothing -> throwError AuthConnectionError
+  where
+    credentials = do
+      ac <- normalizeUsername authcid
+      az <- case authzid of
+        Nothing -> Just Nothing
+        Just az' -> Just <$> normalizeUsername az'
+      pw <- normalizePassword password
+      return (ac, az, pw)
+    xmppDigestMd5' :: Text -> Text -> Maybe Text -> Text -> SaslM ()
+    xmppDigestMd5' hostname authcid authzid password = do
+        -- Push element and receive the challenge (in SaslM).
+        _ <- saslInit "DIGEST-MD5" Nothing -- TODO: Check boolean?
+        pairs <- toPairs =<< saslFromJust =<< pullChallenge
+        cnonce <- liftIO $ makeNonce
+        _b <- respond . Just $ createResponse hostname pairs cnonce
+        challenge2 <- pullFinalMessage
+        _ <- ErrorT $ left AuthStreamError <$> xmppRestartStream
+        return ()
+      where
+        -- Produce the response to the challenge.
+        createResponse :: Text
+                       -> Pairs
+                       -> BS.ByteString -- nonce
+                       -> BS.ByteString
+        createResponse hostname pairs cnonce = let
+            Just qop   = L.lookup "qop" pairs -- TODO: proper handling
+            Just nonce = L.lookup "nonce" pairs
+            uname_     = Text.encodeUtf8 authcid
+            passwd_    = Text.encodeUtf8 password
+            -- Using Int instead of Word8 for random 1.0.0.0 (GHC 7)
+            -- compatibility.
+
+            nc         = "00000001"
+            digestURI  = "xmpp/" `BS.append` Text.encodeUtf8 hostname
+            digest     = md5Digest
+                uname_
+                (lookup "realm" pairs)
+                passwd_
+                digestURI
+                nc
+                qop
+                nonce
+                cnonce
+            response = BS.intercalate "," . map (BS.intercalate "=") $
+                [["username", quote uname_]] ++
+                    case L.lookup "realm" pairs of
+                        Just realm -> [["realm" , quote realm ]]
+                        Nothing -> [] ++
+                            [ ["nonce"     , quote nonce    ]
+                            , ["cnonce"    , quote cnonce   ]
+                            , ["nc"        ,       nc       ]
+                            , ["qop"       ,       qop      ]
+                            , ["digest-uri", quote digestURI]
+                            , ["response"  ,       digest   ]
+                            , ["charset"   ,       "utf-8"  ]
+                            ]
+            in B64.encode response
+        hash :: [BS8.ByteString] -> BS8.ByteString
+        hash = BS8.pack . show
+               . (CC.hash' :: BS.ByteString -> MD5.MD5Digest)
+                  . BS.intercalate (":")
+        hashRaw :: [BS8.ByteString] -> BS8.ByteString
+        hashRaw = toStrict . Binary.encode .
+            (CC.hash' :: BS.ByteString -> MD5.MD5Digest) . BS.intercalate (":")
+        toStrict :: BL.ByteString -> BS8.ByteString
+        toStrict = BS.concat . BL.toChunks
+        -- TODO: this only handles MD5-sess
+        md5Digest :: BS8.ByteString
+                  -> Maybe BS8.ByteString
+                  -> BS8.ByteString
+                  -> BS8.ByteString
+                  -> BS8.ByteString
+                  -> BS8.ByteString
+                  -> BS8.ByteString
+                  -> BS8.ByteString
+                  -> BS8.ByteString
+        md5Digest uname realm password digestURI nc qop nonce cnonce =
+          let ha1 = hash [ hashRaw [uname, maybe "" id realm, password]
+                         , nonce
+                         , cnonce
+                         ]
+              ha2 = hash ["AUTHENTICATE", digestURI]
+          in hash [ha1, nonce, nc, cnonce, qop, ha2]
+
+digestMd5 :: Maybe Text -- Authorization identity (authzid)
+          -> Text -- Authentication identity (authzid)
+          -> Text -- Password (authzid)
+          -> SaslHandler
+digestMd5 authzid authcid password = ( "DIGEST-MD5"
+                                     , xmppDigestMd5 authzid authcid password
+                                     )

source/Network/Xmpp/Sasl/Plain.hs

@@ -46,9 +46,9 @@ import Network.Xmpp.Sasl.Common
 import Network.Xmpp.Sasl.Types
 
 -- TODO: stringprep
-xmppPlain :: Text.Text
+xmppPlain :: Text.Text -- ^ Password
-          -> Maybe Text.Text
+          -> Maybe Text.Text -- ^ Authorization identity (authzid)
-          -> Text.Text
+          -> Text.Text -- ^ Authentication identity (authcid)
           -> SaslM ()
 xmppPlain authcid authzid passwd  = do
     _ <- saslInit "PLAIN" ( Just $ plainMessage authzid authcid passwd)

source/Network/Xmpp/Sasl/Scram.hs

@@ -4,7 +4,7 @@
 
 module Network.Xmpp.Sasl.Scram where
 
-import           Control.Applicative((<$>))
+import           Control.Applicative ((<$>))
 import           Control.Monad.Error
 import           Control.Monad.Trans (liftIO)
 import qualified Crypto.Classes as Crypto
@@ -16,8 +16,7 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base64 as B64
 import           Data.ByteString.Char8  as BS8 (unpack)
 import qualified Data.ByteString.Lazy as LBS
-import           Data.List (foldl1')
+import           Data.List (foldl1', genericTake)
-
 
 import qualified Data.Binary.Builder as Build
 
@@ -52,11 +51,11 @@ hashToken = undefined
 --
 -- This implementation is independent and polymorphic in the used hash function.
 scram :: (Crypto.Hash ctx hash)
-      => hash            -- ^ Dummy argument to determine the hash to use. You
+      => hash            -- ^ Dummy argument to determine the hash to use; you
                          --   can safely pass undefined or a 'hashToken' to it
-      -> Text.Text       -- ^ authentication ID (username)
+      -> Text.Text       -- ^ Authentication ID (user name)
-      -> Maybe Text.Text -- ^ authorization ID
+      -> Maybe Text.Text -- ^ Authorization ID
-      -> Text.Text       -- ^ password
+      -> Text.Text       -- ^ Password
       -> SaslM ()
 scram hashToken authcid authzid password = case credentials of
     Nothing -> throwError $ AuthStringPrepError
@@ -84,32 +83,51 @@ scram hashToken authcid authzid password = case credentials of
         -- We need to jump through some hoops to get a polymorphic solution
         encode :: Crypto.Hash ctx hash => hash -> hash -> BS.ByteString
         encode _hashtoken = Crypto.encode
+
+        hash :: BS.ByteString -> BS.ByteString
         hash str = encode hashToken $ Crypto.hash' str
+
+        hmac :: BS.ByteString -> BS.ByteString -> BS.ByteString
         hmac key str = encode hashToken $ Crypto.hmac' (Crypto.MacKey key) str
 
+        authzid :: Maybe BS.ByteString
         authzid              = (\z -> "a=" +++ Text.encodeUtf8 z) <$> authzid'
+
+        gs2CbindFlag :: BS.ByteString
         gs2CbindFlag         = "n" -- we don't support channel binding yet
+
+        gs2Header :: BS.ByteString
         gs2Header            = merge $ [ gs2CbindFlag
                                         , maybe "" id authzid
                                         , ""
                                         ]
+        cbindData :: BS.ByteString
         cbindData            = "" -- we don't support channel binding yet
+
+        cFirstMessageBare :: BS.ByteString -> BS.ByteString
         cFirstMessageBare cnonce = merge [ "n=" +++ Text.encodeUtf8 authcid
                                          , "r=" +++ cnonce]
+        cFirstMessage :: BS.ByteString -> BS.ByteString
         cFirstMessage cnonce = gs2Header +++ cFirstMessageBare cnonce
 
         fromPairs :: Pairs
                   -> BS.ByteString
-                  -> SaslM (BS.ByteString, BS.ByteString, Int)
+                  -> SaslM (BS.ByteString, BS.ByteString, Integer)
         fromPairs pairs cnonce | Just nonce <- lookup "r" pairs
                                , cnonce `BS.isPrefixOf` nonce
                                , Just salt' <- lookup "s" pairs
                                , Right salt <- B64.decode salt'
                                , Just ic <- lookup "i" pairs
                                , [(i,"")] <- reads $ BS8.unpack ic
-                               = return (nonce, salt, i :: Int)
+                               = return (nonce, salt, i)
         fromPairs _ _ = throwError $ AuthChallengeError
 
+        cFinalMessageAndVerifier :: BS.ByteString
+                                 -> BS.ByteString
+                                 -> Integer
+                                 -> BS.ByteString
+                                 -> BS.ByteString
+                                 -> (BS.ByteString, BS.ByteString)
         cFinalMessageAndVerifier nonce salt ic sfm cnonce
             =  (merge [ cFinalMessageWOProof
                       , "p=" +++ B64.encode clientProof
@@ -117,22 +135,40 @@ scram hashToken authcid authzid password = case credentials of
               , B64.encode serverSignature
               )
           where
+            cFinalMessageWOProof :: BS.ByteString
             cFinalMessageWOProof = merge [ "c=" +++ B64.encode gs2Header
                                          , "r=" +++ nonce]
+
+            saltedPassword :: BS.ByteString
             saltedPassword       = hi (Text.encodeUtf8 password) salt ic
+
+            clientKey :: BS.ByteString
             clientKey            = hmac saltedPassword "Client Key"
+
+            storedKey :: BS.ByteString
             storedKey            = hash clientKey
+
+            authMessage :: BS.ByteString
             authMessage          = merge [ cFirstMessageBare cnonce
                                          , sfm
                                          , cFinalMessageWOProof
                                          ]
+
+            clientSignature :: BS.ByteString
             clientSignature      = hmac storedKey authMessage
+
+            clientProof :: BS.ByteString
             clientProof          = clientKey `xorBS` clientSignature
+
+            serverKey :: BS.ByteString
             serverKey            = hmac saltedPassword "Server Key"
+
+            serverSignature :: BS.ByteString
             serverSignature      = hmac serverKey authMessage
 
             -- helper
-            hi str salt ic = foldl1' xorBS (take ic us)
+            hi :: BS.ByteString -> BS.ByteString -> Integer -> BS.ByteString
+            hi str salt ic = foldl1' xorBS (genericTake ic us)
               where
                 u1 = hmac str (salt +++ (BS.pack [0,0,0,1]))
                 us = iterate (hmac str) u1

source/Network/Xmpp/Sasl/Types.hs

@@ -11,19 +11,26 @@ data AuthError = AuthXmlError
                                                        -- offered
                | AuthChallengeError
                | AuthServerAuthError -- ^ The server failed to authenticate
-                                     -- himself
+                                     -- itself
                | AuthStreamError StreamError -- ^ Stream error on stream restart
-               | AuthConnectionError -- ^ No host name set in state
+               -- TODO: Rename AuthConnectionError?
+               | AuthConnectionError -- ^ Connection is closed
                | AuthError -- General instance used for the Error instance
-               | AuthSaslFailure SaslFailure -- ^ defined SASL error condition
+               | AuthSaslFailure SaslFailure -- ^ Defined SASL error condition
                | AuthStringPrepError -- ^ StringPrep failed
                  deriving Show
 
 instance Error AuthError where
     noMsg = AuthError
 
+data SaslElement = SaslSuccess   (Maybe Text.Text)
+                 | SaslChallenge (Maybe Text.Text)
+
+-- | SASL mechanism XmppConnection computation, with the possibility of throwing
+-- an authentication error.
 type SaslM a = ErrorT AuthError (StateT XmppConnection IO) a
 
 type Pairs = [(ByteString, ByteString)]
 
+-- | Tuple defining the SASL Handler's name, and a SASL mechanism computation
 type SaslHandler = (Text.Text, SaslM ())