Fix error reporting for deletion of big messages

PR#115
This commit is contained in:
Victor Denisov 2020-04-07 20:26:59 -07:00
commit e98655a907

View file

@ -896,25 +896,22 @@ delete' ordered col deleteDocs = do
NoConfirm -> ["w" =: (0 :: Int)] NoConfirm -> ["w" =: (0 :: Int)]
Confirm params -> params Confirm params -> params
let docSize = sizeOfDocument $ deleteCommandDocument col ordered [] writeConcern let docSize = sizeOfDocument $ deleteCommandDocument col ordered [] writeConcern
let preChunks = splitAtLimit let chunks = splitAtLimit
(maxBsonObjectSize sd - docSize) (maxBsonObjectSize sd - docSize)
-- size of auxiliary part of delete -- size of auxiliary part of delete
-- document should be subtracted from -- document should be subtracted from
-- the overall size -- the overall size
(maxWriteBatchSize sd) (maxWriteBatchSize sd)
deletes deletes
let chunks =
if ordered
then takeRightsUpToLeft preChunks
else rights preChunks
ctx <- ask ctx <- ask
let lens = map length chunks let lens = map (either (const 1) length) chunks
let lSums = 0 : (zipWith (+) lSums lens) let lSums = 0 : (zipWith (+) lSums lens)
blockResult <- liftIO $ interruptibleFor ordered (zip lSums chunks) $ \b -> do let failureResult e = return $ WriteResult True 0 Nothing 0 [] [e] []
dr <- runReaderT (deleteBlock ordered col b) ctx let doChunk b = runReaderT (deleteBlock ordered col b) ctx `catch` failureResult
return dr blockResult <- liftIO $ interruptibleFor ordered (zip lSums chunks) $ \(n, c) ->
`catch` \(e :: Failure) -> do case c of
return $ WriteResult True 0 Nothing 0 [] [e] [] Left e -> failureResult e
Right b -> doChunk (n, b)
return $ foldl1' mergeWriteResults blockResult return $ foldl1' mergeWriteResults blockResult