Vergara_Tech/mongodb
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Support mongolab SCRAM auth

Browse source 
For some reason mongolab requires additional message exchange round.
This commit is contained in:
Yuras Shumovich 2015-11-30 15:55:20 +03:00
parent 4f48ca92be
commit 0b4e3d96ed
1 changed files with 10 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
Database/MongoDB/Query.hs
View file

@ -271,7 +271,16 @@ authSCRAMSHA1 un pw = do
let serverPayload2 = B64.decodeLenient . B.pack $ at "payload" server2 let serverPayload2 = B64.decodeLenient . B.pack $ at "payload" server2
let serverData2 = parseSCRAM serverPayload2 let serverData2 = parseSCRAM serverPayload2
let serverSigComp = Map.findWithDefault "" "v" serverData2 let serverSigComp = Map.findWithDefault "" "v" serverData2
return (serverSig == serverSigComp)
shortcircuit (serverSig == serverSigComp) $ do
let done = true1 "done" server2
if done
then return True
else do
let client2 = ["saslContinue" =: (1 :: Int), "conversationId" =: (at "conversationId" server1 :: Int), "payload" =: String ""]
server3 <- runCommand client2
shortcircuit (true1 "ok" server3) $ do
return True
where where
shortcircuit True f = f shortcircuit True f = f
shortcircuit False _ = return False shortcircuit False _ = return False