-- |
-- Module      : Amazonka.Sign.V4.Chunked
-- 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.Sign.V4.Chunked where

import qualified Amazonka.Bytes as Bytes
import Amazonka.Core.Lens.Internal ((^.))
import qualified Amazonka.Crypto as Crypto
import Amazonka.Data
import Amazonka.Prelude as Prelude
import Amazonka.Sign.V4.Base as V4 hiding (algorithm)
import Amazonka.Types
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as Build
import qualified Data.ByteString.Char8 as BS8
import Data.Conduit (ConduitM)
import qualified Data.Conduit as Conduit
import qualified Network.HTTP.Types as HTTP
import qualified Numeric

chunked :: ChunkedBody -> Algorithm a
chunked :: forall a. ChunkedBody -> Algorithm a
chunked
  c :: ChunkedBody
c@ChunkedBody {$sel:length:ChunkedBody :: ChunkedBody -> Integer
length = Integer
len}
  rq :: Request a
rq@Request {$sel:service:Request :: forall a. Request a -> Service
service = service :: Service
service@Service {Region -> Endpoint
$sel:endpoint:Service :: Service -> Region -> Endpoint
endpoint :: Region -> Endpoint
endpoint}}
  AuthEnv
a
  Region
region
  UTCTime
ts =
    forall a.
V4 -> RequestBody -> (ClientRequest -> ClientRequest) -> Signed a
signRequest V4
meta (RequestBody -> RequestBody
toRequestBody RequestBody
body) ClientRequest -> ClientRequest
auth
    where
      (V4
meta, ClientRequest -> ClientRequest
auth) = forall a.
Hash
-> Request a
-> AuthEnv
-> Region
-> UTCTime
-> (V4, ClientRequest -> ClientRequest)
V4.base (forall (s :: Symbol) a. a -> Tag s a
Tag ByteString
digest) (forall a. Request a -> Request a
prepare Request a
rq) AuthEnv
a Region
region UTCTime
ts

      -- Although https://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-streaming.html says to include
      -- `Content-Encoding: aws-chunked`, we don't. If it's the only header, S3 will remove
      -- `aws-chunked` leaving a blank header, and store `"ContentEncoding": ""` in the object's metadata.
      -- This breaks some CDNs and HTTP clients.
      --
      -- According to https://github.com/fog/fog-aws/pull/147 , AWS support have confirmed that the
      -- header is not strictly necessary, and S3 will figure out that it's a chunked body.
      prepare :: Request a -> Request a
      prepare :: forall a. Request a -> Request a
prepare r :: Request a
r@Request {[Header]
$sel:headers:Request :: forall a. Request a -> [Header]
headers :: [Header]
headers} =
        Request a
r
          { $sel:headers:Request :: [Header]
headers =
              [Header]
headers
                forall a. Semigroup a => a -> a -> a
<> [ (HeaderName
hAMZDecodedContentLength, forall a. ToByteString a => a -> ByteString
toBS Integer
len),
                     (HeaderName
HTTP.hContentLength, forall a. ToByteString a => a -> ByteString
toBS (ChunkedBody -> Integer
metadataLength ChunkedBody
c))
                   ]
          }

      body :: RequestBody
body = ChunkedBody -> RequestBody
Chunked (ChunkedBody
c ChunkedBody
-> ConduitM ByteString ByteString (ResourceT IO) () -> ChunkedBody
`fuseChunks` forall (m :: * -> *).
Monad m =>
Signature -> ConduitM ByteString ByteString m ()
sign (V4 -> Signature
metaSignature V4
meta))

      sign :: Monad m => Signature -> ConduitM ByteString ByteString m ()
      sign :: forall (m :: * -> *).
Monad m =>
Signature -> ConduitM ByteString ByteString m ()
sign Signature
prev = do
        Maybe ByteString
mx <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
Conduit.await

        let next :: Signature
next = Signature -> ByteString -> Signature
chunkSignature Signature
prev (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe ByteString
mx)

        case Maybe ByteString
mx of
          Maybe ByteString
Nothing -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
Conduit.yield (forall {a}. ToByteString a => a -> ByteString -> ByteString
chunkData Signature
next forall a. Monoid a => a
mempty)
          Just ByteString
x -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
Conduit.yield (forall {a}. ToByteString a => a -> ByteString -> ByteString
chunkData Signature
next ByteString
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *).
Monad m =>
Signature -> ConduitM ByteString ByteString m ()
sign Signature
next

      chunkData :: a -> ByteString -> ByteString
chunkData a
next ByteString
x =
        forall a. ToByteString a => a -> ByteString
toBS forall a b. (a -> b) -> a -> b
$
          Word64 -> Builder
Build.word64Hex (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
x))
            forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Build.byteString ByteString
chunkSignatureHeader
            forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Build.byteString (forall a. ToByteString a => a -> ByteString
toBS a
next)
            forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Build.byteString ByteString
crlf
            forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Build.byteString ByteString
x
            forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Build.byteString ByteString
crlf

      chunkSignature :: Signature -> ByteString -> Signature
chunkSignature Signature
prev ByteString
x =
        SecretKey -> CredentialScope -> StringToSign -> Signature
signature (AuthEnv -> Sensitive SecretKey
secretAccessKey AuthEnv
a forall s a. s -> Getting a s a -> a
^. forall a. Iso' (Sensitive a) a
_Sensitive) CredentialScope
scope (forall {a} {s :: Symbol}.
ToByteString a =>
a -> ByteString -> Tag s ByteString
chunkStringToSign Signature
prev ByteString
x)

      chunkStringToSign :: a -> ByteString -> Tag s ByteString
chunkStringToSign a
prev ByteString
x =
        forall (s :: Symbol) a. a -> Tag s a
Tag forall a b. (a -> b) -> a -> b
$
          ByteString -> [ByteString] -> ByteString
BS8.intercalate
            ByteString
"\n"
            [ ByteString
algorithm,
              ByteString
time,
              forall a. ToByteString a => a -> ByteString
toBS CredentialScope
scope,
              forall a. ToByteString a => a -> ByteString
toBS a
prev,
              ByteString
sha256Empty,
              ByteString -> ByteString
sha256 ByteString
x
            ]

      time :: ByteString
      time :: ByteString
time = forall a. ToByteString a => a -> ByteString
toBS (forall (a :: Format). UTCTime -> Time a
Time UTCTime
ts :: AWSTime)

      scope :: CredentialScope
      scope :: CredentialScope
scope = Service -> Endpoint -> UTCTime -> CredentialScope
credentialScope Service
service Endpoint
end UTCTime
ts

      end :: Endpoint
      end :: Endpoint
end = Region -> Endpoint
endpoint Region
region

metadataLength :: ChunkedBody -> Integer
metadataLength :: ChunkedBody -> Integer
metadataLength ChunkedBody
c =
  -- Number of full sized chunks.
  ChunkedBody -> Integer
fullChunks ChunkedBody
c forall a. Num a => a -> a -> a
* forall a. Integral a => a -> Integer
chunkLength (ChunkedBody -> ChunkSize
size ChunkedBody
c)
    -- Non-full chunk preceeding the final chunk.
    forall a. Num a => a -> a -> a
+ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 forall a. Integral a => a -> Integer
chunkLength (ChunkedBody -> Maybe Integer
remainderBytes ChunkedBody
c)
    -- The final empty chunk.
    forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Integer
chunkLength (Integer
0 :: Integer)
  where
    chunkLength :: Integral a => a -> Integer
    chunkLength :: forall a. Integral a => a -> Integer
chunkLength (forall a. Integral a => a -> Integer
toInteger -> Integer
n) =
      forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length (forall a. (Integral a, Show a) => a -> ShowS
Numeric.showHex Integer
n String
""))
        forall a. Num a => a -> a -> a
+ Integer
headerLength
        forall a. Num a => a -> a -> a
+ Integer
signatureLength
        forall a. Num a => a -> a -> a
+ Integer
crlfLength
        forall a. Num a => a -> a -> a
+ Integer
n
        forall a. Num a => a -> a -> a
+ Integer
crlfLength

    headerLength :: Integer
headerLength = forall a. Integral a => a -> Integer
toInteger (ByteString -> Int
BS.length ByteString
chunkSignatureHeader)
    crlfLength :: Integer
crlfLength = forall a. Integral a => a -> Integer
toInteger (ByteString -> Int
BS.length ByteString
crlf)
    signatureLength :: Integer
signatureLength = Integer
64

sha256 :: ByteString -> ByteString
sha256 :: ByteString -> ByteString
sha256 = forall a. ByteArrayAccess a => a -> ByteString
Bytes.encodeBase16 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteArrayAccess a => a -> Digest SHA256
Crypto.hashSHA256

sha256Empty :: ByteString
sha256Empty :: ByteString
sha256Empty = ByteString
"e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"

algorithm :: ByteString
algorithm :: ByteString
algorithm = ByteString
"AWS4-HMAC-SHA256-PAYLOAD"

digest :: ByteString
digest :: ByteString
digest = ByteString
"STREAMING-AWS4-HMAC-SHA256-PAYLOAD"

chunkSignatureHeader :: ByteString
chunkSignatureHeader :: ByteString
chunkSignatureHeader = ByteString
";chunk-signature="

crlf :: ByteString
crlf :: ByteString
crlf = ByteString
"\r\n"