{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Network.AWS.Internal.Body where
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Morph
import Control.Monad.Trans.Resource
import qualified Data.ByteString as BS
import Data.Conduit
import qualified Data.Conduit.Binary as Conduit
import Network.AWS.Prelude
import System.IO
getFileSize :: MonadIO m => FilePath -> m Integer
getFileSize f = liftIO (withBinaryFile f ReadMode hFileSize)
sinkBody :: MonadResource m => RsBody -> Sink ByteString m a -> m a
sinkBody (RsBody s) sink = hoist liftResourceT s $$+- sink
hashedFile :: MonadIO m => FilePath -> m HashedBody
hashedFile f = liftIO $ HashedStream
<$> runResourceT (Conduit.sourceFile f $$ sinkSHA256)
<*> getFileSize f
<*> pure (Conduit.sourceFile f)
hashedBody :: Digest SHA256
-> Integer
-> Source (ResourceT IO) ByteString
-> HashedBody
hashedBody h n = HashedStream h n
chunkedFile :: MonadIO m => ChunkSize -> FilePath -> m RqBody
chunkedFile c f = do
n <- getFileSize f
if n > toInteger c
then return $ unsafeChunkedBody c n (sourceFileChunks c f)
else Hashed `liftM` hashedFile f
unsafeChunkedBody :: ChunkSize
-> Integer
-> Source (ResourceT IO) ByteString
-> RqBody
unsafeChunkedBody c n = Chunked . ChunkedBody c n
sourceFileChunks :: MonadResource m
=> ChunkSize
-> FilePath
-> Source m ByteString
sourceFileChunks (ChunkSize sz) f =
bracketP (openBinaryFile f ReadMode) hClose go
where
go h = do
bs <- liftIO (BS.hGet h sz)
unless (BS.null bs) $ do
yield bs
go h
sinkMD5 :: Monad m => Consumer ByteString m (Digest MD5)
sinkMD5 = sinkHash
sinkSHA256 :: Monad m => Consumer ByteString m (Digest SHA256)
sinkSHA256 = sinkHash
sinkHash :: (Monad m, HashAlgorithm a) => Consumer ByteString m (Digest a)
sinkHash = sink hashInit
where
sink ctx = do
b <- await
case b of
Nothing -> return $! hashFinalize ctx
Just bs -> sink $! hashUpdate ctx bs