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

Merge pull request #37 from Yuras/mongolab-auth

Browse source 
Support mongolab SCRAM auth
This commit is contained in:
Victor Denisov 2015-12-22 02:31:13 -08:00
commit ec0dac6915
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