-- Author:
-- Brent Tubbs <brent.tubbs@gmail.com>
-- | MongoDB GridFS implementation
{-# LANGUAGE OverloadedStrings, RecordWildCards, NamedFieldPuns, TupleSections, FlexibleContexts, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, StandaloneDeriving, TypeSynonymInstances, TypeFamilies, CPP, RankNTypes #-}

module Database.MongoDB.GridFS
  ( Bucket
  , files, chunks
  , File
  , document, bucket
  -- ** Setup
  , openDefaultBucket
  , openBucket
  -- ** Query
  , findFile
  , findOneFile
  , fetchFile
  -- ** Delete
  , deleteFile
  -- ** Conduits
  , sourceFile
  , sinkFile
  )
  where

import Control.Applicative((<$>))

import Control.Monad(when)
import Control.Monad.Fail(MonadFail)
import Control.Monad.IO.Class
import Control.Monad.Trans(lift)

import Data.Conduit
import Data.Digest.Pure.MD5
import Data.Int
import Data.Tagged(Tagged, untag)
import Data.Text(Text, append)
import Data.Time.Clock(getCurrentTime)
import Database.MongoDB
import Prelude
import qualified Data.Bson as B
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L


defaultChunkSize :: Int64
-- ^ The default chunk size is 256 kB
defaultChunkSize :: Int64
defaultChunkSize = Int64
256 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1024

-- magic constant for md5Finalize
md5BlockSizeInBytes :: Int
md5BlockSizeInBytes :: Int
md5BlockSizeInBytes = Int
64


data Bucket = Bucket {Bucket -> Text
files :: Text, Bucket -> Text
chunks :: Text}
-- ^ Files are stored in "buckets". You open a bucket with openDefaultBucket or openBucket

openDefaultBucket :: (Monad m, MonadIO m) => Action m Bucket
-- ^ Open the default 'Bucket' (named "fs")
openDefaultBucket :: Action m Bucket
openDefaultBucket = Text -> Action m Bucket
forall (m :: * -> *).
(Monad m, MonadIO m) =>
Text -> Action m Bucket
openBucket Text
"fs"

openBucket :: (Monad m, MonadIO m) => Text -> Action m Bucket
-- ^ Open a 'Bucket'
openBucket :: Text -> Action m Bucket
openBucket Text
name = do
  let filesCollection :: Text
filesCollection = Text
name Text -> Text -> Text
`append` Text
".files"
  let chunksCollection :: Text
chunksCollection = Text
name Text -> Text -> Text
`append` Text
".chunks"
  Index -> Action m ()
forall (m :: * -> *). MonadIO m => Index -> Action m ()
ensureIndex (Index -> Action m ()) -> Index -> Action m ()
forall a b. (a -> b) -> a -> b
$ (Text -> Order -> Index
index Text
filesCollection [Text
"filename" Text -> Int -> Field
forall v. Val v => Text -> v -> Field
=: (Int
1::Int), Text
"uploadDate" Text -> Int -> Field
forall v. Val v => Text -> v -> Field
=: (Int
1::Int)])
  Index -> Action m ()
forall (m :: * -> *). MonadIO m => Index -> Action m ()
ensureIndex (Index -> Action m ()) -> Index -> Action m ()
forall a b. (a -> b) -> a -> b
$ (Text -> Order -> Index
index Text
chunksCollection [Text
"files_id" Text -> Int -> Field
forall v. Val v => Text -> v -> Field
=: (Int
1::Int), Text
"n" Text -> Int -> Field
forall v. Val v => Text -> v -> Field
=: (Int
1::Int)]) { iUnique :: Bool
iUnique = Bool
True, iDropDups :: Bool
iDropDups = Bool
True }
  Bucket -> Action m Bucket
forall (m :: * -> *) a. Monad m => a -> m a
return (Bucket -> Action m Bucket) -> Bucket -> Action m Bucket
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bucket
Bucket Text
filesCollection Text
chunksCollection

data File = File {File -> Bucket
bucket :: Bucket, File -> Order
document :: Document}

getChunk :: (MonadFail m, MonadIO m) => File -> Int -> Action m (Maybe S.ByteString)
-- ^ Get a chunk of a file
getChunk :: File -> Int -> Action m (Maybe ByteString)
getChunk (File Bucket
bucket Order
doc) Int
i = do
  Value
files_id <- Text -> Order -> ReaderT MongoContext m Value
forall (m :: * -> *). MonadFail m => Text -> Order -> m Value
B.look Text
"_id" Order
doc
  Maybe Order
result <- Query -> Action m (Maybe Order)
forall (m :: * -> *). MonadIO m => Query -> Action m (Maybe Order)
findOne (Query -> Action m (Maybe Order))
-> Query -> Action m (Maybe Order)
forall a b. (a -> b) -> a -> b
$ Order -> Text -> Query
forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Text -> aQueryOrSelection
select [Text
"files_id" Text -> Value -> Field
:= Value
files_id, Text
"n" Text -> Int -> Field
forall v. Val v => Text -> v -> Field
=: Int
i] (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Bucket -> Text
chunks Bucket
bucket
  let content :: Maybe Binary
content = Text -> Order -> Binary
forall v. Val v => Text -> Order -> v
at Text
"data" (Order -> Binary) -> Maybe Order -> Maybe Binary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Order
result
  case Maybe Binary
content of
    Just (Binary ByteString
b) -> Maybe ByteString -> Action m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
b)
    Maybe Binary
_ -> Maybe ByteString -> Action m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing

findFile :: MonadIO m => Bucket -> Selector -> Action m [File]
-- ^ Find files in the bucket
findFile :: Bucket -> Order -> Action m [File]
findFile Bucket
bucket Order
sel = do
  Cursor
cursor <- Query -> Action m Cursor
forall (m :: * -> *). MonadIO m => Query -> Action m Cursor
find (Query -> Action m Cursor) -> Query -> Action m Cursor
forall a b. (a -> b) -> a -> b
$ Order -> Text -> Query
forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Text -> aQueryOrSelection
select Order
sel (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Bucket -> Text
files Bucket
bucket
  [Order]
results <- Cursor -> Action m [Order]
forall (m :: * -> *). MonadIO m => Cursor -> Action m [Order]
rest Cursor
cursor
  [File] -> Action m [File]
forall (m :: * -> *) a. Monad m => a -> m a
return ([File] -> Action m [File]) -> [File] -> Action m [File]
forall a b. (a -> b) -> a -> b
$ Bucket -> Order -> File
File Bucket
bucket (Order -> File) -> [Order] -> [File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Order]
results

findOneFile :: MonadIO m => Bucket -> Selector -> Action m (Maybe File)
-- ^ Find one file in the bucket
findOneFile :: Bucket -> Order -> Action m (Maybe File)
findOneFile Bucket
bucket Order
sel = do
  Maybe Order
mdoc <- Query -> Action m (Maybe Order)
forall (m :: * -> *). MonadIO m => Query -> Action m (Maybe Order)
findOne (Query -> Action m (Maybe Order))
-> Query -> Action m (Maybe Order)
forall a b. (a -> b) -> a -> b
$ Order -> Text -> Query
forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Text -> aQueryOrSelection
select Order
sel (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Bucket -> Text
files Bucket
bucket
  Maybe File -> Action m (Maybe File)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe File -> Action m (Maybe File))
-> Maybe File -> Action m (Maybe File)
forall a b. (a -> b) -> a -> b
$ Bucket -> Order -> File
File Bucket
bucket (Order -> File) -> Maybe Order -> Maybe File
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Order
mdoc

fetchFile :: MonadIO m => Bucket -> Selector -> Action m File
-- ^ Fetch one file in the bucket
fetchFile :: Bucket -> Order -> Action m File
fetchFile Bucket
bucket Order
sel = do
  Order
doc <- Query -> Action m Order
forall (m :: * -> *). MonadIO m => Query -> Action m Order
fetch (Query -> Action m Order) -> Query -> Action m Order
forall a b. (a -> b) -> a -> b
$ Order -> Text -> Query
forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Text -> aQueryOrSelection
select Order
sel (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Bucket -> Text
files Bucket
bucket
  File -> Action m File
forall (m :: * -> *) a. Monad m => a -> m a
return (File -> Action m File) -> File -> Action m File
forall a b. (a -> b) -> a -> b
$ Bucket -> Order -> File
File Bucket
bucket Order
doc

deleteFile :: (MonadIO m, MonadFail m) => File -> Action m ()
-- ^ Delete files in the bucket
deleteFile :: File -> Action m ()
deleteFile (File Bucket
bucket Order
doc) = do
  Value
files_id <- Text -> Order -> ReaderT MongoContext m Value
forall (m :: * -> *). MonadFail m => Text -> Order -> m Value
B.look Text
"_id" Order
doc
  Selection -> Action m ()
forall (m :: * -> *). MonadIO m => Selection -> Action m ()
delete (Selection -> Action m ()) -> Selection -> Action m ()
forall a b. (a -> b) -> a -> b
$ Order -> Text -> Selection
forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Text -> aQueryOrSelection
select [Text
"_id" Text -> Value -> Field
:= Value
files_id] (Text -> Selection) -> Text -> Selection
forall a b. (a -> b) -> a -> b
$ Bucket -> Text
files Bucket
bucket
  Selection -> Action m ()
forall (m :: * -> *). MonadIO m => Selection -> Action m ()
delete (Selection -> Action m ()) -> Selection -> Action m ()
forall a b. (a -> b) -> a -> b
$ Order -> Text -> Selection
forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Text -> aQueryOrSelection
select [Text
"files_id" Text -> Value -> Field
:= Value
files_id] (Text -> Selection) -> Text -> Selection
forall a b. (a -> b) -> a -> b
$ Bucket -> Text
chunks Bucket
bucket

putChunk :: (Monad m, MonadIO m) => Bucket -> ObjectId -> Int -> L.ByteString -> Action m ()
-- ^ Put a chunk in the bucket
putChunk :: Bucket -> ObjectId -> Int -> ByteString -> Action m ()
putChunk Bucket
bucket ObjectId
files_id Int
i ByteString
chunk = do
  Text -> Order -> Action m ()
forall (m :: * -> *). MonadIO m => Text -> Order -> Action m ()
insert_ (Bucket -> Text
chunks Bucket
bucket) [Text
"files_id" Text -> ObjectId -> Field
forall v. Val v => Text -> v -> Field
=: ObjectId
files_id, Text
"n" Text -> Int -> Field
forall v. Val v => Text -> v -> Field
=: Int
i, Text
"data" Text -> Binary -> Field
forall v. Val v => Text -> v -> Field
=: ByteString -> Binary
Binary (ByteString -> ByteString
L.toStrict ByteString
chunk)]

sourceFile :: (MonadFail m, MonadIO m) => File -> Producer (Action m) S.ByteString
-- ^ A producer for the contents of a file
sourceFile :: File -> Producer (Action m) ByteString
sourceFile File
file = Int -> ConduitT i ByteString (Action m) ()
yieldChunk Int
0 where
  yieldChunk :: Int -> ConduitT i ByteString (Action m) ()
yieldChunk Int
i = do
    Maybe ByteString
mbytes <- ReaderT MongoContext m (Maybe ByteString)
-> ConduitT i ByteString (Action m) (Maybe ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT MongoContext m (Maybe ByteString)
 -> ConduitT i ByteString (Action m) (Maybe ByteString))
-> ReaderT MongoContext m (Maybe ByteString)
-> ConduitT i ByteString (Action m) (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ File -> Int -> ReaderT MongoContext m (Maybe ByteString)
forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
File -> Int -> Action m (Maybe ByteString)
getChunk File
file Int
i
    case Maybe ByteString
mbytes of
      Just ByteString
bytes -> ByteString -> ConduitT i ByteString (Action m) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
bytes ConduitT i ByteString (Action m) ()
-> ConduitT i ByteString (Action m) ()
-> ConduitT i ByteString (Action m) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ConduitT i ByteString (Action m) ()
yieldChunk (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
      Maybe ByteString
Nothing -> () -> ConduitT i ByteString (Action m) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Used to keep data during writing
data FileWriter = FileWriter
  { FileWriter -> Int64
_fwChunkSize :: Int64
  , FileWriter -> Bucket
_fwBucket :: Bucket
  , FileWriter -> ObjectId
_fwFilesId :: ObjectId
  , FileWriter -> Int
_fwChunkIndex :: Int
  , FileWriter -> Int64
_fwSize :: Int64
  , FileWriter -> ByteString
_fwAcc :: L.ByteString
  , FileWriter -> MD5Context
_fwMd5Context :: MD5Context
  , FileWriter -> ByteString
_fwMd5acc :: L.ByteString
  }

-- Finalize file, calculating md5 digest, saving the last chunk, and creating the file in the bucket
finalizeFile :: (Monad m, MonadIO m) => Text -> FileWriter -> Action m File
finalizeFile :: Text -> FileWriter -> Action m File
finalizeFile Text
filename (FileWriter Int64
chunkSize Bucket
bucket ObjectId
files_id Int
i Int64
size ByteString
acc MD5Context
md5context ByteString
md5acc) = do
  let md5digest :: MD5Digest
md5digest = MD5Context -> ByteString -> MD5Digest
finalizeMD5 MD5Context
md5context (ByteString -> ByteString
L.toStrict ByteString
md5acc)
  Bool -> ReaderT MongoContext m () -> ReaderT MongoContext m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int64
L.length ByteString
acc Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0) (ReaderT MongoContext m () -> ReaderT MongoContext m ())
-> ReaderT MongoContext m () -> ReaderT MongoContext m ()
forall a b. (a -> b) -> a -> b
$ Bucket
-> ObjectId -> Int -> ByteString -> ReaderT MongoContext m ()
forall (m :: * -> *).
(Monad m, MonadIO m) =>
Bucket -> ObjectId -> Int -> ByteString -> Action m ()
putChunk Bucket
bucket ObjectId
files_id Int
i ByteString
acc
  UTCTime
currentTimestamp <- IO UTCTime -> ReaderT MongoContext m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> ReaderT MongoContext m UTCTime)
-> IO UTCTime -> ReaderT MongoContext m UTCTime
forall a b. (a -> b) -> a -> b
$ IO UTCTime
getCurrentTime
  let doc :: Order
doc = [ Text
"_id" Text -> ObjectId -> Field
forall v. Val v => Text -> v -> Field
=: ObjectId
files_id
            , Text
"length" Text -> Int64 -> Field
forall v. Val v => Text -> v -> Field
=: Int64
size
            , Text
"uploadDate" Text -> UTCTime -> Field
forall v. Val v => Text -> v -> Field
=: UTCTime
currentTimestamp
            , Text
"md5" Text -> String -> Field
forall v. Val v => Text -> v -> Field
=: MD5Digest -> String
forall a. Show a => a -> String
show (MD5Digest
md5digest)
            , Text
"chunkSize" Text -> Int64 -> Field
forall v. Val v => Text -> v -> Field
=: Int64
chunkSize
            , Text
"filename" Text -> Text -> Field
forall v. Val v => Text -> v -> Field
=: Text
filename
            ]
  Text -> Order -> ReaderT MongoContext m ()
forall (m :: * -> *). MonadIO m => Text -> Order -> Action m ()
insert_ (Bucket -> Text
files Bucket
bucket) Order
doc
  File -> Action m File
forall (m :: * -> *) a. Monad m => a -> m a
return (File -> Action m File) -> File -> Action m File
forall a b. (a -> b) -> a -> b
$ Bucket -> Order -> File
File Bucket
bucket Order
doc

-- finalize the remainder and return the MD5Digest.
finalizeMD5 :: MD5Context -> S.ByteString -> MD5Digest
finalizeMD5 :: MD5Context -> ByteString -> MD5Digest
finalizeMD5 MD5Context
ctx ByteString
remainder =
  MD5Context -> ByteString -> MD5Digest
md5Finalize MD5Context
ctx2 (Int -> ByteString -> ByteString
S.drop Int
lu ByteString
remainder) -- can only handle max md5BlockSizeInBytes length
  where
    l :: Int
l = ByteString -> Int
S.length ByteString
remainder
    r :: Int
r = Int
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
md5BlockSizeInBytes
    lu :: Int
lu = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r
    ctx2 :: MD5Context
ctx2 = MD5Context -> ByteString -> MD5Context
md5Update MD5Context
ctx (Int -> ByteString -> ByteString
S.take Int
lu ByteString
remainder)

-- Write as many chunks as can be written from the file writer
writeChunks :: (Monad m, MonadIO m) => FileWriter -> L.ByteString -> Action m FileWriter
writeChunks :: FileWriter -> ByteString -> Action m FileWriter
writeChunks (FileWriter Int64
chunkSize Bucket
bucket ObjectId
files_id Int
i Int64
size ByteString
acc MD5Context
md5context ByteString
md5acc) ByteString
chunk = do
  -- Update md5 context
  let md5BlockLength :: Int64
md5BlockLength = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Tagged MD5Digest Int -> Int
forall k (s :: k) b. Tagged s b -> b
untag (Tagged MD5Digest Int
forall ctx d. Hash ctx d => Tagged d Int
blockLength :: Tagged MD5Digest Int)
  let md5acc_temp :: ByteString
md5acc_temp = (ByteString
md5acc ByteString -> ByteString -> ByteString
`L.append` ByteString
chunk)
  let (MD5Context
md5context', ByteString
md5acc') = 
        if (ByteString -> Int64
L.length ByteString
md5acc_temp Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
md5BlockLength)
        then (MD5Context
md5context, ByteString
md5acc_temp)
        else let numBlocks :: Int64
numBlocks = ByteString -> Int64
L.length ByteString
md5acc_temp Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
md5BlockLength
                 (ByteString
current, ByteString
remainder) = Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt (Int64
md5BlockLength Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
numBlocks) ByteString
md5acc_temp
             in (MD5Context -> ByteString -> MD5Context
md5Update MD5Context
md5context (ByteString -> ByteString
L.toStrict ByteString
current), ByteString
remainder)
  -- Update chunks
  let size' :: Int64
size' = (Int64
size Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
L.length ByteString
chunk)
  let acc_temp :: ByteString
acc_temp = (ByteString
acc ByteString -> ByteString -> ByteString
`L.append` ByteString
chunk)
  if (ByteString -> Int64
L.length ByteString
acc_temp Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
chunkSize)
    then FileWriter -> Action m FileWriter
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
-> Bucket
-> ObjectId
-> Int
-> Int64
-> ByteString
-> MD5Context
-> ByteString
-> FileWriter
FileWriter Int64
chunkSize Bucket
bucket ObjectId
files_id Int
i Int64
size' ByteString
acc_temp MD5Context
md5context' ByteString
md5acc')
    else do
      let (ByteString
newChunk, ByteString
acc') = Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt Int64
chunkSize ByteString
acc_temp
      Bucket -> ObjectId -> Int -> ByteString -> Action m ()
forall (m :: * -> *).
(Monad m, MonadIO m) =>
Bucket -> ObjectId -> Int -> ByteString -> Action m ()
putChunk Bucket
bucket ObjectId
files_id Int
i ByteString
newChunk
      FileWriter -> ByteString -> Action m FileWriter
forall (m :: * -> *).
(Monad m, MonadIO m) =>
FileWriter -> ByteString -> Action m FileWriter
writeChunks (Int64
-> Bucket
-> ObjectId
-> Int
-> Int64
-> ByteString
-> MD5Context
-> ByteString
-> FileWriter
FileWriter Int64
chunkSize Bucket
bucket ObjectId
files_id (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int64
size' ByteString
acc' MD5Context
md5context' ByteString
md5acc') ByteString
L.empty

sinkFile :: (Monad m, MonadIO m) => Bucket -> Text -> Consumer S.ByteString (Action m) File
-- ^ A consumer that creates a file in the bucket and puts all consumed data in it
sinkFile :: Bucket -> Text -> Consumer ByteString (Action m) File
sinkFile Bucket
bucket Text
filename = do
  ObjectId
files_id <- IO ObjectId -> ConduitT ByteString o (Action m) ObjectId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ObjectId -> ConduitT ByteString o (Action m) ObjectId)
-> IO ObjectId -> ConduitT ByteString o (Action m) ObjectId
forall a b. (a -> b) -> a -> b
$ IO ObjectId
genObjectId
  FileWriter -> ConduitT ByteString o (Action m) File
awaitChunk (FileWriter -> ConduitT ByteString o (Action m) File)
-> FileWriter -> ConduitT ByteString o (Action m) File
forall a b. (a -> b) -> a -> b
$ Int64
-> Bucket
-> ObjectId
-> Int
-> Int64
-> ByteString
-> MD5Context
-> ByteString
-> FileWriter
FileWriter Int64
defaultChunkSize Bucket
bucket ObjectId
files_id Int
0 Int64
0 ByteString
L.empty MD5Context
md5InitialContext ByteString
L.empty
 where
  awaitChunk :: FileWriter -> ConduitT ByteString o (Action m) File
awaitChunk FileWriter
fw = do
    Maybe ByteString
mchunk <- ConduitT ByteString o (Action m) (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
    case Maybe ByteString
mchunk of
      Maybe ByteString
Nothing -> ReaderT MongoContext m File
-> ConduitT ByteString o (Action m) File
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Text -> FileWriter -> ReaderT MongoContext m File
forall (m :: * -> *).
(Monad m, MonadIO m) =>
Text -> FileWriter -> Action m File
finalizeFile Text
filename FileWriter
fw)
      Just ByteString
chunk -> ReaderT MongoContext m FileWriter
-> ConduitT ByteString o (Action m) FileWriter
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FileWriter -> ByteString -> ReaderT MongoContext m FileWriter
forall (m :: * -> *).
(Monad m, MonadIO m) =>
FileWriter -> ByteString -> Action m FileWriter
writeChunks FileWriter
fw (ByteString -> ByteString
L.fromStrict ByteString
chunk)) ConduitT ByteString o (Action m) FileWriter
-> (FileWriter -> ConduitT ByteString o (Action m) File)
-> ConduitT ByteString o (Action m) File
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FileWriter -> ConduitT ByteString o (Action m) File
awaitChunk