-- |
-- Module      : Amazonka.Sign.V4
-- 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
  ( Base.V4 (..),
    v4,
  )
where

import Amazonka.Data.Body
import Amazonka.Data.ByteString
import Amazonka.Data.Headers
import Amazonka.Data.Query
import Amazonka.Data.Time
import Amazonka.Lens ((%~), (<>~))
import Amazonka.Prelude
import Amazonka.Request
import qualified Amazonka.Sign.V4.Base as Base
import qualified Amazonka.Sign.V4.Chunked as Chunked
import Amazonka.Types
import qualified Data.CaseInsensitive as CI

v4 :: Signer
v4 :: Signer
v4 = (forall a. Algorithm a)
-> (forall a. Seconds -> Algorithm a) -> Signer
Signer forall a. Algorithm a
sign forall a. Seconds -> Algorithm a
presign

presign :: Seconds -> Algorithm a
presign :: Seconds -> Algorithm a
presign Seconds
ex Request a
rq AuthEnv
a Region
r UTCTime
ts = V4 -> RequestBody -> (ClientRequest -> ClientRequest) -> Signed a
forall a.
V4 -> RequestBody -> (ClientRequest -> ClientRequest) -> Signed a
Base.signRequest V4
meta RequestBody
forall a. Monoid a => a
mempty ClientRequest -> ClientRequest
auth
  where
    auth :: ClientRequest -> ClientRequest
auth = (ByteString -> Identity ByteString)
-> ClientRequest -> Identity ClientRequest
Lens' ClientRequest ByteString
clientRequestQuery ((ByteString -> Identity ByteString)
 -> ClientRequest -> Identity ClientRequest)
-> ByteString -> ClientRequest -> ClientRequest
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ (ByteString
"&X-Amz-Signature=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Signature -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (V4 -> Signature
Base.metaSignature V4
meta))

    meta :: V4
meta = AuthEnv
-> Region
-> UTCTime
-> (Credential -> SignedHeaders -> QueryString -> QueryString)
-> Hash
-> Request a
-> V4
forall a.
AuthEnv
-> Region
-> UTCTime
-> (Credential -> SignedHeaders -> QueryString -> QueryString)
-> Hash
-> Request a
-> V4
Base.signMetadata AuthEnv
a Region
r UTCTime
ts Credential -> SignedHeaders -> QueryString -> QueryString
presigner Hash
forall (s :: Symbol). Tag s ByteString
digest (Request a -> Request a
prepare Request a
rq)

    presigner :: Credential -> SignedHeaders -> QueryString -> QueryString
presigner Credential
c SignedHeaders
shs =
      ByteString -> ByteString -> QueryString -> QueryString
forall a.
ToQuery a =>
ByteString -> a -> QueryString -> QueryString
pair (CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
hAMZAlgorithm) ByteString
Base.algorithm
        (QueryString -> QueryString)
-> (QueryString -> QueryString) -> QueryString -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> QueryString -> QueryString
forall a.
ToQuery a =>
ByteString -> a -> QueryString -> QueryString
pair (CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
hAMZCredential) (Credential -> ByteString
forall a. ToByteString a => a -> ByteString
toBS Credential
c)
        (QueryString -> QueryString)
-> (QueryString -> QueryString) -> QueryString -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AWSTime -> QueryString -> QueryString
forall a.
ToQuery a =>
ByteString -> a -> QueryString -> QueryString
pair (CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
hAMZDate) (UTCTime -> AWSTime
forall (a :: Format). UTCTime -> Time a
Time UTCTime
ts :: AWSTime)
        (QueryString -> QueryString)
-> (QueryString -> QueryString) -> QueryString -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Seconds -> QueryString -> QueryString
forall a.
ToQuery a =>
ByteString -> a -> QueryString -> QueryString
pair (CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
hAMZExpires) Seconds
ex
        (QueryString -> QueryString)
-> (QueryString -> QueryString) -> QueryString -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> QueryString -> QueryString
forall a.
ToQuery a =>
ByteString -> a -> QueryString -> QueryString
pair (CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
hAMZSignedHeaders) (SignedHeaders -> ByteString
forall a. ToByteString a => a -> ByteString
toBS SignedHeaders
shs)
        (QueryString -> QueryString)
-> (QueryString -> QueryString) -> QueryString -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString -> QueryString -> QueryString
forall a.
ToQuery a =>
ByteString -> a -> QueryString -> QueryString
pair (CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
hAMZToken) (Sensitive SessionToken -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (Sensitive SessionToken -> ByteString)
-> Maybe (Sensitive SessionToken) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AuthEnv -> Maybe (Sensitive SessionToken)
_authSessionToken AuthEnv
a)

    digest :: Tag s ByteString
digest = ByteString -> Tag s ByteString
forall (s :: Symbol) a. a -> Tag s a
Base.Tag ByteString
"UNSIGNED-PAYLOAD"

    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] -> [Header]) -> Request a -> Request a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (CI ByteString -> ByteString -> [Header] -> [Header]
hdr CI ByteString
hHost ByteString
host)

    host :: ByteString
host =
      case (Endpoint -> Bool
_endpointSecure Endpoint
end, Endpoint -> Int
_endpointPort Endpoint
end) of
        (Bool
False, Int
80) -> Endpoint -> ByteString
_endpointHost Endpoint
end
        (Bool
True, Int
443) -> Endpoint -> ByteString
_endpointHost Endpoint
end
        (Bool
_, Int
port) -> Endpoint -> ByteString
_endpointHost Endpoint
end ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString
forall a. ToByteString a => a -> ByteString
toBS Int
port

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

sign :: Algorithm a
sign :: Algorithm a
sign Request a
rq AuthEnv
a Region
r UTCTime
ts =
  case Request a -> RequestBody
forall a. Request a -> RequestBody
_requestBody Request a
rq of
    Chunked ChunkedBody
x -> ChunkedBody -> Algorithm a
forall a. ChunkedBody -> Algorithm a
Chunked.chunked ChunkedBody
x Request a
rq AuthEnv
a Region
r UTCTime
ts
    Hashed HashedBody
x -> HashedBody -> Algorithm a
forall a. HashedBody -> Algorithm a
hashed HashedBody
x Request a
rq AuthEnv
a Region
r UTCTime
ts

hashed :: HashedBody -> Algorithm a
hashed :: HashedBody -> Algorithm a
hashed HashedBody
x Request a
rq AuthEnv
a Region
r UTCTime
ts =
  let (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.base (ByteString -> Hash
forall (s :: Symbol) a. a -> Tag s a
Base.Tag (HashedBody -> ByteString
sha256Base16 HashedBody
x)) Request a
rq AuthEnv
a Region
r UTCTime
ts
   in V4 -> RequestBody -> (ClientRequest -> ClientRequest) -> Signed a
forall a.
V4 -> RequestBody -> (ClientRequest -> ClientRequest) -> Signed a
Base.signRequest V4
meta (RequestBody -> RequestBody
toRequestBody (HashedBody -> RequestBody
Hashed HashedBody
x)) ClientRequest -> ClientRequest
auth