-- |
-- Module      : Amazonka.Sign.V4.Chunked
-- Copyright   : (c) 2013-2021 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 qualified Amazonka.Crypto as Crypto
import Amazonka.Data
import Amazonka.Lens ((<>~), (^.))
import Amazonka.Prelude
import Amazonka.Sign.V4.Base 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 :: ChunkedBody -> Algorithm a
chunked ChunkedBody
c Request a
rq AuthEnv
a Region
r UTCTime
ts = V4 -> RequestBody -> (ClientRequest -> ClientRequest) -> Signed a
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) = Hash
-> Request a
-> AuthEnv
-> Region
-> UTCTime
-> (V4, ClientRequest -> ClientRequest)
forall a.
Hash
-> Request a
-> AuthEnv
-> Region
-> UTCTime
-> (V4, ClientRequest -> ClientRequest)
base (ByteString -> Hash
forall (s :: Symbol) a. a -> Tag s a
Tag ByteString
digest) (Request a -> Request a
prepare Request a
rq) AuthEnv
a Region
r 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 =
      ([Header] -> Identity [Header])
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) [Header]
requestHeaders
        (([Header] -> Identity [Header])
 -> Request a -> Identity (Request a))
-> [Header] -> Request a -> Request a
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [ (HeaderName
hAMZDecodedContentLength, Integer -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (ChunkedBody -> Integer
_chunkedLength ChunkedBody
c)),
              (HeaderName
HTTP.hContentLength, Integer -> ByteString
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` Signature -> ConduitM ByteString ByteString (ResourceT IO) ()
forall (m :: * -> *).
Monad m =>
Signature -> ConduitM ByteString ByteString m ()
sign (V4 -> Signature
metaSignature V4
meta))

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

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

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

    chunkData :: a -> ByteString -> ByteString
chunkData a
next ByteString
x =
      Builder -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
        Word64 -> Builder
Build.word64Hex (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
x))
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Build.byteString ByteString
chunkSignatureHeader
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Build.byteString (a -> ByteString
forall a. ToByteString a => a -> ByteString
toBS a
next)
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Build.byteString ByteString
crlf
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Build.byteString ByteString
x
          Builder -> Builder -> Builder
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
_authSecretAccessKey AuthEnv
a Sensitive SecretKey
-> Getting SecretKey (Sensitive SecretKey) SecretKey -> SecretKey
forall s a. s -> Getting a s a -> a
^. Getting SecretKey (Sensitive SecretKey) SecretKey
forall a. Iso' (Sensitive a) a
_Sensitive) CredentialScope
scope (Signature -> ByteString -> StringToSign
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 =
      ByteString -> Tag s ByteString
forall (s :: Symbol) a. a -> Tag s a
Tag (ByteString -> Tag s ByteString) -> ByteString -> Tag s ByteString
forall a b. (a -> b) -> a -> b
$
        ByteString -> [ByteString] -> ByteString
BS8.intercalate
          ByteString
"\n"
          [ ByteString
algorithm,
            ByteString
time,
            CredentialScope -> ByteString
forall a. ToByteString a => a -> ByteString
toBS CredentialScope
scope,
            a -> ByteString
forall a. ToByteString a => a -> ByteString
toBS a
prev,
            ByteString
sha256Empty,
            ByteString -> ByteString
sha256 ByteString
x
          ]

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

    scope :: CredentialScope
    scope :: CredentialScope
scope = Service -> Endpoint -> UTCTime -> CredentialScope
credentialScope (Request a -> Service
forall a. Request a -> Service
_requestService Request a
rq) Endpoint
end UTCTime
ts

    end :: Endpoint
    end :: Endpoint
end = Service -> Region -> Endpoint
_serviceEndpoint (Request a -> Service
forall a. Request a -> Service
_requestService Request a
rq) Region
r

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

    headerLength :: Integer
headerLength = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteString -> Int
BS.length ByteString
chunkSignatureHeader)
    crlfLength :: Integer
crlfLength = Int -> Integer
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 = Digest SHA256 -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
Bytes.encodeBase16 (Digest SHA256 -> ByteString)
-> (ByteString -> Digest SHA256) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256
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"