module Network.AWS.Data.Internal.Body where
import Control.Lens
import Control.Applicative
import Control.Monad.IO.Class
import Control.Monad.Morph
import Control.Monad.Trans.Resource
import Crypto.Hash
import qualified Crypto.Hash.Conduit as Conduit
import Data.Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Char8 as LBS8
import Data.Conduit
import qualified Data.Conduit.Binary as Conduit
import Data.IORef
import Data.Int
import Data.Monoid
import Data.String
import qualified Data.Text as Text
import Network.AWS.Data.Internal.Text
import Network.HTTP.Client
import System.IO
data RsBody = RsBody (ResumableSource (ResourceT IO) ByteString)
makePrisms ''RsBody
connectBody :: MonadResource m => RsBody -> Sink ByteString m a -> m a
connectBody (RsBody src) sink = hoist liftResourceT src $$+- sink
instance ToText RsBody where
toText = const "RsBody <body>"
instance Show RsBody where
show = Text.unpack . toText
data RqBody = RqBody
{ _bdyHash :: Digest SHA256
, _bdyBody :: RequestBody
}
makeLenses ''RqBody
bodyHash :: RqBody -> ByteString
bodyHash = digestToHexByteString . _bdyHash
instance ToText RqBody where
toText (RqBody h _) = "RqBody " <> toText h <> " <body>"
instance Show RqBody where
show = Text.unpack . toText
instance IsString RqBody where
fromString = toBody . LBS8.pack
class ToBody a where
toBody :: a -> RqBody
toBody = const (RqBody (hash "") (RequestBodyLBS mempty))
instance ToBody RqBody where
toBody = id
instance ToBody LBS.ByteString where
toBody lbs = RqBody (hashlazy lbs) (RequestBodyLBS lbs)
instance ToBody ByteString where
toBody = toBody . LBS.fromStrict
instance ToBody Value where
toBody = toBody . encode
sourceBody :: Digest SHA256 -> Int64 -> Source IO ByteString -> RqBody
sourceBody h n = RqBody h . RequestBodyStream n . sourcePopper
sourceHandle :: Digest SHA256 -> Int64 -> Handle -> RqBody
sourceHandle h n = sourceBody h n . Conduit.sourceHandle
sourceFile :: Digest SHA256 -> Int64 -> FilePath -> RqBody
sourceFile h n = sourceBody h n . hoist runResourceT . Conduit.sourceFile
sourceFileIO :: MonadIO m => FilePath -> m RqBody
sourceFileIO f = liftIO $ sourceFile
<$> runResourceT (Conduit.sourceFile f $$ Conduit.sinkHash)
<*> (fromIntegral <$> withBinaryFile f ReadMode hFileSize)
<*> pure f
sourcePopper :: Source IO ByteString -> GivesPopper ()
sourcePopper src f = do
(rsrc0, ()) <- src $$+ return ()
irsrc <- newIORef rsrc0
let popper :: IO ByteString
popper = do
rsrc <- readIORef irsrc
(rsrc', mres) <- rsrc $$++ await
writeIORef irsrc rsrc'
case mres of
Nothing -> return mempty
Just bs
| BS.null bs -> popper
| otherwise -> return bs
f popper