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

add protocol asserts

Browse source
This commit is contained in:
Scott R. Parish 2010-01-16 13:45:08 -06:00
parent 6a9a533fcc
commit ee1e4d3528
1 changed files with 4 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
Database/MongoDB.hs
View file

@ -8,6 +8,7 @@ module Database.MongoDB
query query
) )
where where
import Control.Exception (assert)
import Control.Monad import Control.Monad
import Data.Binary import Data.Binary
import Data.Binary.Get import Data.Binary.Get
@ -187,8 +188,8 @@ getReply c reqID = do
respTo <- getI32 respTo <- getI32
op <- getI32 op <- getI32
return $ Hdr msgLen reqID respTo $ toOpcode op return $ Hdr msgLen reqID respTo $ toOpcode op
-- TODO assert OP_REPLY = hOp hdr assert (OP_REPLY == hOp hdr) $ return ()
-- TODO assert hReqID hdr assert (hRespTo hdr == reqID) $ return ()
replyBytes <- L.hGet h 20 replyBytes <- L.hGet h 20
let reply = flip runGet replyBytes $ do let reply = flip runGet replyBytes $ do
respFlags <- getI32 respFlags <- getI32
@ -196,6 +197,7 @@ getReply c reqID = do
startFrom <- getI32 startFrom <- getI32
numReturned <- getI32 numReturned <- getI32
return $ (Reply respFlags cursorID startFrom numReturned) return $ (Reply respFlags cursorID startFrom numReturned)
assert (rRespFlags reply == 0) $ return ()
docBytes <- L.hGet h $ fromIntegral $ hMsgLen hdr - 16 - 20 docBytes <- L.hGet h $ fromIntegral $ hMsgLen hdr - 16 - 20
return $ flip runGet docBytes $ do return $ flip runGet docBytes $ do
forM [1 .. rNumReturned reply] $ \_ -> get forM [1 .. rNumReturned reply] $ \_ -> get