{-# LANGUAGE CPP #-}

-- |
-- Module      : Amazonka.Data.Body
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.Data.Body where

import qualified Amazonka.Bytes as Bytes
import Amazonka.Core.Lens.Internal (coerced)
import Amazonka.Crypto (Digest, SHA256)
import qualified Amazonka.Crypto as Crypto
import Amazonka.Data.ByteString
import Amazonka.Data.Log
import Amazonka.Data.Query (QueryString)
import Amazonka.Data.XML (encodeXML)
import Amazonka.Prelude hiding (length)
import Control.Monad.Trans.Resource (ResourceT, runResourceT)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy.Char8 as LBS8
import Data.Conduit (ConduitM, (.|))
import qualified Data.Conduit as Conduit
import qualified Data.Conduit.Binary as Conduit.Binary
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy.Encoding as LText
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Conduit as Client.Conduit
import qualified System.IO as IO
import qualified Text.XML as XML

#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap (KeyMap)
#endif

-- | Convenience function for obtaining the size of a file.
getFileSize :: MonadIO m => FilePath -> m Integer
getFileSize :: forall (m :: * -> *). MonadIO m => FilePath -> m Integer
getFileSize FilePath
path = IO Integer -> m Integer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IOMode -> (Handle -> IO Integer) -> IO Integer
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
IO.withBinaryFile FilePath
path IOMode
IO.ReadMode Handle -> IO Integer
IO.hFileSize)

-- | A streaming, exception safe response body.
--
-- @newtype@ for show/orhpan instance purposes.
newtype ResponseBody = ResponseBody
  {ResponseBody -> ConduitM () ByteString (ResourceT IO) ()
body :: ConduitM () ByteString (ResourceT IO) ()}
  deriving stock ((forall x. ResponseBody -> Rep ResponseBody x)
-> (forall x. Rep ResponseBody x -> ResponseBody)
-> Generic ResponseBody
forall x. Rep ResponseBody x -> ResponseBody
forall x. ResponseBody -> Rep ResponseBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResponseBody -> Rep ResponseBody x
from :: forall x. ResponseBody -> Rep ResponseBody x
$cto :: forall x. Rep ResponseBody x -> ResponseBody
to :: forall x. Rep ResponseBody x -> ResponseBody
Generic)

instance Show ResponseBody where
  show :: ResponseBody -> FilePath
show = FilePath -> ResponseBody -> FilePath
forall a b. a -> b -> a
const FilePath
"ResponseBody { ConduitM () ByteString (ResourceT IO) () }"

{-# INLINE _ResponseBody #-}
_ResponseBody :: Iso' ResponseBody (ConduitM () ByteString (ResourceT IO) ())
_ResponseBody :: Iso' ResponseBody (ConduitM () ByteString (ResourceT IO) ())
_ResponseBody = p (ConduitM () ByteString (ResourceT IO) ())
  (f (ConduitM () ByteString (ResourceT IO) ()))
-> p ResponseBody (f ResponseBody)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso' ResponseBody (ConduitM () ByteString (ResourceT IO) ())
coerced

fuseStream ::
  ResponseBody ->
  ConduitM ByteString ByteString (ResourceT IO) () ->
  ResponseBody
fuseStream :: ResponseBody
-> ConduitM ByteString ByteString (ResourceT IO) () -> ResponseBody
fuseStream b :: ResponseBody
b@ResponseBody {ConduitM () ByteString (ResourceT IO) ()
$sel:body:ResponseBody :: ResponseBody -> ConduitM () ByteString (ResourceT IO) ()
body :: ConduitM () ByteString (ResourceT IO) ()
body} ConduitM ByteString ByteString (ResourceT IO) ()
f = ResponseBody
b {$sel:body:ResponseBody :: ConduitM () ByteString (ResourceT IO) ()
body = ConduitM () ByteString (ResourceT IO) ()
body ConduitM () ByteString (ResourceT IO) ()
-> ConduitM ByteString ByteString (ResourceT IO) ()
-> ConduitM () ByteString (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitM ByteString ByteString (ResourceT IO) ()
f}

-- | Connect a 'Sink' to a response stream.
sinkBody :: MonadIO m => ResponseBody -> ConduitM ByteString Void (ResourceT IO) a -> m a
sinkBody :: forall (m :: * -> *) a.
MonadIO m =>
ResponseBody -> ConduitM ByteString Void (ResourceT IO) a -> m a
sinkBody (ResponseBody ConduitM () ByteString (ResourceT IO) ()
body) ConduitM ByteString Void (ResourceT IO) a
sink =
  IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ ConduitT () Void (ResourceT IO) a -> IO a
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
Conduit.runConduitRes (ConduitT () Void (ResourceT IO) a -> IO a)
-> ConduitT () Void (ResourceT IO) a -> IO a
forall a b. (a -> b) -> a -> b
$ ConduitM () ByteString (ResourceT IO) ()
body ConduitM () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) a
-> ConduitT () Void (ResourceT IO) a
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitM ByteString Void (ResourceT IO) a
sink

-- | Specifies the transmitted size of the 'Transfer-Encoding' chunks.
--
-- /See:/ 'defaultChunk'.
newtype ChunkSize = ChunkSize Int
  deriving stock (ChunkSize -> ChunkSize -> Bool
(ChunkSize -> ChunkSize -> Bool)
-> (ChunkSize -> ChunkSize -> Bool) -> Eq ChunkSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChunkSize -> ChunkSize -> Bool
== :: ChunkSize -> ChunkSize -> Bool
$c/= :: ChunkSize -> ChunkSize -> Bool
/= :: ChunkSize -> ChunkSize -> Bool
Eq, Eq ChunkSize
Eq ChunkSize
-> (ChunkSize -> ChunkSize -> Ordering)
-> (ChunkSize -> ChunkSize -> Bool)
-> (ChunkSize -> ChunkSize -> Bool)
-> (ChunkSize -> ChunkSize -> Bool)
-> (ChunkSize -> ChunkSize -> Bool)
-> (ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize -> ChunkSize)
-> Ord ChunkSize
ChunkSize -> ChunkSize -> Bool
ChunkSize -> ChunkSize -> Ordering
ChunkSize -> ChunkSize -> ChunkSize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ChunkSize -> ChunkSize -> Ordering
compare :: ChunkSize -> ChunkSize -> Ordering
$c< :: ChunkSize -> ChunkSize -> Bool
< :: ChunkSize -> ChunkSize -> Bool
$c<= :: ChunkSize -> ChunkSize -> Bool
<= :: ChunkSize -> ChunkSize -> Bool
$c> :: ChunkSize -> ChunkSize -> Bool
> :: ChunkSize -> ChunkSize -> Bool
$c>= :: ChunkSize -> ChunkSize -> Bool
>= :: ChunkSize -> ChunkSize -> Bool
$cmax :: ChunkSize -> ChunkSize -> ChunkSize
max :: ChunkSize -> ChunkSize -> ChunkSize
$cmin :: ChunkSize -> ChunkSize -> ChunkSize
min :: ChunkSize -> ChunkSize -> ChunkSize
Ord, Int -> ChunkSize -> ShowS
[ChunkSize] -> ShowS
ChunkSize -> FilePath
(Int -> ChunkSize -> ShowS)
-> (ChunkSize -> FilePath)
-> ([ChunkSize] -> ShowS)
-> Show ChunkSize
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChunkSize -> ShowS
showsPrec :: Int -> ChunkSize -> ShowS
$cshow :: ChunkSize -> FilePath
show :: ChunkSize -> FilePath
$cshowList :: [ChunkSize] -> ShowS
showList :: [ChunkSize] -> ShowS
Show)
  deriving newtype (Int -> ChunkSize
ChunkSize -> Int
ChunkSize -> [ChunkSize]
ChunkSize -> ChunkSize
ChunkSize -> ChunkSize -> [ChunkSize]
ChunkSize -> ChunkSize -> ChunkSize -> [ChunkSize]
(ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize)
-> (Int -> ChunkSize)
-> (ChunkSize -> Int)
-> (ChunkSize -> [ChunkSize])
-> (ChunkSize -> ChunkSize -> [ChunkSize])
-> (ChunkSize -> ChunkSize -> [ChunkSize])
-> (ChunkSize -> ChunkSize -> ChunkSize -> [ChunkSize])
-> Enum ChunkSize
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ChunkSize -> ChunkSize
succ :: ChunkSize -> ChunkSize
$cpred :: ChunkSize -> ChunkSize
pred :: ChunkSize -> ChunkSize
$ctoEnum :: Int -> ChunkSize
toEnum :: Int -> ChunkSize
$cfromEnum :: ChunkSize -> Int
fromEnum :: ChunkSize -> Int
$cenumFrom :: ChunkSize -> [ChunkSize]
enumFrom :: ChunkSize -> [ChunkSize]
$cenumFromThen :: ChunkSize -> ChunkSize -> [ChunkSize]
enumFromThen :: ChunkSize -> ChunkSize -> [ChunkSize]
$cenumFromTo :: ChunkSize -> ChunkSize -> [ChunkSize]
enumFromTo :: ChunkSize -> ChunkSize -> [ChunkSize]
$cenumFromThenTo :: ChunkSize -> ChunkSize -> ChunkSize -> [ChunkSize]
enumFromThenTo :: ChunkSize -> ChunkSize -> ChunkSize -> [ChunkSize]
Enum, Integer -> ChunkSize
ChunkSize -> ChunkSize
ChunkSize -> ChunkSize -> ChunkSize
(ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize)
-> (Integer -> ChunkSize)
-> Num ChunkSize
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChunkSize -> ChunkSize -> ChunkSize
+ :: ChunkSize -> ChunkSize -> ChunkSize
$c- :: ChunkSize -> ChunkSize -> ChunkSize
- :: ChunkSize -> ChunkSize -> ChunkSize
$c* :: ChunkSize -> ChunkSize -> ChunkSize
* :: ChunkSize -> ChunkSize -> ChunkSize
$cnegate :: ChunkSize -> ChunkSize
negate :: ChunkSize -> ChunkSize
$cabs :: ChunkSize -> ChunkSize
abs :: ChunkSize -> ChunkSize
$csignum :: ChunkSize -> ChunkSize
signum :: ChunkSize -> ChunkSize
$cfromInteger :: Integer -> ChunkSize
fromInteger :: Integer -> ChunkSize
Num, Num ChunkSize
Ord ChunkSize
Num ChunkSize
-> Ord ChunkSize -> (ChunkSize -> Rational) -> Real ChunkSize
ChunkSize -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
$ctoRational :: ChunkSize -> Rational
toRational :: ChunkSize -> Rational
Real, Enum ChunkSize
Real ChunkSize
Real ChunkSize
-> Enum ChunkSize
-> (ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize -> (ChunkSize, ChunkSize))
-> (ChunkSize -> ChunkSize -> (ChunkSize, ChunkSize))
-> (ChunkSize -> Integer)
-> Integral ChunkSize
ChunkSize -> Integer
ChunkSize -> ChunkSize -> (ChunkSize, ChunkSize)
ChunkSize -> ChunkSize -> ChunkSize
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ChunkSize -> ChunkSize -> ChunkSize
quot :: ChunkSize -> ChunkSize -> ChunkSize
$crem :: ChunkSize -> ChunkSize -> ChunkSize
rem :: ChunkSize -> ChunkSize -> ChunkSize
$cdiv :: ChunkSize -> ChunkSize -> ChunkSize
div :: ChunkSize -> ChunkSize -> ChunkSize
$cmod :: ChunkSize -> ChunkSize -> ChunkSize
mod :: ChunkSize -> ChunkSize -> ChunkSize
$cquotRem :: ChunkSize -> ChunkSize -> (ChunkSize, ChunkSize)
quotRem :: ChunkSize -> ChunkSize -> (ChunkSize, ChunkSize)
$cdivMod :: ChunkSize -> ChunkSize -> (ChunkSize, ChunkSize)
divMod :: ChunkSize -> ChunkSize -> (ChunkSize, ChunkSize)
$ctoInteger :: ChunkSize -> Integer
toInteger :: ChunkSize -> Integer
Integral)

instance ToLog ChunkSize where
  build :: ChunkSize -> ByteStringBuilder
build = FilePath -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build (FilePath -> ByteStringBuilder)
-> (ChunkSize -> FilePath) -> ChunkSize -> ByteStringBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkSize -> FilePath
forall a. Show a => a -> FilePath
show

_ChunkSize :: Iso' ChunkSize Int
_ChunkSize :: Iso' ChunkSize Int
_ChunkSize = p Int (f Int) -> p ChunkSize (f ChunkSize)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso' ChunkSize Int
coerced

-- | The default chunk size of 128 KB. The minimum chunk size accepted by
-- AWS is 8 KB, unless the entirety of the request is below this threshold.
--
-- A chunk size of 64 KB or higher is recommended for performance reasons.
defaultChunkSize :: ChunkSize
defaultChunkSize :: ChunkSize
defaultChunkSize = ChunkSize
128 ChunkSize -> ChunkSize -> ChunkSize
forall a. Num a => a -> a -> a
* ChunkSize
1024

-- | An opaque request body which will be transmitted via
-- @Transfer-Encoding: chunked@.
--
-- /Invariant:/ Only services that support chunked encoding can
-- accept a 'ChunkedBody'. (Currently S3.) This is enforced by the type
-- signatures emitted by the generator.
data ChunkedBody = ChunkedBody
  { ChunkedBody -> ChunkSize
size :: ChunkSize,
    ChunkedBody -> Integer
length :: Integer,
    ChunkedBody -> ConduitM () ByteString (ResourceT IO) ()
body :: ConduitM () ByteString (ResourceT IO) ()
  }

{-# INLINE chunkedBody_size #-}
chunkedBody_size :: Lens' ChunkedBody ChunkSize
chunkedBody_size :: Lens' ChunkedBody ChunkSize
chunkedBody_size ChunkSize -> f ChunkSize
f b :: ChunkedBody
b@ChunkedBody {ChunkSize
$sel:size:ChunkedBody :: ChunkedBody -> ChunkSize
size :: ChunkSize
size} = ChunkSize -> f ChunkSize
f ChunkSize
size f ChunkSize -> (ChunkSize -> ChunkedBody) -> f ChunkedBody
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ChunkSize
size' -> ChunkedBody
b {$sel:size:ChunkedBody :: ChunkSize
size = ChunkSize
size'}

{-# INLINE chunkedBody_length #-}
chunkedBody_length :: Lens' ChunkedBody Integer
chunkedBody_length :: Lens' ChunkedBody Integer
chunkedBody_length Integer -> f Integer
f b :: ChunkedBody
b@ChunkedBody {Integer
$sel:length:ChunkedBody :: ChunkedBody -> Integer
length :: Integer
length} = Integer -> f Integer
f Integer
length f Integer -> (Integer -> ChunkedBody) -> f ChunkedBody
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Integer
length' -> ChunkedBody
b {$sel:length:ChunkedBody :: Integer
length = Integer
length'}

{-# INLINE chunkedBody_body #-}
chunkedBody_body :: Lens' ChunkedBody (ConduitM () ByteString (ResourceT IO) ())
chunkedBody_body :: Lens' ChunkedBody (ConduitM () ByteString (ResourceT IO) ())
chunkedBody_body ConduitM () ByteString (ResourceT IO) ()
-> f (ConduitM () ByteString (ResourceT IO) ())
f b :: ChunkedBody
b@ChunkedBody {ConduitM () ByteString (ResourceT IO) ()
$sel:body:ChunkedBody :: ChunkedBody -> ConduitM () ByteString (ResourceT IO) ()
body :: ConduitM () ByteString (ResourceT IO) ()
body} = ConduitM () ByteString (ResourceT IO) ()
-> f (ConduitM () ByteString (ResourceT IO) ())
f ConduitM () ByteString (ResourceT IO) ()
body f (ConduitM () ByteString (ResourceT IO) ())
-> (ConduitM () ByteString (ResourceT IO) () -> ChunkedBody)
-> f ChunkedBody
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ConduitM () ByteString (ResourceT IO) ()
body' -> (ChunkedBody
b :: ChunkedBody) {$sel:body:ChunkedBody :: ConduitM () ByteString (ResourceT IO) ()
body = ConduitM () ByteString (ResourceT IO) ()
body'}

-- Maybe revert to using Source's, and then enforce the chunk size
-- during conversion from HashedBody -> ChunkedBody

instance Show ChunkedBody where
  show :: ChunkedBody -> FilePath
show ChunkedBody
c =
    ByteString -> FilePath
BS8.unpack (ByteString -> FilePath)
-> (ByteStringBuilder -> ByteString)
-> ByteStringBuilder
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringBuilder -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (ByteStringBuilder -> FilePath) -> ByteStringBuilder -> FilePath
forall a b. (a -> b) -> a -> b
$
      ByteStringBuilder
"ChunkedBody { chunkSize = "
        ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ChunkSize -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build (ChunkedBody -> ChunkSize
size ChunkedBody
c)
        ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"<> originalLength = "
        ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Integer -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build (ChunkedBody -> Integer
length ChunkedBody
c)
        ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"<> fullChunks = "
        ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Integer -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build (ChunkedBody -> Integer
fullChunks ChunkedBody
c)
        ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"<> remainderBytes = "
        ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Maybe Integer -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build (ChunkedBody -> Maybe Integer
remainderBytes ChunkedBody
c)
        ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"}"

fuseChunks ::
  ChunkedBody ->
  ConduitM ByteString ByteString (ResourceT IO) () ->
  ChunkedBody
fuseChunks :: ChunkedBody
-> ConduitM ByteString ByteString (ResourceT IO) () -> ChunkedBody
fuseChunks c :: ChunkedBody
c@ChunkedBody {ConduitM () ByteString (ResourceT IO) ()
$sel:body:ChunkedBody :: ChunkedBody -> ConduitM () ByteString (ResourceT IO) ()
body :: ConduitM () ByteString (ResourceT IO) ()
body} ConduitM ByteString ByteString (ResourceT IO) ()
f = ChunkedBody
c {$sel:body:ChunkedBody :: ConduitM () ByteString (ResourceT IO) ()
body = ConduitM () ByteString (ResourceT IO) ()
body ConduitM () ByteString (ResourceT IO) ()
-> ConduitM ByteString ByteString (ResourceT IO) ()
-> ConduitM () ByteString (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitM ByteString ByteString (ResourceT IO) ()
f}

fullChunks :: ChunkedBody -> Integer
fullChunks :: ChunkedBody -> Integer
fullChunks ChunkedBody
c = ChunkedBody -> Integer
length ChunkedBody
c Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` ChunkSize -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ChunkedBody -> ChunkSize
size ChunkedBody
c)

remainderBytes :: ChunkedBody -> Maybe Integer
remainderBytes :: ChunkedBody -> Maybe Integer
remainderBytes ChunkedBody {Integer
$sel:length:ChunkedBody :: ChunkedBody -> Integer
length :: Integer
length, ChunkSize
$sel:size:ChunkedBody :: ChunkedBody -> ChunkSize
size :: ChunkSize
size} =
  case Integer
length Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` ChunkSize -> Integer
forall a. Integral a => a -> Integer
toInteger ChunkSize
size of
    Integer
0 -> Maybe Integer
forall a. Maybe a
Nothing
    Integer
n -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n

-- | Construct a 'ChunkedBody' from a 'FilePath', where the contents will be
-- read and signed incrementally in chunks if the target service supports it.
--
-- Will intelligently revert to 'HashedBody' if the file is smaller than the
-- specified 'ChunkSize'.
--
-- /See:/ 'ToBody'.
chunkedFile :: MonadIO m => ChunkSize -> FilePath -> m RequestBody
chunkedFile :: forall (m :: * -> *).
MonadIO m =>
ChunkSize -> FilePath -> m RequestBody
chunkedFile ChunkSize
chunk FilePath
path = do
  Integer
size <- FilePath -> m Integer
forall (m :: * -> *). MonadIO m => FilePath -> m Integer
getFileSize FilePath
path
  if Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> ChunkSize -> Integer
forall a. Integral a => a -> Integer
toInteger ChunkSize
chunk
    then RequestBody -> m RequestBody
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RequestBody -> m RequestBody) -> RequestBody -> m RequestBody
forall a b. (a -> b) -> a -> b
$ ChunkSize
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
-> RequestBody
unsafeChunkedBody ChunkSize
chunk Integer
size (ChunkSize -> FilePath -> ConduitM () ByteString (ResourceT IO) ()
forall (m :: * -> *).
MonadResource m =>
ChunkSize -> FilePath -> ConduitM () ByteString m ()
sourceFileChunks ChunkSize
chunk FilePath
path)
    else HashedBody -> RequestBody
Hashed (HashedBody -> RequestBody) -> m HashedBody -> m RequestBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m HashedBody
forall (m :: * -> *). MonadIO m => FilePath -> m HashedBody
hashedFile FilePath
path

-- | Construct a 'ChunkedBody' from a 'FilePath', specifying the range of bytes
-- to read. This can be useful for constructing multiple requests from a single
-- file, say for S3 multipart uploads.
--
-- /See:/ 'chunkedFile'.
chunkedFileRange ::
  MonadIO m =>
  -- | The idealized size of chunks that will be yielded downstream.
  ChunkSize ->
  -- | The file path to read.
  FilePath ->
  -- | The byte offset at which to start reading.
  Integer ->
  -- | The maximum number of bytes to read.
  Integer ->
  m RequestBody
chunkedFileRange :: forall (m :: * -> *).
MonadIO m =>
ChunkSize -> FilePath -> Integer -> Integer -> m RequestBody
chunkedFileRange ChunkSize
chunk FilePath
path Integer
offset Integer
len = do
  Integer
size <- FilePath -> m Integer
forall (m :: * -> *). MonadIO m => FilePath -> m Integer
getFileSize FilePath
path
  let n :: Integer
n = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min (Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
offset) Integer
len
  if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> ChunkSize -> Integer
forall a. Integral a => a -> Integer
toInteger ChunkSize
chunk
    then RequestBody -> m RequestBody
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RequestBody -> m RequestBody) -> RequestBody -> m RequestBody
forall a b. (a -> b) -> a -> b
$ ChunkSize
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
-> RequestBody
unsafeChunkedBody ChunkSize
chunk Integer
n (ChunkSize
-> FilePath
-> Integer
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
forall (m :: * -> *).
MonadResource m =>
ChunkSize
-> FilePath -> Integer -> Integer -> ConduitM () ByteString m ()
sourceFileRangeChunks ChunkSize
chunk FilePath
path Integer
offset Integer
len)
    else HashedBody -> RequestBody
Hashed (HashedBody -> RequestBody) -> m HashedBody -> m RequestBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Integer -> Integer -> m HashedBody
forall (m :: * -> *).
MonadIO m =>
FilePath -> Integer -> Integer -> m HashedBody
hashedFileRange FilePath
path Integer
offset Integer
len

-- | Unsafely construct a 'ChunkedBody'.
--
-- This function is marked unsafe because it does nothing to enforce the chunk size.
-- Typically for conduit 'IO' functions, it's whatever ByteString's
-- 'defaultBufferSize' is, around 32 KB. If the chunk size is less than 8 KB,
-- the request will error. 64 KB or higher chunk size is recommended for
-- performance reasons.
--
-- Note that it will always create a chunked body even if the request
-- is too small.
--
-- /See:/ 'ToBody'.
unsafeChunkedBody ::
  -- | The idealized size of chunks that will be yielded downstream.
  ChunkSize ->
  -- | The size of the stream in bytes.
  Integer ->
  ConduitM () ByteString (ResourceT IO) () ->
  RequestBody
unsafeChunkedBody :: ChunkSize
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
-> RequestBody
unsafeChunkedBody ChunkSize
chunk Integer
size = ChunkedBody -> RequestBody
Chunked (ChunkedBody -> RequestBody)
-> (ConduitM () ByteString (ResourceT IO) () -> ChunkedBody)
-> ConduitM () ByteString (ResourceT IO) ()
-> RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkSize
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
-> ChunkedBody
ChunkedBody ChunkSize
chunk Integer
size

sourceFileChunks ::
  MonadResource m =>
  ChunkSize ->
  FilePath ->
  ConduitM () ByteString m ()
sourceFileChunks :: forall (m :: * -> *).
MonadResource m =>
ChunkSize -> FilePath -> ConduitM () ByteString m ()
sourceFileChunks (ChunkSize Int
chunk) FilePath
path =
  IO Handle
-> (Handle -> IO ())
-> (Handle -> ConduitT () ByteString m ())
-> ConduitT () ByteString m ()
forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
Conduit.bracketP (FilePath -> IOMode -> IO Handle
IO.openBinaryFile FilePath
path IOMode
IO.ReadMode) Handle -> IO ()
IO.hClose Handle -> ConduitT () ByteString m ()
go
  where
    -- Uses hGet with a specific buffer size, instead of hGetSome.
    go :: Handle -> ConduitT () ByteString m ()
go Handle
hd = do
      ByteString
bs <- IO ByteString -> ConduitT () ByteString m ByteString
forall a. IO a -> ConduitT () ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Int -> IO ByteString
BS.hGet Handle
hd Int
chunk)
      Bool -> ConduitT () ByteString m () -> ConduitT () ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
bs) (ConduitT () ByteString m () -> ConduitT () ByteString m ())
-> ConduitT () ByteString m () -> ConduitT () ByteString m ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> ConduitT () ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
Conduit.yield ByteString
bs
        Handle -> ConduitT () ByteString m ()
go Handle
hd

sourceFileRangeChunks ::
  MonadResource m =>
  -- | The idealized size of chunks that will be yielded downstream.
  ChunkSize ->
  -- | The file path to read.
  FilePath ->
  -- | The byte offset at which to start reading.
  Integer ->
  -- | The maximum number of bytes to read.
  Integer ->
  ConduitM () ByteString m ()
sourceFileRangeChunks :: forall (m :: * -> *).
MonadResource m =>
ChunkSize
-> FilePath -> Integer -> Integer -> ConduitM () ByteString m ()
sourceFileRangeChunks (ChunkSize Int
chunk) FilePath
path Integer
offset Integer
len =
  IO Handle
-> (Handle -> IO ())
-> (Handle -> ConduitT () ByteString m ())
-> ConduitT () ByteString m ()
forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
Conduit.bracketP IO Handle
acquire Handle -> IO ()
IO.hClose Handle -> ConduitT () ByteString m ()
seek
  where
    acquire :: IO Handle
acquire = FilePath -> IOMode -> IO Handle
IO.openBinaryFile FilePath
path IOMode
IO.ReadMode
    seek :: Handle -> ConduitT () ByteString m ()
seek Handle
hd = do
      IO () -> ConduitT () ByteString m ()
forall a. IO a -> ConduitT () ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
hd SeekMode
IO.AbsoluteSeek Integer
offset)
      Int -> Handle -> ConduitT () ByteString m ()
go (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
len) Handle
hd

    go :: Int -> Handle -> ConduitT () ByteString m ()
go Int
remainder Handle
hd
      | Int
remainder Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
chunk = do
          ByteString
bs <- IO ByteString -> ConduitT () ByteString m ByteString
forall a. IO a -> ConduitT () ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Int -> IO ByteString
BS.hGet Handle
hd Int
remainder)
          Bool -> ConduitT () ByteString m () -> ConduitT () ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
bs) (ConduitT () ByteString m () -> ConduitT () ByteString m ())
-> ConduitT () ByteString m () -> ConduitT () ByteString m ()
forall a b. (a -> b) -> a -> b
$
            ByteString -> ConduitT () ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
Conduit.yield ByteString
bs
      --
      | Bool
otherwise = do
          ByteString
bs <- IO ByteString -> ConduitT () ByteString m ByteString
forall a. IO a -> ConduitT () ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Int -> IO ByteString
BS.hGet Handle
hd Int
chunk)

          Bool -> ConduitT () ByteString m () -> ConduitT () ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
bs) (ConduitT () ByteString m () -> ConduitT () ByteString m ())
-> ConduitT () ByteString m () -> ConduitT () ByteString m ()
forall a b. (a -> b) -> a -> b
$ do
            ByteString -> ConduitT () ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
Conduit.yield ByteString
bs
            Int -> Handle -> ConduitT () ByteString m ()
go (Int
remainder Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
chunk) Handle
hd

-- | An opaque request body containing a 'SHA256' hash.
data HashedBody
  = HashedStream (Digest SHA256) !Integer (ConduitM () ByteString (ResourceT IO) ())
  | HashedBytes (Digest SHA256) ByteString

instance Show HashedBody where
  show :: HashedBody -> FilePath
show = \case
    HashedStream Digest SHA256
h Integer
n ConduitM () ByteString (ResourceT IO) ()
_ -> ByteStringBuilder -> Digest SHA256 -> Integer -> FilePath
forall {a} {a}.
(ByteArrayAccess a, ToLog a) =>
ByteStringBuilder -> a -> a -> FilePath
str ByteStringBuilder
"HashedStream" Digest SHA256
h Integer
n
    HashedBytes Digest SHA256
h ByteString
x -> ByteStringBuilder -> Digest SHA256 -> Int -> FilePath
forall {a} {a}.
(ByteArrayAccess a, ToLog a) =>
ByteStringBuilder -> a -> a -> FilePath
str ByteStringBuilder
"HashedBody" Digest SHA256
h (ByteString -> Int
BS.length ByteString
x)
    where
      str :: ByteStringBuilder -> a -> a -> FilePath
str ByteStringBuilder
c a
h a
n =
        ByteString -> FilePath
BS8.unpack (ByteString -> FilePath)
-> (ByteStringBuilder -> ByteString)
-> ByteStringBuilder
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringBuilder -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (ByteStringBuilder -> FilePath) -> ByteStringBuilder -> FilePath
forall a b. (a -> b) -> a -> b
$
          ByteStringBuilder
c
            ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
" { sha256 = "
            ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build (a -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
Bytes.encodeBase16 a
h)
            ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
", length = "
            ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> a -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build a
n

instance IsString HashedBody where
  fromString :: FilePath -> HashedBody
fromString = FilePath -> HashedBody
forall a. ToHashedBody a => a -> HashedBody
toHashed

sha256Base16 :: HashedBody -> ByteString
sha256Base16 :: HashedBody -> ByteString
sha256Base16 =
  Digest SHA256 -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
Bytes.encodeBase16 (Digest SHA256 -> ByteString)
-> (HashedBody -> Digest SHA256) -> HashedBody -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    HashedStream Digest SHA256
h Integer
_ ConduitM () ByteString (ResourceT IO) ()
_ -> Digest SHA256
h
    HashedBytes Digest SHA256
h ByteString
_ -> Digest SHA256
h

-- | Construct a 'HashedBody' from a 'FilePath', calculating the 'SHA256' hash
-- and file size.
--
-- /Note:/ While this function will perform in constant space, it will enumerate the
-- entirety of the file contents /twice/. Firstly to calculate the SHA256 and
-- lastly to stream the contents to the socket during sending.
--
-- /See:/ 'ToHashedBody'.
hashedFile ::
  MonadIO m =>
  -- | The file path to read.
  FilePath ->
  m HashedBody
hashedFile :: forall (m :: * -> *). MonadIO m => FilePath -> m HashedBody
hashedFile FilePath
path =
  IO HashedBody -> m HashedBody
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HashedBody -> m HashedBody) -> IO HashedBody -> m HashedBody
forall a b. (a -> b) -> a -> b
$
    Digest SHA256
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
-> HashedBody
HashedStream
      (Digest SHA256
 -> Integer
 -> ConduitM () ByteString (ResourceT IO) ()
 -> HashedBody)
-> IO (Digest SHA256)
-> IO
     (Integer -> ConduitM () ByteString (ResourceT IO) () -> HashedBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResourceT IO (Digest SHA256) -> IO (Digest SHA256)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (FilePath -> ConduitM () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
Conduit.Binary.sourceFile FilePath
path ConduitM () ByteString (ResourceT IO) ()
-> ConduitT ByteString Void (ResourceT IO) (Digest SHA256)
-> ResourceT IO (Digest SHA256)
forall (m :: * -> *) a r.
Monad m =>
ConduitT () a m () -> ConduitT a Void m r -> m r
`Conduit.connect` ConduitT ByteString Void (ResourceT IO) (Digest SHA256)
forall (m :: * -> *) o.
Monad m =>
ConduitM ByteString o m (Digest SHA256)
Crypto.sinkSHA256)
      IO
  (Integer -> ConduitM () ByteString (ResourceT IO) () -> HashedBody)
-> IO Integer
-> IO (ConduitM () ByteString (ResourceT IO) () -> HashedBody)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO Integer
forall (m :: * -> *). MonadIO m => FilePath -> m Integer
getFileSize FilePath
path
      IO (ConduitM () ByteString (ResourceT IO) () -> HashedBody)
-> IO (ConduitM () ByteString (ResourceT IO) ()) -> IO HashedBody
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitM () ByteString (ResourceT IO) ()
-> IO (ConduitM () ByteString (ResourceT IO) ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> ConduitM () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
Conduit.Binary.sourceFile FilePath
path)

-- | Construct a 'HashedBody' from a 'FilePath', specifying the range of bytes
-- to read. This can be useful for constructing multiple requests from a single
-- file, say for S3 multipart uploads.
--
-- /See:/ 'hashedFile', 'Conduit.sourceFileRange'.
hashedFileRange ::
  MonadIO m =>
  -- | The file path to read.
  FilePath ->
  -- | The byte offset at which to start reading.
  Integer ->
  -- | The maximum number of bytes to read.
  Integer ->
  m HashedBody
hashedFileRange :: forall (m :: * -> *).
MonadIO m =>
FilePath -> Integer -> Integer -> m HashedBody
hashedFileRange FilePath
path Integer
offset Integer
len = do
  Integer
size <- FilePath -> m Integer
forall (m :: * -> *). MonadIO m => FilePath -> m Integer
getFileSize FilePath
path
  let bytes :: Integer
bytes = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
len (Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
offset)
      sourceFileRange :: ConduitM () ByteString (ResourceT IO) ()
sourceFileRange =
        FilePath
-> Maybe Integer
-> Maybe Integer
-> ConduitM () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath
-> Maybe Integer -> Maybe Integer -> ConduitT i ByteString m ()
Conduit.Binary.sourceFileRange FilePath
path (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
offset) (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
len)
  Digest SHA256
digest <-
    IO (Digest SHA256) -> m (Digest SHA256)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Digest SHA256) -> m (Digest SHA256))
-> (ResourceT IO (Digest SHA256) -> IO (Digest SHA256))
-> ResourceT IO (Digest SHA256)
-> m (Digest SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT IO (Digest SHA256) -> IO (Digest SHA256)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (Digest SHA256) -> m (Digest SHA256))
-> ResourceT IO (Digest SHA256) -> m (Digest SHA256)
forall a b. (a -> b) -> a -> b
$ ConduitM () ByteString (ResourceT IO) ()
-> ConduitT ByteString Void (ResourceT IO) (Digest SHA256)
-> ResourceT IO (Digest SHA256)
forall (m :: * -> *) a r.
Monad m =>
ConduitT () a m () -> ConduitT a Void m r -> m r
Conduit.connect ConduitM () ByteString (ResourceT IO) ()
sourceFileRange ConduitT ByteString Void (ResourceT IO) (Digest SHA256)
forall (m :: * -> *) o.
Monad m =>
ConduitM ByteString o m (Digest SHA256)
Crypto.sinkSHA256
  HashedBody -> m HashedBody
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashedBody -> m HashedBody) -> HashedBody -> m HashedBody
forall a b. (a -> b) -> a -> b
$ Digest SHA256
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
-> HashedBody
HashedStream Digest SHA256
digest Integer
bytes ConduitM () ByteString (ResourceT IO) ()
sourceFileRange

-- | Construct a 'HashedBody' from a 'Source', manually specifying the 'SHA256'
-- hash and file size. It's left up to the caller to calculate these correctly,
-- otherwise AWS will return signing errors.
--
-- /See:/ 'ToHashedBody'.
hashedBody ::
  -- | A SHA256 hash of the file contents.
  Crypto.Digest Crypto.SHA256 ->
  -- | The size of the stream in bytes.
  Integer ->
  ConduitM () ByteString (ResourceT IO) () ->
  HashedBody
hashedBody :: Digest SHA256
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
-> HashedBody
hashedBody = Digest SHA256
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
-> HashedBody
HashedStream

-- | Invariant: only services that support /both/ standard and
-- chunked signing expose 'RequestBody' as a parameter.
data RequestBody
  = -- | Currently S3 only, see 'ChunkedBody' for details.
    Chunked ChunkedBody
  | Hashed HashedBody
  deriving stock (Int -> RequestBody -> ShowS
[RequestBody] -> ShowS
RequestBody -> FilePath
(Int -> RequestBody -> ShowS)
-> (RequestBody -> FilePath)
-> ([RequestBody] -> ShowS)
-> Show RequestBody
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestBody -> ShowS
showsPrec :: Int -> RequestBody -> ShowS
$cshow :: RequestBody -> FilePath
show :: RequestBody -> FilePath
$cshowList :: [RequestBody] -> ShowS
showList :: [RequestBody] -> ShowS
Show)

instance IsString RequestBody where
  fromString :: FilePath -> RequestBody
fromString = HashedBody -> RequestBody
Hashed (HashedBody -> RequestBody)
-> (FilePath -> HashedBody) -> FilePath -> RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> HashedBody
forall a. IsString a => FilePath -> a
fromString

md5Base64 :: RequestBody -> Maybe ByteString
md5Base64 :: RequestBody -> Maybe ByteString
md5Base64 = \case
  Hashed (HashedBytes Digest SHA256
_ ByteString
x) -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Digest MD5 -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
Bytes.encodeBase64 (ByteString -> Digest MD5
forall a. ByteArrayAccess a => a -> Digest MD5
Crypto.hashMD5 ByteString
x))
  RequestBody
_ -> Maybe ByteString
forall a. Maybe a
Nothing

isStreaming :: RequestBody -> Bool
isStreaming :: RequestBody -> Bool
isStreaming = \case
  Hashed (HashedStream {}) -> Bool
True
  RequestBody
_ -> Bool
False

toRequestBody :: RequestBody -> Client.RequestBody
toRequestBody :: RequestBody -> RequestBody
toRequestBody = \case
  Chunked ChunkedBody {ConduitM () ByteString (ResourceT IO) ()
$sel:body:ChunkedBody :: ChunkedBody -> ConduitM () ByteString (ResourceT IO) ()
body :: ConduitM () ByteString (ResourceT IO) ()
body} -> ConduitM () ByteString (ResourceT IO) () -> RequestBody
Client.Conduit.requestBodySourceChunked ConduitM () ByteString (ResourceT IO) ()
body
  Hashed HashedBody
x -> case HashedBody
x of
    HashedStream Digest SHA256
_ Integer
n ConduitM () ByteString (ResourceT IO) ()
f -> Int64 -> ConduitM () ByteString (ResourceT IO) () -> RequestBody
Client.Conduit.requestBodySource (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) ConduitM () ByteString (ResourceT IO) ()
f
    HashedBytes Digest SHA256
_ ByteString
b -> ByteString -> RequestBody
Client.RequestBodyBS ByteString
b

contentLength :: RequestBody -> Integer
contentLength :: RequestBody -> Integer
contentLength = \case
  Chunked ChunkedBody {Integer
$sel:length:ChunkedBody :: ChunkedBody -> Integer
length :: Integer
length} -> Integer
length
  Hashed HashedBody
x -> case HashedBody
x of
    HashedStream Digest SHA256
_ Integer
n ConduitM () ByteString (ResourceT IO) ()
_ -> Integer
n
    HashedBytes Digest SHA256
_ ByteString
b -> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
b)

-- | Anything that can be safely converted to a 'HashedBody'.
class ToHashedBody a where
  -- | Convert a value to a hashed request body.
  toHashed :: a -> HashedBody

instance ToHashedBody ByteString where
  toHashed :: ByteString -> HashedBody
toHashed ByteString
x = Digest SHA256 -> ByteString -> HashedBody
HashedBytes (ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash ByteString
x) ByteString
x

instance ToHashedBody HashedBody where
  toHashed :: HashedBody -> HashedBody
toHashed = HashedBody -> HashedBody
forall a. a -> a
id

instance ToHashedBody String where
  toHashed :: FilePath -> HashedBody
toHashed = ByteString -> HashedBody
forall a. ToHashedBody a => a -> HashedBody
toHashed (ByteString -> HashedBody)
-> (FilePath -> ByteString) -> FilePath -> HashedBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
LBS8.pack

instance ToHashedBody ByteStringLazy where
  toHashed :: ByteString -> HashedBody
toHashed = ByteString -> HashedBody
forall a. ToHashedBody a => a -> HashedBody
toHashed (ByteString -> HashedBody)
-> (ByteString -> ByteString) -> ByteString -> HashedBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. ToByteString a => a -> ByteString
toBS

instance ToHashedBody Text where
  toHashed :: Text -> HashedBody
toHashed = ByteString -> HashedBody
forall a. ToHashedBody a => a -> HashedBody
toHashed (ByteString -> HashedBody)
-> (Text -> ByteString) -> Text -> HashedBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8

instance ToHashedBody TextLazy where
  toHashed :: TextLazy -> HashedBody
toHashed = ByteString -> HashedBody
forall a. ToHashedBody a => a -> HashedBody
toHashed (ByteString -> HashedBody)
-> (TextLazy -> ByteString) -> TextLazy -> HashedBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextLazy -> ByteString
LText.encodeUtf8

instance ToHashedBody Aeson.Value where
  toHashed :: Value -> HashedBody
toHashed = ByteString -> HashedBody
forall a. ToHashedBody a => a -> HashedBody
toHashed (ByteString -> HashedBody)
-> (Value -> ByteString) -> Value -> HashedBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode

instance ToHashedBody XML.Element where
  toHashed :: Element -> HashedBody
toHashed = ByteString -> HashedBody
forall a. ToHashedBody a => a -> HashedBody
toHashed (ByteString -> HashedBody)
-> (Element -> ByteString) -> Element -> HashedBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> ByteString
forall a. ToElement a => a -> ByteString
encodeXML

instance ToHashedBody QueryString where
  toHashed :: QueryString -> HashedBody
toHashed = ByteString -> HashedBody
forall a. ToHashedBody a => a -> HashedBody
toHashed (ByteString -> HashedBody)
-> (QueryString -> ByteString) -> QueryString -> HashedBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryString -> ByteString
forall a. ToByteString a => a -> ByteString
toBS

#if MIN_VERSION_aeson(2,0,0)
instance ToHashedBody (KeyMap Aeson.Value) where
  toHashed :: KeyMap Value -> HashedBody
toHashed = Value -> HashedBody
forall a. ToHashedBody a => a -> HashedBody
toHashed (Value -> HashedBody)
-> (KeyMap Value -> Value) -> KeyMap Value -> HashedBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap Value -> Value
Aeson.Object
#else
instance ToHashedBody (HashMap Text Aeson.Value) where
  toHashed = toHashed . Aeson.Object
#endif

-- | Anything that can be converted to a streaming request 'Body'.
class ToBody a where
  -- | Convert a value to a request body.
  toBody :: a -> RequestBody
  default toBody :: ToHashedBody a => a -> RequestBody
  toBody = HashedBody -> RequestBody
Hashed (HashedBody -> RequestBody)
-> (a -> HashedBody) -> a -> RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> HashedBody
forall a. ToHashedBody a => a -> HashedBody
toHashed

instance ToBody RequestBody where
  toBody :: RequestBody -> RequestBody
toBody = RequestBody -> RequestBody
forall a. a -> a
id

instance ToBody HashedBody where
  toBody :: HashedBody -> RequestBody
toBody = HashedBody -> RequestBody
Hashed

instance ToBody ChunkedBody where
  toBody :: ChunkedBody -> RequestBody
toBody = ChunkedBody -> RequestBody
Chunked

instance ToHashedBody a => ToBody (Maybe a) where
  toBody :: Maybe a -> RequestBody
toBody = HashedBody -> RequestBody
Hashed (HashedBody -> RequestBody)
-> (Maybe a -> HashedBody) -> Maybe a -> RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashedBody -> (a -> HashedBody) -> Maybe a -> HashedBody
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> HashedBody
forall a. ToHashedBody a => a -> HashedBody
toHashed ByteString
BS.empty) a -> HashedBody
forall a. ToHashedBody a => a -> HashedBody
toHashed

instance ToBody String

instance ToBody ByteStringLazy

instance ToBody ByteString

instance ToBody Text

instance ToBody TextLazy

#if MIN_VERSION_aeson(2,0,0)
instance ToBody (KeyMap Aeson.Value)
#else
instance ToBody (HashMap Text Aeson.Value)
#endif

instance ToBody Aeson.Value

instance ToBody XML.Element

instance ToBody QueryString