add documentation to Scram.hs and Common.hs

source/Network/Xmpp/Sasl/Common.hs

@@ -85,11 +85,14 @@ xpFailure = xpWrap
              xpPrim
              (xpUnit)
              (xpUnit))))
+
 -- Challenge element pickler.
 xpChallenge :: PU [Node] (Maybe Text.Text)
 xpChallenge = xpElemNodes "{urn:ietf:params:xml:ns:xmpp-sasl}challenge"
                       (xpOption $ xpContent xpId)
 
+-- | pickler for SaslElement
+xpSaslElement :: PU [Node] SaslElement
 xpSaslElement = xpAlt saslSel
                 [ xpWrap SaslSuccess   (\(SaslSuccess x)   -> x) xpSuccess
                 , xpWrap SaslChallenge (\(SaslChallenge c) -> c) xpChallenge
@@ -98,6 +101,7 @@ xpSaslElement = xpAlt saslSel
     saslSel (SaslSuccess   _) = 0
     saslSel (SaslChallenge _) = 1
 
+-- | Add quotationmarks around a byte string
 quote :: BS.ByteString -> BS.ByteString
 quote x = BS.concat ["\"",x,"\""]
 
@@ -105,6 +109,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
 pullSaslElement :: SaslM SaslElement
 pullSaslElement = do
     el <- lift $ pullPickle (xpEither xpFailure xpSaslElement)
@@ -112,6 +117,7 @@ pullSaslElement = do
         Left e ->throwError $ AuthSaslFailure e
         Right r -> return r
 
+-- | Pull the next element, checking that it is a challenge
 pullChallenge :: SaslM (Maybe BS.ByteString)
 pullChallenge = do
   e <- pullSaslElement
@@ -122,10 +128,12 @@ pullChallenge = do
              -> return $ Just sc
       _ -> throwError AuthChallengeError
 
+-- | 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
 pullSuccess :: SaslM (Maybe Text.Text)
 pullSuccess = do
     e <- pullSaslElement
@@ -133,6 +141,8 @@ pullSuccess = do
         SaslSuccess x -> return x
         _ -> 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
 pullFinalMessage :: SaslM (Maybe Text.Text)
 pullFinalMessage = do
     challenge2 <- pullSaslElement
@@ -143,11 +153,13 @@ pullFinalMessage = do
             pullSuccess
             return x
 
+-- | 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
 respond :: Maybe BS.ByteString -> SaslM Bool
 respond = lift . pushElement . saslResponseE .
               fmap (Text.decodeUtf8 . B64.encode)

source/Network/Xmpp/Sasl/Scram.hs

@@ -29,28 +29,33 @@ import           Data.Word(Word8)
 import           Network.Xmpp.Sasl.Common
 import           Network.Xmpp.Sasl.Types
 
+-- | Bit-wise xor of byte strings
+xorBS :: BS.ByteString -> BS.ByteString -> BS.ByteString
 xorBS x y = BS.pack $ BS.zipWith xor x y
-merge = BS.intercalate ","
-
-type Hash = BS.ByteString -> BS.ByteString
-type Hmac = BS.ByteString -> BS.ByteString -> BS.ByteString
-
 
--- -- mKey :: Crypto.Hash ctx d => d -> BS.ByteString -> MacKey ctx d
--- -- mKey x k = Crypto.MacKey k
+-- | Join byte strings with ","
+merge :: [BS.ByteString] -> BS.ByteString
+merge = BS.intercalate ","
 
+-- | Infix concatenation of byte strings
 (+++) :: BS.ByteString -> BS.ByteString -> BS.ByteString
 (+++) = BS.append
 
+-- | A nicer name for undefined, for use as a dummy token to determin
+-- the hash function to use
 hashToken :: (Crypto.Hash ctx hash) => hash
 hashToken = undefined
 
+-- | Salted Challenge Response Authentication Mechanism (SCRAM) SASL
+-- mechanism according to RFC 5802.
+--
+-- 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
-              -- can safely pass undefined or a 'hashToken' to it
-      -> Text.Text
-      -> Maybe Text.Text
-      -> Text.Text
+      => hash            -- ^ Dummy argument to determine the hash to use. You
+                         --   can safely pass undefined or a 'hashToken' to it
+      -> Text.Text       -- ^ authentication ID (username)
+      -> Maybe Text.Text -- ^ authorization ID
+      -> Text.Text       -- ^ password
       -> SaslM ()
 scram hashToken authcid authzid' password = do
     cnonce <- liftIO $ makeNonce
@@ -118,35 +123,13 @@ scram hashToken authcid authzid' password = do
             u1 = hmac str (salt +++ (BS.pack [0,0,0,1]))
             us = iterate (hmac str) u1
 
---        toOectets l = encode $ x
-
-
-     -- SaltedPassword  := Hi(Normalize(password), salt, i)
-     -- ClientKey       := HMAC(SaltedPassword, "Client Key")
-     -- StoredKey       := H(ClientKey)
-     -- AuthMessage     := client-first-message-bare + "," +
-     --                    server-first-message + "," +
-     --                    client-final-message-without-proof
-     -- ClientSignature := HMAC(StoredKey, AuthMessage)
-     -- ClientProof     := ClientKey XOR ClientSignature
-     -- ServerKey       := HMAC(SaltedPassword, "Server Key")
-     -- ServerSignature := HMAC(ServerKey, AuthMessage)
-
-
     normalize = Text.encodeUtf8 . id -- TODO: stringprep
     base64 = B64.encode
 
+-- | 'scram' spezialised to the SHA-1 hash function, packaged as a SaslHandler
 scramSha1 :: SaslM Text.Text -> SaslHandler
 scramSha1 passwd = ("SCRAM-SHA-1"
                    , \_hostname authcid authzid -> do
                        pw <- passwd
                        scram (hashToken :: Crypto.SHA1) authcid authzid pw
                    )
-
-showBits x = [if testBit x i then '1' else '0' | i <- [0.. bitSize x -1]]
-
-toOctets :: (Binary a) => a -> [Word8]
-toOctets x = LBS.unpack . encode $ x
-
-intToFourWord8s i = let w8s =  toOctets $ i
-                    in drop (length w8s -4) w8s