{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ViewPatterns #-}
module Network.AWS.Internal.Body where
import Control.Monad
import Control.Monad.IO.Class
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
import Data.Void (Void)
getFileSize :: MonadIO m => FilePath -> m Integer
getFileSize path = liftIO (withBinaryFile path ReadMode hFileSize)
sinkBody :: MonadIO m => RsBody -> ConduitM ByteString Void (ResourceT IO) a -> m a
sinkBody (RsBody body) sink = liftIO $ runConduitRes $ body .| sink
hashedFile :: MonadIO m
=> FilePath
-> m HashedBody
hashedFile path =
liftIO $ HashedStream
<$> runResourceT (Conduit.sourceFile path `connect` sinkSHA256)
<*> getFileSize path
<*> pure (Conduit.sourceFile path)
hashedFileRange :: MonadIO m
=> FilePath
-> Integer
-> Integer
-> m HashedBody
hashedFileRange path (Just -> offset) (Just -> len) =
liftIO $ HashedStream
<$> runResourceT (Conduit.sourceFileRange path offset len `connect` sinkSHA256)
<*> getFileSize path
<*> pure (Conduit.sourceFileRange path offset len)
hashedBody :: Digest SHA256
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
-> HashedBody
hashedBody = HashedStream
chunkedFile :: MonadIO m => ChunkSize -> FilePath -> m RqBody
chunkedFile chunk path = do
size <- getFileSize path
if size > toInteger chunk
then return $ unsafeChunkedBody chunk size (sourceFileChunks chunk path)
else Hashed `liftM` hashedFile path
chunkedFileRange :: MonadIO m
=> ChunkSize
-> FilePath
-> Integer
-> Integer
-> m RqBody
chunkedFileRange chunk path offset len = do
size <- getFileSize path
let n = min (size - offset) len
if n > toInteger chunk
then return $ unsafeChunkedBody chunk n (sourceFileRangeChunks chunk path offset len)
else Hashed `liftM` hashedFileRange path offset len
unsafeChunkedBody :: ChunkSize
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
-> RqBody
unsafeChunkedBody chunk size = Chunked . ChunkedBody chunk size
sourceFileChunks :: MonadResource m
=> ChunkSize
-> FilePath
-> ConduitM () ByteString m ()
sourceFileChunks (ChunkSize chunk) path =
bracketP (openBinaryFile path ReadMode) hClose go
where
go hd = do
bs <- liftIO (BS.hGet hd chunk)
unless (BS.null bs) $ do
yield bs
go hd
sourceFileRangeChunks :: MonadResource m
=> ChunkSize
-> FilePath
-> Integer
-> Integer
-> ConduitM () ByteString m ()
sourceFileRangeChunks (ChunkSize chunk) path offset len =
bracketP acquire hClose seek
where
acquire = openBinaryFile path ReadMode
seek hd = liftIO (hSeek hd AbsoluteSeek offset) >> go (fromIntegral len) hd
go remainder hd
| remainder <= chunk = do
bs <- liftIO (BS.hGet hd remainder)
unless (BS.null bs) $
yield bs
| otherwise = do
bs <- liftIO (BS.hGet hd chunk)
unless (BS.null bs) $ do
yield bs
go (remainder - chunk) hd
sinkMD5 :: Monad m => ConduitM ByteString o m (Digest MD5)
sinkMD5 = sinkHash
sinkSHA256 :: Monad m => ConduitM ByteString o m (Digest SHA256)
sinkSHA256 = sinkHash
sinkHash :: (Monad m, HashAlgorithm a) => ConduitM ByteString o m (Digest a)
sinkHash = sink hashInit
where
sink ctx = do
mbs <- await
case mbs of
Nothing -> return $! hashFinalize ctx
Just bs -> sink $! hashUpdate ctx bs