de-monadified createResponse

src/Network/XMPP/SASL.hs

@@ -68,7 +68,8 @@ xmppStartSASL realm username passwd = do
   pushN $ saslInitE "DIGEST-MD5"
   Right challenge <- B64.decode . Text.encodeUtf8<$> pullPickle challengePickle
   let Right pairs = toPairs challenge
-  pushN . saslResponseE =<< createResponse realm username passwd pairs
+  g <- liftIO $ Random.newStdGen
+  pushN . saslResponseE $ createResponse g realm username passwd pairs
   challenge2 <- pullPickle (xpEither failurePickle challengePickle)
   case challenge2 of
     Left x -> error $ show x
@@ -78,44 +79,46 @@ xmppStartSASL realm username passwd = do
   xmppRestartStream
   return ()
 
-createResponse :: Text
+createResponse :: Random.RandomGen g
+               => g
+               -> Text
                -> Text
                -> Text
                -> [(BS8.ByteString, BS8.ByteString)]
-               -> XMPPConMonad Text
+               -> Text
-createResponse hostname username passwd' pairs = do
+createResponse g hostname username passwd' pairs = let
-  let Just qop = L.lookup "qop" pairs
+  Just qop = L.lookup "qop" pairs
-  let Just nonce = L.lookup "nonce" pairs
+  Just nonce = L.lookup "nonce" pairs
-  let uname = Text.encodeUtf8 username
+  uname = Text.encodeUtf8 username
-  let passwd = Text.encodeUtf8 passwd'
+  passwd = Text.encodeUtf8 passwd'
-  let realm = Text.encodeUtf8 hostname
+  realm = Text.encodeUtf8 hostname
-  g <- liftIO $ Random.newStdGen
+  cnonce = BS.tail . BS.init .
-  let cnonce = BS.tail . BS.init .
+           B64.encode . BS.pack . take 8 $ Random.randoms g
-               B64.encode . BS.pack . take 8 $ Random.randoms g
+  nc = "00000001"
-  let nc = "00000001"
+  digestURI = ("xmpp/" `BS.append` realm)
-  let digestURI = ("xmpp/" `BS.append` realm)
+  digest = md5Digest
-  let digest = md5Digest
+             uname
-                 uname
+             realm
-                 realm
+             passwd
-                 passwd
+             digestURI
-                 digestURI
+             nc
-                 nc
+             qop
-                 qop
+             nonce
-                 nonce
+             cnonce
-                 cnonce
+  response = BS.intercalate"," . map (BS.intercalate "=") $
-  let response = BS.intercalate"," . map (BS.intercalate "=") $
+   [["username"  , quote uname     ]
-       [["username"  , quote uname     ]
+   ,["realm"     , quote realm     ]
-       ,["realm"     , quote realm     ]
+   ,["nonce"     , quote nonce     ]
-       ,["nonce"     , quote nonce     ]
+   ,["cnonce"    , quote cnonce    ]
-       ,["cnonce"    , quote cnonce    ]
+   ,["nc"        ,       nc        ]
-       ,["nc"        ,       nc        ]
+   ,["qop"       ,       qop       ]
-       ,["qop"       ,       qop       ]
+   ,["digest-uri", quote digestURI ]
-       ,["digest-uri", quote digestURI ]
+   ,["response"  ,       digest    ]
-       ,["response"  ,       digest    ]
+   ,["charset"   ,       "utf-8"   ]
-       ,["charset"   ,       "utf-8"   ]
+   ]
-       ]
+  in Text.decodeUtf8 $ B64.encode response
-  return . Text.decodeUtf8 $ B64.encode response
+  where
-  where quote x = BS.concat ["\"",x,"\""]
+    quote x = BS.concat ["\"",x,"\""]
 
 toPairs :: BS.ByteString -> Either String [(BS.ByteString, BS.ByteString)]
 toPairs = AP.parseOnly . flip AP.sepBy1 (void $ AP.char ',') $ do