{-# 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 => String -> m Integer
getFileSize String
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall r. String -> IOMode -> (Handle -> IO r) -> IO r
IO.withBinaryFile String
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. 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
$cto :: forall x. Rep ResponseBody x -> ResponseBody
$cfrom :: forall x. ResponseBody -> Rep ResponseBody x
Generic)

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

{-# INLINE _ResponseBody #-}
_ResponseBody :: Iso' ResponseBody (ConduitM () ByteString (ResourceT IO) ())
_ResponseBody :: Iso' ResponseBody (ConduitM () ByteString (ResourceT IO) ())
_ResponseBody = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
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) ()
body :: ConduitM () ByteString (ResourceT IO) ()
$sel:body:ResponseBody :: ResponseBody -> 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 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 =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
Conduit.runConduitRes forall a b. (a -> b) -> a -> b
$ ConduitM () ByteString (ResourceT IO) ()
body 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChunkSize -> ChunkSize -> Bool
$c/= :: ChunkSize -> ChunkSize -> Bool
== :: ChunkSize -> ChunkSize -> Bool
$c== :: ChunkSize -> ChunkSize -> Bool
Eq, Eq 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
min :: ChunkSize -> ChunkSize -> ChunkSize
$cmin :: ChunkSize -> ChunkSize -> ChunkSize
max :: ChunkSize -> ChunkSize -> ChunkSize
$cmax :: ChunkSize -> ChunkSize -> ChunkSize
>= :: ChunkSize -> ChunkSize -> Bool
$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
compare :: ChunkSize -> ChunkSize -> Ordering
$ccompare :: ChunkSize -> ChunkSize -> Ordering
Ord, Int -> ChunkSize -> ShowS
[ChunkSize] -> ShowS
ChunkSize -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChunkSize] -> ShowS
$cshowList :: [ChunkSize] -> ShowS
show :: ChunkSize -> String
$cshow :: ChunkSize -> String
showsPrec :: Int -> ChunkSize -> ShowS
$cshowsPrec :: Int -> ChunkSize -> ShowS
Show)
  deriving newtype (Int -> ChunkSize
ChunkSize -> Int
ChunkSize -> [ChunkSize]
ChunkSize -> ChunkSize
ChunkSize -> ChunkSize -> [ChunkSize]
ChunkSize -> ChunkSize -> ChunkSize -> [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
enumFromThenTo :: ChunkSize -> ChunkSize -> ChunkSize -> [ChunkSize]
$cenumFromThenTo :: ChunkSize -> ChunkSize -> ChunkSize -> [ChunkSize]
enumFromTo :: ChunkSize -> ChunkSize -> [ChunkSize]
$cenumFromTo :: ChunkSize -> ChunkSize -> [ChunkSize]
enumFromThen :: ChunkSize -> ChunkSize -> [ChunkSize]
$cenumFromThen :: ChunkSize -> ChunkSize -> [ChunkSize]
enumFrom :: ChunkSize -> [ChunkSize]
$cenumFrom :: ChunkSize -> [ChunkSize]
fromEnum :: ChunkSize -> Int
$cfromEnum :: ChunkSize -> Int
toEnum :: Int -> ChunkSize
$ctoEnum :: Int -> ChunkSize
pred :: ChunkSize -> ChunkSize
$cpred :: ChunkSize -> ChunkSize
succ :: ChunkSize -> ChunkSize
$csucc :: ChunkSize -> ChunkSize
Enum, Integer -> ChunkSize
ChunkSize -> ChunkSize
ChunkSize -> ChunkSize -> ChunkSize
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ChunkSize
$cfromInteger :: Integer -> ChunkSize
signum :: ChunkSize -> ChunkSize
$csignum :: ChunkSize -> ChunkSize
abs :: ChunkSize -> ChunkSize
$cabs :: ChunkSize -> ChunkSize
negate :: ChunkSize -> ChunkSize
$cnegate :: ChunkSize -> ChunkSize
* :: ChunkSize -> ChunkSize -> ChunkSize
$c* :: ChunkSize -> ChunkSize -> ChunkSize
- :: ChunkSize -> ChunkSize -> ChunkSize
$c- :: ChunkSize -> ChunkSize -> ChunkSize
+ :: ChunkSize -> ChunkSize -> ChunkSize
$c+ :: ChunkSize -> ChunkSize -> ChunkSize
Num, Num ChunkSize
Ord ChunkSize
ChunkSize -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: ChunkSize -> Rational
$ctoRational :: ChunkSize -> Rational
Real, Enum ChunkSize
Real 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
toInteger :: ChunkSize -> Integer
$ctoInteger :: ChunkSize -> Integer
divMod :: ChunkSize -> ChunkSize -> (ChunkSize, ChunkSize)
$cdivMod :: ChunkSize -> ChunkSize -> (ChunkSize, ChunkSize)
quotRem :: ChunkSize -> ChunkSize -> (ChunkSize, ChunkSize)
$cquotRem :: ChunkSize -> ChunkSize -> (ChunkSize, ChunkSize)
mod :: ChunkSize -> ChunkSize -> ChunkSize
$cmod :: ChunkSize -> ChunkSize -> ChunkSize
div :: ChunkSize -> ChunkSize -> ChunkSize
$cdiv :: ChunkSize -> ChunkSize -> ChunkSize
rem :: ChunkSize -> ChunkSize -> ChunkSize
$crem :: ChunkSize -> ChunkSize -> ChunkSize
quot :: ChunkSize -> ChunkSize -> ChunkSize
$cquot :: ChunkSize -> ChunkSize -> ChunkSize
Integral)

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

_ChunkSize :: Iso' ChunkSize Int
_ChunkSize :: Iso' ChunkSize Int
_ChunkSize = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
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 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
size :: ChunkSize
$sel:size:ChunkedBody :: ChunkedBody -> ChunkSize
size} = ChunkSize -> f ChunkSize
f ChunkSize
size 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
length :: Integer
$sel:length:ChunkedBody :: ChunkedBody -> Integer
length} = Integer -> f Integer
f Integer
length 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) ()
body :: ConduitM () ByteString (ResourceT IO) ()
$sel:body:ChunkedBody :: ChunkedBody -> ConduitM () ByteString (ResourceT IO) ()
body} = ConduitM () ByteString (ResourceT IO) ()
-> f (ConduitM () ByteString (ResourceT IO) ())
f ConduitM () ByteString (ResourceT IO) ()
body 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 -> String
show ChunkedBody
c =
    ByteString -> String
BS8.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToByteString a => a -> ByteString
toBS forall a b. (a -> b) -> a -> b
$
      ByteStringBuilder
"ChunkedBody { chunkSize = "
        forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (ChunkedBody -> ChunkSize
size ChunkedBody
c)
        forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"<> originalLength = "
        forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (ChunkedBody -> Integer
length ChunkedBody
c)
        forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"<> fullChunks = "
        forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (ChunkedBody -> Integer
fullChunks ChunkedBody
c)
        forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"<> remainderBytes = "
        forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (ChunkedBody -> Maybe Integer
remainderBytes ChunkedBody
c)
        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) ()
body :: ConduitM () ByteString (ResourceT IO) ()
$sel:body:ChunkedBody :: ChunkedBody -> 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 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 forall a. Integral a => a -> a -> a
`div` 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
length :: Integer
$sel:length:ChunkedBody :: ChunkedBody -> Integer
length, ChunkSize
size :: ChunkSize
$sel:size:ChunkedBody :: ChunkedBody -> ChunkSize
size} =
  case Integer
length forall a. Integral a => a -> a -> a
`mod` forall a. Integral a => a -> Integer
toInteger ChunkSize
size of
    Integer
0 -> forall a. Maybe a
Nothing
    Integer
n -> 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 -> String -> m RequestBody
chunkedFile ChunkSize
chunk String
path = do
  Integer
size <- forall (m :: * -> *). MonadIO m => String -> m Integer
getFileSize String
path
  if Integer
size forall a. Ord a => a -> a -> Bool
> forall a. Integral a => a -> Integer
toInteger ChunkSize
chunk
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ChunkSize
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
-> RequestBody
unsafeChunkedBody ChunkSize
chunk Integer
size (forall (m :: * -> *).
MonadResource m =>
ChunkSize -> String -> ConduitM () ByteString m ()
sourceFileChunks ChunkSize
chunk String
path)
    else HashedBody -> RequestBody
Hashed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => String -> m HashedBody
hashedFile String
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 -> String -> Integer -> Integer -> m RequestBody
chunkedFileRange ChunkSize
chunk String
path Integer
offset Integer
len = do
  Integer
size <- forall (m :: * -> *). MonadIO m => String -> m Integer
getFileSize String
path
  let n :: Integer
n = forall a. Ord a => a -> a -> a
min (Integer
size forall a. Num a => a -> a -> a
- Integer
offset) Integer
len
  if Integer
n forall a. Ord a => a -> a -> Bool
> forall a. Integral a => a -> Integer
toInteger ChunkSize
chunk
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ChunkSize
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
-> RequestBody
unsafeChunkedBody ChunkSize
chunk Integer
n (forall (m :: * -> *).
MonadResource m =>
ChunkSize
-> String -> Integer -> Integer -> ConduitM () ByteString m ()
sourceFileRangeChunks ChunkSize
chunk String
path Integer
offset Integer
len)
    else HashedBody -> RequestBody
Hashed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
String -> Integer -> Integer -> m HashedBody
hashedFileRange String
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 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 -> String -> ConduitM () ByteString m ()
sourceFileChunks (ChunkSize Int
chunk) String
path =
  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 (String -> IOMode -> IO Handle
IO.openBinaryFile String
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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Int -> IO ByteString
BS.hGet Handle
hd Int
chunk)
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
bs) forall a b. (a -> b) -> a -> b
$ do
        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
-> String -> Integer -> Integer -> ConduitM () ByteString m ()
sourceFileRangeChunks (ChunkSize Int
chunk) String
path Integer
offset Integer
len =
  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 = String -> IOMode -> IO Handle
IO.openBinaryFile String
path IOMode
IO.ReadMode
    seek :: Handle -> ConduitT () ByteString m ()
seek Handle
hd = do
      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 (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 forall a. Ord a => a -> a -> Bool
<= Int
chunk = do
          ByteString
bs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Int -> IO ByteString
BS.hGet Handle
hd Int
remainder)
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
bs) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
Conduit.yield ByteString
bs
      --
      | Bool
otherwise = do
          ByteString
bs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Int -> IO ByteString
BS.hGet Handle
hd Int
chunk)

          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
bs) forall a b. (a -> b) -> a -> b
$ do
            forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
Conduit.yield ByteString
bs
            Int -> Handle -> ConduitT () ByteString m ()
go (Int
remainder 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 -> String
show = \case
    HashedStream Digest SHA256
h Integer
n ConduitM () ByteString (ResourceT IO) ()
_ -> forall {a} {a}.
(ByteArrayAccess a, ToLog a) =>
ByteStringBuilder -> a -> a -> String
str ByteStringBuilder
"HashedStream" Digest SHA256
h Integer
n
    HashedBytes Digest SHA256
h ByteString
x -> forall {a} {a}.
(ByteArrayAccess a, ToLog a) =>
ByteStringBuilder -> a -> a -> String
str ByteStringBuilder
"HashedBody" Digest SHA256
h (ByteString -> Int
BS.length ByteString
x)
    where
      str :: ByteStringBuilder -> a -> a -> String
str ByteStringBuilder
c a
h a
n =
        ByteString -> String
BS8.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToByteString a => a -> ByteString
toBS forall a b. (a -> b) -> a -> b
$
          ByteStringBuilder
c
            forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
" { sha256 = "
            forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (forall a. ByteArrayAccess a => a -> ByteString
Bytes.encodeBase16 a
h)
            forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
", length = "
            forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build a
n

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

sha256Base16 :: HashedBody -> ByteString
sha256Base16 :: HashedBody -> ByteString
sha256Base16 =
  forall a. ByteArrayAccess a => a -> ByteString
Bytes.encodeBase16 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 => String -> m HashedBody
hashedFile String
path =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    Digest SHA256
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
-> HashedBody
HashedStream
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (forall (m :: * -> *) i.
MonadResource m =>
String -> ConduitT i ByteString m ()
Conduit.Binary.sourceFile String
path forall (m :: * -> *) a r.
Monad m =>
ConduitT () a m () -> ConduitT a Void m r -> m r
`Conduit.connect` forall (m :: * -> *) o.
Monad m =>
ConduitM ByteString o m (Digest SHA256)
Crypto.sinkSHA256)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadIO m => String -> m Integer
getFileSize String
path
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *) i.
MonadResource m =>
String -> ConduitT i ByteString m ()
Conduit.Binary.sourceFile String
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 =>
String -> Integer -> Integer -> m HashedBody
hashedFileRange String
path Integer
offset Integer
len = do
  Integer
size <- forall (m :: * -> *). MonadIO m => String -> m Integer
getFileSize String
path
  let bytes :: Integer
bytes = forall a. Ord a => a -> a -> a
min Integer
len (Integer
size forall a. Num a => a -> a -> a
- Integer
offset)
      sourceFileRange :: ConduitM () ByteString (ResourceT IO) ()
sourceFileRange =
        forall (m :: * -> *) i.
MonadResource m =>
String
-> Maybe Integer -> Maybe Integer -> ConduitT i ByteString m ()
Conduit.Binary.sourceFileRange String
path (forall a. a -> Maybe a
Just Integer
offset) (forall a. a -> Maybe a
Just Integer
len)
  Digest SHA256
digest <-
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a r.
Monad m =>
ConduitT () a m () -> ConduitT a Void m r -> m r
Conduit.connect ConduitM () ByteString (ResourceT IO) ()
sourceFileRange forall (m :: * -> *) o.
Monad m =>
ConduitM ByteString o m (Digest SHA256)
Crypto.sinkSHA256
  forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestBody] -> ShowS
$cshowList :: [RequestBody] -> ShowS
show :: RequestBody -> String
$cshow :: RequestBody -> String
showsPrec :: Int -> RequestBody -> ShowS
$cshowsPrec :: Int -> RequestBody -> ShowS
Show)

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

md5Base64 :: RequestBody -> Maybe ByteString
md5Base64 :: RequestBody -> Maybe ByteString
md5Base64 = \case
  Hashed (HashedBytes Digest SHA256
_ ByteString
x) -> forall a. a -> Maybe a
Just (forall a. ByteArrayAccess a => a -> ByteString
Bytes.encodeBase64 (forall a. ByteArrayAccess a => a -> Digest MD5
Crypto.hashMD5 ByteString
x))
  RequestBody
_ -> 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) ()
body :: ConduitM () ByteString (ResourceT IO) ()
$sel:body:ChunkedBody :: ChunkedBody -> 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 (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
length :: Integer
$sel:length:ChunkedBody :: ChunkedBody -> 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 -> 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 (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash ByteString
x) ByteString
x

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

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

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

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

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

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

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

instance ToHashedBody QueryString where
  toHashed :: QueryString -> HashedBody
toHashed = forall a. ToHashedBody a => a -> HashedBody
toHashed forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. ToHashedBody a => a -> HashedBody
toHashed 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToHashedBody a => a -> HashedBody
toHashed

instance ToBody RequestBody where
  toBody :: RequestBody -> RequestBody
toBody = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. ToHashedBody a => a -> HashedBody
toHashed ByteString
BS.empty) 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