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

import Amazonka.Bytes
import Amazonka.Core.Lens.Internal ((<>~))
import Amazonka.Data.Body
import Amazonka.Data.ByteString
import Amazonka.Data.Headers
import Amazonka.Data.Query
import Amazonka.Data.Time
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 hiding (presign, sign)
import qualified Data.ByteString as BS
import qualified Data.CaseInsensitive as CI

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

-- |
-- Presigns a URL according to the AWS Request Signature V4 spec <https://docs.aws.amazon.com/general/latest/gr/sigv4_signing.html>.
-- In the case that the URL contains a payload that is not signed when sending requests to Amazon S3, a literal `UNSIGNED-PAYLOAD`
-- must be included when constructing the cannonical request. See <https://docs.aws.amazon.com/AmazonS3/latest/API/sig-v4-header-based-auth.html>
-- In the edge case that the request body is a @Amazonka.Data.Body.ChunkedBody@ we will also use the `UNSIGNED-PAYLOAD` literal as we won't consume the stream
-- to hash it.
presign :: Seconds -> Algorithm a
presign :: forall a. Seconds -> Algorithm a
presign Seconds
ex rq :: Request a
rq@Request {RequestBody
body :: RequestBody
$sel:body:Request :: forall a. Request a -> RequestBody
body, Service
service :: Service
$sel:service:Request :: forall a. Request a -> Service
service} AuthEnv
a Region
region 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
region UTCTime
ts Credential -> SignedHeaders -> QueryString -> QueryString
presigner Hash
digest (Request a -> Request a
forall a. 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)
sessionToken AuthEnv
a)

    digest :: Hash
digest =
      case RequestBody
body of
        Chunked ChunkedBody
_ -> Hash
forall {s :: Symbol}. Tag s ByteString
unsignedPayload
        Hashed (HashedStream Digest SHA256
h Integer
_ ConduitM () ByteString (ResourceT IO) ()
_) -> ByteString -> Hash
forall (s :: Symbol) a. a -> Tag s a
Base.Tag (ByteString -> Hash) -> ByteString -> Hash
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
encodeBase16 Digest SHA256
h
        Hashed (HashedBytes Digest SHA256
h ByteString
b)
          | ByteString -> Bool
BS.null ByteString
b Bool -> Bool -> Bool
&& Service -> ByteString
signingName Service
service ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"s3" -> Hash
forall {s :: Symbol}. Tag s ByteString
unsignedPayload
          | Bool
otherwise -> ByteString -> Hash
forall (s :: Symbol) a. a -> Tag s a
Base.Tag (ByteString -> Hash) -> ByteString -> Hash
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
encodeBase16 Digest SHA256
h

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

    prepare :: Request a -> Request a
    prepare :: forall a. Request a -> Request a
prepare r :: Request a
r@Request {[Header]
headers :: [Header]
$sel:headers:Request :: forall a. Request a -> [Header]
headers} = Request a
r {$sel:headers:Request :: [Header]
headers = CI ByteString -> ByteString -> [Header] -> [Header]
hdr CI ByteString
hHost ByteString
realHost [Header]
headers}

    realHost :: ByteString
realHost =
      case (Bool
secure, Int
port) of
        (Bool
False, Int
80) -> ByteString
host
        (Bool
True, Int
443) -> ByteString
host
        (Bool, Int)
_ -> [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [ByteString
host, ByteString
":", Int -> ByteString
forall a. ToByteString a => a -> ByteString
toBS Int
port]

    Endpoint {ByteString
host :: ByteString
$sel:host:Endpoint :: Endpoint -> ByteString
host, Int
port :: Int
$sel:port:Endpoint :: Endpoint -> Int
port, Bool
secure :: Bool
$sel:secure:Endpoint :: Endpoint -> Bool
secure} = Service -> Region -> Endpoint
endpoint Service
service Region
region

sign :: Algorithm a
sign :: forall a. Algorithm a
sign rq :: Request a
rq@Request {RequestBody
$sel:body:Request :: forall a. Request a -> RequestBody
body :: RequestBody
body} AuthEnv
a Region
r UTCTime
ts =
  case RequestBody
body 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 :: forall a. 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