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

import qualified Amazonka.Bytes as Bytes
import Amazonka.Core.Lens.Internal ((<>~), (^.))
import qualified Amazonka.Crypto as Crypto
import Amazonka.Data hiding (Path)
import Amazonka.Prelude
import Amazonka.Request
import Amazonka.Types
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BSL
import qualified Data.CaseInsensitive as CI
import qualified Data.Foldable as Foldable
import qualified Data.Map.Strict as Map
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Types as HTTP

data V4 = V4
  { V4 -> UTCTime
metaTime :: UTCTime,
    V4 -> Method
metaMethod :: Method,
    V4 -> Path
metaPath :: Path,
    V4 -> Endpoint
metaEndpoint :: Endpoint,
    V4 -> Credential
metaCredential :: Credential,
    V4 -> CanonicalQuery
metaCanonicalQuery :: CanonicalQuery,
    V4 -> CanonicalRequest
metaCanonicalRequest :: CanonicalRequest,
    V4 -> CanonicalHeaders
metaCanonicalHeaders :: CanonicalHeaders,
    V4 -> SignedHeaders
metaSignedHeaders :: SignedHeaders,
    V4 -> StringToSign
metaStringToSign :: StringToSign,
    V4 -> Signature
metaSignature :: Signature,
    V4 -> [Header]
metaHeaders :: [Header],
    V4 -> Maybe Seconds
metaTimeout :: Maybe Seconds
  }

instance ToLog V4 where
  build :: V4 -> Builder
build V4 {$sel:metaEndpoint:V4 :: V4 -> Endpoint
metaEndpoint = Endpoint {ByteString
$sel:host:Endpoint :: Endpoint -> ByteString
host :: ByteString
host}, [Header]
Maybe Seconds
UTCTime
Method
Path
Signature
Credential
CanonicalRequest
StringToSign
CanonicalQuery
CanonicalHeaders
SignedHeaders
metaTimeout :: Maybe Seconds
metaHeaders :: [Header]
metaSignature :: Signature
metaStringToSign :: StringToSign
metaSignedHeaders :: SignedHeaders
metaCanonicalHeaders :: CanonicalHeaders
metaCanonicalRequest :: CanonicalRequest
metaCanonicalQuery :: CanonicalQuery
metaCredential :: Credential
metaPath :: Path
metaMethod :: Method
metaTime :: UTCTime
$sel:metaTimeout:V4 :: V4 -> Maybe Seconds
$sel:metaHeaders:V4 :: V4 -> [Header]
$sel:metaSignature:V4 :: V4 -> Signature
$sel:metaStringToSign:V4 :: V4 -> StringToSign
$sel:metaSignedHeaders:V4 :: V4 -> SignedHeaders
$sel:metaCanonicalHeaders:V4 :: V4 -> CanonicalHeaders
$sel:metaCanonicalRequest:V4 :: V4 -> CanonicalRequest
$sel:metaCanonicalQuery:V4 :: V4 -> CanonicalQuery
$sel:metaCredential:V4 :: V4 -> Credential
$sel:metaPath:V4 :: V4 -> Path
$sel:metaMethod:V4 :: V4 -> Method
$sel:metaTime:V4 :: V4 -> UTCTime
..} =
    [Builder] -> Builder
buildLines
      [ Builder
"[Version 4 Metadata] {",
        Builder
"  time              = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> Builder
build UTCTime
metaTime,
        Builder
"  endpoint          = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> Builder
build ByteString
host,
        Builder
"  credential        = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> Builder
build Credential
metaCredential,
        Builder
"  signed headers    = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> Builder
build SignedHeaders
metaSignedHeaders,
        Builder
"  signature         = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> Builder
build Signature
metaSignature,
        Builder
"  string to sign    = {",
        forall a. ToLog a => a -> Builder
build StringToSign
metaStringToSign,
        Builder
"  }",
        Builder
"  canonical request = {",
        forall a. ToLog a => a -> Builder
build CanonicalRequest
metaCanonicalRequest,
        Builder
"  }",
        Builder
"}"
      ]

base ::
  Hash ->
  Request a ->
  AuthEnv ->
  Region ->
  UTCTime ->
  (V4, ClientRequest -> ClientRequest)
base :: forall a.
Hash
-> Request a
-> AuthEnv
-> Region
-> UTCTime
-> (V4, ClientRequest -> ClientRequest)
base Hash
h Request a
rq AuthEnv
a Region
region UTCTime
ts = (V4
meta, ClientRequest -> ClientRequest
auth)
  where
    auth :: ClientRequest -> ClientRequest
auth = Lens' ClientRequest [Header]
clientRequestHeaders forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [(CI ByteString
HTTP.hAuthorization, V4 -> ByteString
authorisation V4
meta)]

    meta :: V4
meta = forall a.
AuthEnv
-> Region
-> UTCTime
-> (Credential -> SignedHeaders -> QueryString -> QueryString)
-> Hash
-> Request a
-> V4
signMetadata AuthEnv
a Region
region UTCTime
ts forall {p} {p} {a}. p -> p -> a -> a
presigner Hash
h (forall a. Request a -> Request a
prepare Request a
rq)

    presigner :: p -> p -> a -> a
presigner p
_ p
_ = forall a. a -> a
id

    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 b. a -> (a -> b) -> b
& CI ByteString -> ByteString -> [Header] -> [Header]
hdr CI ByteString
hHost ByteString
realHost
              forall a b. a -> (a -> b) -> b
& CI ByteString -> ByteString -> [Header] -> [Header]
hdr CI ByteString
hAMZDate (forall a. ToByteString a => a -> ByteString
toBS (forall (a :: Format). UTCTime -> Time a
Time UTCTime
ts :: AWSTime))
              forall a b. a -> (a -> b) -> b
& CI ByteString -> ByteString -> [Header] -> [Header]
hdr CI ByteString
hAMZContentSHA256 (forall a. ToByteString a => a -> ByteString
toBS Hash
h)
              forall a b. a -> (a -> b) -> b
& forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (CI ByteString -> ByteString -> [Header] -> [Header]
hdr CI ByteString
hAMZToken forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToByteString a => a -> ByteString
toBS) (AuthEnv -> Maybe (Sensitive SessionToken)
sessionToken AuthEnv
a)
        }

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

    Endpoint {ByteString
host :: ByteString
$sel:host:Endpoint :: Endpoint -> ByteString
host, Int
$sel:port:Endpoint :: Endpoint -> Int
port :: Int
port, Bool
$sel:secure:Endpoint :: Endpoint -> Bool
secure :: Bool
secure} = Service -> Region -> Endpoint
endpoint (forall a. Request a -> Service
service Request a
rq) Region
region

-- | Used to tag provenance. This allows keeping the same layout as
-- the signing documentation, passing 'ByteString's everywhere, with
-- some type guarantees.
--
-- Data.Tagged is not used for no reason other than the dependency, syntactic length,
-- and the ToByteString instance.
newtype Tag (s :: Symbol) a = Tag {forall (s :: Symbol) a. Tag s a -> a
untag :: a}
  deriving stock (Int -> Tag s a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Symbol) a. Show a => Int -> Tag s a -> ShowS
forall (s :: Symbol) a. Show a => [Tag s a] -> ShowS
forall (s :: Symbol) a. Show a => Tag s a -> String
showList :: [Tag s a] -> ShowS
$cshowList :: forall (s :: Symbol) a. Show a => [Tag s a] -> ShowS
show :: Tag s a -> String
$cshow :: forall (s :: Symbol) a. Show a => Tag s a -> String
showsPrec :: Int -> Tag s a -> ShowS
$cshowsPrec :: forall (s :: Symbol) a. Show a => Int -> Tag s a -> ShowS
Show)

instance ToByteString (Tag s ByteString) where toBS :: Tag s ByteString -> ByteString
toBS = forall (s :: Symbol) a. Tag s a -> a
untag

instance ToLog (Tag s ByteString) where build :: Tag s ByteString -> Builder
build = forall a. ToLog a => a -> Builder
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Symbol) a. Tag s a -> a
untag

instance ToByteString CredentialScope where
  toBS :: CredentialScope -> ByteString
toBS = ByteString -> [ByteString] -> ByteString
BS8.intercalate ByteString
"/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Symbol) a. Tag s a -> a
untag

type Hash = Tag "body-digest" ByteString

type StringToSign = Tag "string-to-sign" ByteString

type Credential = Tag "credential" ByteString

type CredentialScope = Tag "credential-scope" [ByteString]

type CanonicalRequest = Tag "canonical-request" ByteString

type CanonicalHeaders = Tag "canonical-headers" ByteString

type CanonicalQuery = Tag "canonical-query" ByteString

type SignedHeaders = Tag "signed-headers" ByteString

type NormalisedHeaders = Tag "normalised-headers" [(ByteString, ByteString)]

type Method = Tag "method" ByteString

type CanonicalPath = Tag "canonical-path" ByteString

type Path = Tag "path" ByteString

type Signature = Tag "signature" ByteString

authorisation :: V4 -> ByteString
authorisation :: V4 -> ByteString
authorisation V4 {[Header]
Maybe Seconds
UTCTime
Endpoint
Method
Path
Signature
Credential
CanonicalRequest
StringToSign
CanonicalQuery
CanonicalHeaders
SignedHeaders
metaTimeout :: Maybe Seconds
metaHeaders :: [Header]
metaSignature :: Signature
metaStringToSign :: StringToSign
metaSignedHeaders :: SignedHeaders
metaCanonicalHeaders :: CanonicalHeaders
metaCanonicalRequest :: CanonicalRequest
metaCanonicalQuery :: CanonicalQuery
metaCredential :: Credential
metaEndpoint :: Endpoint
metaPath :: Path
metaMethod :: Method
metaTime :: UTCTime
$sel:metaTimeout:V4 :: V4 -> Maybe Seconds
$sel:metaHeaders:V4 :: V4 -> [Header]
$sel:metaSignature:V4 :: V4 -> Signature
$sel:metaStringToSign:V4 :: V4 -> StringToSign
$sel:metaSignedHeaders:V4 :: V4 -> SignedHeaders
$sel:metaCanonicalHeaders:V4 :: V4 -> CanonicalHeaders
$sel:metaCanonicalRequest:V4 :: V4 -> CanonicalRequest
$sel:metaCanonicalQuery:V4 :: V4 -> CanonicalQuery
$sel:metaCredential:V4 :: V4 -> Credential
$sel:metaEndpoint:V4 :: V4 -> Endpoint
$sel:metaPath:V4 :: V4 -> Path
$sel:metaMethod:V4 :: V4 -> Method
$sel:metaTime:V4 :: V4 -> UTCTime
..} =
  forall a. Monoid a => [a] -> a
mconcat
    [ ByteString
algorithm,
      ByteString
" Credential=",
      forall a. ToByteString a => a -> ByteString
toBS Credential
metaCredential,
      ByteString
", SignedHeaders=",
      forall a. ToByteString a => a -> ByteString
toBS SignedHeaders
metaSignedHeaders,
      ByteString
", Signature=",
      forall a. ToByteString a => a -> ByteString
toBS Signature
metaSignature
    ]

signRequest ::
  -- | Pre-signRequestd signing metadata.
  V4 ->
  -- | The request body.
  Client.RequestBody ->
  -- | Insert authentication information.
  (ClientRequest -> ClientRequest) ->
  Signed a
signRequest :: forall a.
V4 -> RequestBody -> (ClientRequest -> ClientRequest) -> Signed a
signRequest m :: V4
m@V4 {[Header]
Maybe Seconds
UTCTime
Endpoint
Method
Path
Signature
Credential
CanonicalRequest
StringToSign
CanonicalQuery
CanonicalHeaders
SignedHeaders
metaTimeout :: Maybe Seconds
metaHeaders :: [Header]
metaSignature :: Signature
metaStringToSign :: StringToSign
metaSignedHeaders :: SignedHeaders
metaCanonicalHeaders :: CanonicalHeaders
metaCanonicalRequest :: CanonicalRequest
metaCanonicalQuery :: CanonicalQuery
metaCredential :: Credential
metaEndpoint :: Endpoint
metaPath :: Path
metaMethod :: Method
metaTime :: UTCTime
$sel:metaTimeout:V4 :: V4 -> Maybe Seconds
$sel:metaHeaders:V4 :: V4 -> [Header]
$sel:metaSignature:V4 :: V4 -> Signature
$sel:metaStringToSign:V4 :: V4 -> StringToSign
$sel:metaSignedHeaders:V4 :: V4 -> SignedHeaders
$sel:metaCanonicalHeaders:V4 :: V4 -> CanonicalHeaders
$sel:metaCanonicalRequest:V4 :: V4 -> CanonicalRequest
$sel:metaCanonicalQuery:V4 :: V4 -> CanonicalQuery
$sel:metaCredential:V4 :: V4 -> Credential
$sel:metaEndpoint:V4 :: V4 -> Endpoint
$sel:metaPath:V4 :: V4 -> Path
$sel:metaMethod:V4 :: V4 -> Method
$sel:metaTime:V4 :: V4 -> UTCTime
..} RequestBody
b ClientRequest -> ClientRequest
auth = forall a. Meta -> ClientRequest -> Signed a
Signed (forall a. ToLog a => a -> Meta
Meta V4
m) (ClientRequest -> ClientRequest
auth ClientRequest
rq)
  where
    rq :: ClientRequest
rq =
      (Endpoint -> Maybe Seconds -> ClientRequest
newClientRequest Endpoint
metaEndpoint Maybe Seconds
metaTimeout)
        { method :: ByteString
Client.method = forall a. ToByteString a => a -> ByteString
toBS Method
metaMethod,
          path :: ByteString
Client.path = forall a. ToByteString a => a -> ByteString
toBS Path
metaPath,
          queryString :: ByteString
Client.queryString = ByteString
qry,
          requestHeaders :: [Header]
Client.requestHeaders = [Header]
metaHeaders,
          requestBody :: RequestBody
Client.requestBody = RequestBody
b
        }

    qry :: ByteString
qry
      | ByteString -> Bool
BS.null ByteString
x = ByteString
x
      | Bool
otherwise = Char
'?' Char -> ByteString -> ByteString
`BS8.cons` ByteString
x
      where
        x :: ByteString
x = forall a. ToByteString a => a -> ByteString
toBS CanonicalQuery
metaCanonicalQuery

signMetadata ::
  AuthEnv ->
  Region ->
  UTCTime ->
  (Credential -> SignedHeaders -> QueryString -> QueryString) ->
  Hash ->
  Request a ->
  V4
signMetadata :: forall a.
AuthEnv
-> Region
-> UTCTime
-> (Credential -> SignedHeaders -> QueryString -> QueryString)
-> Hash
-> Request a
-> V4
signMetadata AuthEnv
a Region
r UTCTime
ts Credential -> SignedHeaders -> QueryString -> QueryString
presign Hash
digest rq :: Request a
rq@Request {[Header]
headers :: [Header]
$sel:headers:Request :: forall a. Request a -> [Header]
headers, StdMethod
$sel:method:Request :: forall a. Request a -> StdMethod
method :: StdMethod
method, QueryString
$sel:query:Request :: forall a. Request a -> QueryString
query :: QueryString
query, Service
service :: Service
$sel:service:Request :: forall a. Request a -> Service
service} =
  V4
    { $sel:metaTime:V4 :: UTCTime
metaTime = UTCTime
ts,
      $sel:metaMethod:V4 :: Method
metaMethod = Method
method',
      $sel:metaPath:V4 :: Path
metaPath = Path
path,
      $sel:metaEndpoint:V4 :: Endpoint
metaEndpoint = Endpoint
end,
      $sel:metaCredential:V4 :: Credential
metaCredential = Credential
cred,
      $sel:metaCanonicalQuery:V4 :: CanonicalQuery
metaCanonicalQuery = CanonicalQuery
query',
      $sel:metaCanonicalRequest:V4 :: CanonicalRequest
metaCanonicalRequest = CanonicalRequest
crq,
      $sel:metaCanonicalHeaders:V4 :: CanonicalHeaders
metaCanonicalHeaders = CanonicalHeaders
chs,
      $sel:metaSignedHeaders:V4 :: SignedHeaders
metaSignedHeaders = SignedHeaders
shs,
      $sel:metaStringToSign:V4 :: StringToSign
metaStringToSign = StringToSign
sts,
      $sel:metaSignature:V4 :: Signature
metaSignature = 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 StringToSign
sts,
      $sel:metaHeaders:V4 :: [Header]
metaHeaders = [Header]
headers,
      $sel:metaTimeout:V4 :: Maybe Seconds
metaTimeout = Service -> Maybe Seconds
timeout Service
service
    }
  where
    query' :: CanonicalQuery
query' = QueryString -> CanonicalQuery
canonicalQuery forall a b. (a -> b) -> a -> b
$ Credential -> SignedHeaders -> QueryString -> QueryString
presign Credential
cred SignedHeaders
shs QueryString
query

    sts :: StringToSign
sts = UTCTime -> CredentialScope -> CanonicalRequest -> StringToSign
stringToSign UTCTime
ts CredentialScope
scope CanonicalRequest
crq
    cred :: Credential
cred = AccessKey -> CredentialScope -> Credential
credential (AuthEnv -> AccessKey
accessKeyId AuthEnv
a) CredentialScope
scope
    scope :: CredentialScope
scope = Service -> Endpoint -> UTCTime -> CredentialScope
credentialScope Service
service Endpoint
end UTCTime
ts
    crq :: CanonicalRequest
crq = Method
-> CanonicalPath
-> Hash
-> CanonicalQuery
-> CanonicalHeaders
-> SignedHeaders
-> CanonicalRequest
canonicalRequest Method
method' CanonicalPath
cpath Hash
digest CanonicalQuery
query' CanonicalHeaders
chs SignedHeaders
shs

    chs :: CanonicalHeaders
chs = NormalisedHeaders -> CanonicalHeaders
canonicalHeaders NormalisedHeaders
normalisedHeaders
    shs :: SignedHeaders
shs = NormalisedHeaders -> SignedHeaders
signedHeaders NormalisedHeaders
normalisedHeaders
    normalisedHeaders :: NormalisedHeaders
normalisedHeaders = [Header] -> NormalisedHeaders
normaliseHeaders [Header]
headers

    end :: Endpoint
end = Service -> Region -> Endpoint
endpoint Service
service Region
r
    method' :: Method
method' = forall (s :: Symbol) a. a -> Tag s a
Tag forall a b. (a -> b) -> a -> b
$ forall a. ToByteString a => a -> ByteString
toBS StdMethod
method
    path :: Path
path = forall a. Region -> Request a -> Path
escapedPath Region
r Request a
rq
    cpath :: CanonicalPath
cpath = forall a. Region -> Request a -> CanonicalPath
canonicalPath Region
r Request a
rq

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

signature :: SecretKey -> CredentialScope -> StringToSign -> Signature
signature :: SecretKey -> CredentialScope -> StringToSign -> Signature
signature SecretKey
k CredentialScope
c = forall (s :: Symbol) a. a -> Tag s a
Tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteArrayAccess a => a -> ByteString
Bytes.encodeBase16 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteArrayAccess a => ByteString -> a -> HMAC SHA256
Crypto.hmacSHA256 ByteString
signingKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Symbol) a. Tag s a -> a
untag
  where
    signingKey :: ByteString
signingKey = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' forall {bout} {a}.
(ByteArray bout, ByteArrayAccess a) =>
ByteString -> a -> bout
hmac (ByteString
"AWS4" forall a. Semigroup a => a -> a -> a
<> forall a. ToByteString a => a -> ByteString
toBS SecretKey
k) (forall (s :: Symbol) a. Tag s a -> a
untag CredentialScope
c)

    hmac :: ByteString -> a -> bout
hmac ByteString
x a
y = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
Bytes.convert (forall a. ByteArrayAccess a => ByteString -> a -> HMAC SHA256
Crypto.hmacSHA256 ByteString
x a
y)

stringToSign :: UTCTime -> CredentialScope -> CanonicalRequest -> StringToSign
stringToSign :: UTCTime -> CredentialScope -> CanonicalRequest -> StringToSign
stringToSign UTCTime
t CredentialScope
c CanonicalRequest
r =
  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,
        forall a. ToByteString a => a -> ByteString
toBS (forall (a :: Format). UTCTime -> Time a
Time UTCTime
t :: AWSTime),
        forall a. ToByteString a => a -> ByteString
toBS CredentialScope
c,
        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 forall a b. (a -> b) -> a -> b
$ forall a. ToByteString a => a -> ByteString
toBS CanonicalRequest
r
      ]

credential :: AccessKey -> CredentialScope -> Credential
credential :: AccessKey -> CredentialScope -> Credential
credential AccessKey
k CredentialScope
c = forall (s :: Symbol) a. a -> Tag s a
Tag (forall a. ToByteString a => a -> ByteString
toBS AccessKey
k forall a. Semigroup a => a -> a -> a
<> ByteString
"/" forall a. Semigroup a => a -> a -> a
<> forall a. ToByteString a => a -> ByteString
toBS CredentialScope
c)

credentialScope :: Service -> Endpoint -> UTCTime -> CredentialScope
credentialScope :: Service -> Endpoint -> UTCTime -> CredentialScope
credentialScope Service {ByteString
$sel:signingName:Service :: Service -> ByteString
signingName :: ByteString
signingName} Endpoint {ByteString
$sel:scope:Endpoint :: Endpoint -> ByteString
scope :: ByteString
scope} UTCTime
t =
  forall (s :: Symbol) a. a -> Tag s a
Tag
    [ forall a. ToByteString a => a -> ByteString
toBS (forall (a :: Format). UTCTime -> Time a
Time UTCTime
t :: BasicTime),
      forall a. ToByteString a => a -> ByteString
toBS ByteString
scope,
      forall a. ToByteString a => a -> ByteString
toBS ByteString
signingName,
      ByteString
"aws4_request"
    ]

canonicalRequest ::
  Method ->
  CanonicalPath ->
  Hash ->
  CanonicalQuery ->
  CanonicalHeaders ->
  SignedHeaders ->
  CanonicalRequest
canonicalRequest :: Method
-> CanonicalPath
-> Hash
-> CanonicalQuery
-> CanonicalHeaders
-> SignedHeaders
-> CanonicalRequest
canonicalRequest Method
meth CanonicalPath
path Hash
digest CanonicalQuery
query CanonicalHeaders
chs SignedHeaders
shs =
  forall (s :: Symbol) a. a -> Tag s a
Tag forall a b. (a -> b) -> a -> b
$
    ByteString -> [ByteString] -> ByteString
BS8.intercalate
      ByteString
"\n"
      [ forall a. ToByteString a => a -> ByteString
toBS Method
meth,
        forall a. ToByteString a => a -> ByteString
toBS CanonicalPath
path,
        forall a. ToByteString a => a -> ByteString
toBS CanonicalQuery
query,
        forall a. ToByteString a => a -> ByteString
toBS CanonicalHeaders
chs,
        forall a. ToByteString a => a -> ByteString
toBS SignedHeaders
shs,
        forall a. ToByteString a => a -> ByteString
toBS Hash
digest
      ]

escapedPath :: Region -> Request a -> Path
escapedPath :: forall a. Region -> Request a -> Path
escapedPath Region
r rq :: Request a
rq@Request {$sel:service:Request :: forall a. Request a -> Service
service = Service {Abbrev
$sel:abbrev:Service :: Service -> Abbrev
abbrev :: Abbrev
abbrev}} =
  forall (s :: Symbol) a. a -> Tag s a
Tag forall a b. (a -> b) -> a -> b
$ case Abbrev
abbrev of
    Abbrev
"S3" -> forall a. ToByteString a => a -> ByteString
toBS forall a b. (a -> b) -> a -> b
$ forall (a :: Encoding). Path a -> EscapedPath
escapePath RawPath
p
    Abbrev
_ -> forall a. ToByteString a => a -> ByteString
toBS forall a b. (a -> b) -> a -> b
$ forall (a :: Encoding). Path a -> EscapedPath
escapePath forall a b. (a -> b) -> a -> b
$ forall (a :: Encoding). Path a -> Path a
collapsePath RawPath
p
  where
    p :: RawPath
p = forall a. Region -> Request a -> RawPath
fullRawPath Region
r Request a
rq

canonicalPath :: Region -> Request a -> CanonicalPath
canonicalPath :: forall a. Region -> Request a -> CanonicalPath
canonicalPath Region
r rq :: Request a
rq@Request {$sel:service:Request :: forall a. Request a -> Service
service = Service {Abbrev
abbrev :: Abbrev
$sel:abbrev:Service :: Service -> Abbrev
abbrev}} =
  forall (s :: Symbol) a. a -> Tag s a
Tag forall a b. (a -> b) -> a -> b
$ case Abbrev
abbrev of
    Abbrev
"S3" -> forall a. ToByteString a => a -> ByteString
toBS forall a b. (a -> b) -> a -> b
$ forall (a :: Encoding). Path a -> EscapedPath
escapePath RawPath
p
    Abbrev
_ -> forall a. ToByteString a => a -> ByteString
toBS forall a b. (a -> b) -> a -> b
$ forall (a :: Encoding). Path a -> TwiceEscapedPath
escapePathTwice forall a b. (a -> b) -> a -> b
$ forall (a :: Encoding). Path a -> Path a
collapsePath RawPath
p
  where
    p :: RawPath
p = forall a. Region -> Request a -> RawPath
fullRawPath Region
r Request a
rq

-- | The complete raw path for a request, including any 'basePath' on
-- the endpoint.
fullRawPath :: Region -> Request a -> RawPath
fullRawPath :: forall a. Region -> Request a -> RawPath
fullRawPath Region
r Request {RawPath
$sel:path:Request :: forall a. Request a -> RawPath
path :: RawPath
path, $sel:service:Request :: forall a. Request a -> Service
service = Service {Region -> Endpoint
endpoint :: Region -> Endpoint
$sel:endpoint:Service :: Service -> Region -> Endpoint
endpoint}} =
  Endpoint -> RawPath
basePath (Region -> Endpoint
endpoint Region
r) forall a. Semigroup a => a -> a -> a
<> RawPath
path

canonicalQuery :: QueryString -> CanonicalQuery
canonicalQuery :: QueryString -> CanonicalQuery
canonicalQuery = forall (s :: Symbol) a. a -> Tag s a
Tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToByteString a => a -> ByteString
toBS

-- FIXME: the following use of stripBS is too naive, should remove
-- all internal whitespace, replacing with a single space char,
-- unless quoted with \"...\"
canonicalHeaders :: NormalisedHeaders -> CanonicalHeaders
canonicalHeaders :: NormalisedHeaders -> CanonicalHeaders
canonicalHeaders = forall (s :: Symbol) a. a -> Tag s a
Tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Builder
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Symbol) a. Tag s a -> a
untag
  where
    f :: ByteString -> ByteString -> Builder
f ByteString
k ByteString
v = ByteString -> Builder
BSB.byteString ByteString
k forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BSB.char7 Char
':' forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString (ByteString -> ByteString
stripBS ByteString
v) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BSB.char7 Char
'\n'

signedHeaders :: NormalisedHeaders -> SignedHeaders
signedHeaders :: NormalisedHeaders -> SignedHeaders
signedHeaders = forall (s :: Symbol) a. a -> Tag s a
Tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
BS8.intercalate ByteString
";" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Symbol) a. Tag s a -> a
untag

normaliseHeaders :: [Header] -> NormalisedHeaders
normaliseHeaders :: [Header] -> NormalisedHeaders
normaliseHeaders =
  forall (s :: Symbol) a. a -> Tag s a
Tag
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall s. CI s -> s
CI.foldedCase)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toAscList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Map k a
Map.delete CI ByteString
"authorization"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Map k a
Map.delete CI ByteString
"content-length"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a b. a -> b -> a
const