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

import Amazonka.Core
import Amazonka.Prelude
import Conduit ((.|))
import qualified Conduit
import qualified Data.ByteString as BS

-- Resides here since it's unsafe without the use of enforceChunks,
-- which incurs extra dependencies not desired in core.
class ToChunkedBody a where
  toChunked :: a -> ChunkedBody

instance ToChunkedBody ChunkedBody where
  toChunked :: ChunkedBody -> ChunkedBody
toChunked = forall a. a -> a
id

instance ToChunkedBody HashedBody where
  toChunked :: HashedBody -> ChunkedBody
toChunked = \case
    HashedStream Digest SHA256
_ Integer
n ConduitM () ByteString (ResourceT IO) ()
s -> forall a.
Integral a =>
a -> ConduitM () ByteString (ResourceT IO) () -> ChunkedBody
enforceChunks Integer
n ConduitM () ByteString (ResourceT IO) ()
s
    HashedBytes Digest SHA256
_ ByteString
b -> forall a.
Integral a =>
a -> ConduitM () ByteString (ResourceT IO) () -> ChunkedBody
enforceChunks (ByteString -> Int
BS.length ByteString
b) (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
Conduit.yield [ByteString
b])

instance ToChunkedBody RequestBody where
  toChunked :: RequestBody -> ChunkedBody
toChunked = \case
    Chunked ChunkedBody
c -> ChunkedBody
c
    Hashed HashedBody
h -> forall a. ToChunkedBody a => a -> ChunkedBody
toChunked HashedBody
h

enforceChunks ::
  Integral a =>
  a ->
  Conduit.ConduitT () ByteString (Conduit.ResourceT IO) () ->
  ChunkedBody
enforceChunks :: forall a.
Integral a =>
a -> ConduitM () ByteString (ResourceT IO) () -> ChunkedBody
enforceChunks a
size ConduitM () ByteString (ResourceT IO) ()
c =
  ChunkSize
-> Integer
-> ConduitM () ByteString (ResourceT IO) ()
-> ChunkedBody
ChunkedBody ChunkSize
defaultChunkSize (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
size) forall a b. (a -> b) -> a -> b
$
    ConduitM () ByteString (ResourceT IO) ()
c forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
Index seq -> ConduitT seq seq m ()
Conduit.chunksOfCE (forall a b. (Integral a, Num b) => a -> b
fromIntegral ChunkSize
defaultChunkSize)