-- |
-- Module      : Amazonka.Sign.V2
-- 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.V2
  ( v2,
  )
where

import qualified Amazonka.Bytes as Bytes
import qualified Amazonka.Crypto as Crypto
import Amazonka.Data
import Amazonka.Prelude hiding (error)
import Amazonka.Types hiding (presign, sign)
import qualified Data.ByteString.Char8 as BS8
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Types as HTTP
import qualified Network.HTTP.Types.URI as URI

data V2 = V2
  { V2 -> UTCTime
metaTime :: UTCTime,
    V2 -> Endpoint
metaEndpoint :: Endpoint,
    V2 -> ByteString
metaSignature :: ByteString
  }

instance ToLog V2 where
  build :: V2 -> ByteStringBuilder
build V2 {ByteString
UTCTime
Endpoint
$sel:metaTime:V2 :: V2 -> UTCTime
$sel:metaEndpoint:V2 :: V2 -> Endpoint
$sel:metaSignature:V2 :: V2 -> ByteString
metaTime :: UTCTime
metaEndpoint :: Endpoint
metaSignature :: ByteString
..} =
    [ByteStringBuilder] -> ByteStringBuilder
buildLines
      [ ByteStringBuilder
"[Version 2 Metadata] {",
        ByteStringBuilder
"  time      = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> UTCTime -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build UTCTime
metaTime,
        ByteStringBuilder
"  endpoint  = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build (Endpoint -> ByteString
host Endpoint
metaEndpoint),
        ByteStringBuilder
"  signature = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build ByteString
metaSignature,
        ByteStringBuilder
"}"
      ]

v2 :: Signer
v2 :: Signer
v2 = (forall a. Algorithm a)
-> (forall a. Seconds -> Algorithm a) -> Signer
Signer Algorithm a
forall a. Algorithm a
sign (Algorithm a -> Seconds -> Algorithm a
forall a b. a -> b -> a
const Algorithm a
forall a. Algorithm a
sign) -- FIXME: revisit v2 presigning.

sign :: Algorithm a
sign :: forall a. Algorithm a
sign Request {$sel:service:Request :: forall a. Request a -> Service
service = Service {Maybe Seconds
ByteString
S3AddressingStyle
Signer
Retry
Abbrev
Status -> Bool
Status -> [Header] -> ByteStringLazy -> Error
Region -> Endpoint
abbrev :: Abbrev
signer :: Signer
signingName :: ByteString
version :: ByteString
s3AddressingStyle :: S3AddressingStyle
endpointPrefix :: ByteString
endpoint :: Region -> Endpoint
timeout :: Maybe Seconds
check :: Status -> Bool
error :: Status -> [Header] -> ByteStringLazy -> Error
retry :: Retry
$sel:abbrev:Service :: Service -> Abbrev
$sel:signer:Service :: Service -> Signer
$sel:signingName:Service :: Service -> ByteString
$sel:version:Service :: Service -> ByteString
$sel:s3AddressingStyle:Service :: Service -> S3AddressingStyle
$sel:endpointPrefix:Service :: Service -> ByteString
$sel:endpoint:Service :: Service -> Region -> Endpoint
$sel:timeout:Service :: Service -> Maybe Seconds
$sel:check:Service :: Service -> Status -> Bool
$sel:error:Service :: Service -> Status -> [Header] -> ByteStringLazy -> Error
$sel:retry:Service :: Service -> Retry
..}, [Header]
StdMethod
QueryString
Path 'NoEncoding
RequestBody
method :: StdMethod
path :: Path 'NoEncoding
query :: QueryString
headers :: [Header]
body :: RequestBody
$sel:method:Request :: forall a. Request a -> StdMethod
$sel:path:Request :: forall a. Request a -> Path 'NoEncoding
$sel:query:Request :: forall a. Request a -> QueryString
$sel:headers:Request :: forall a. Request a -> [Header]
$sel:body:Request :: forall a. Request a -> RequestBody
..} AuthEnv {Maybe ISO8601
Maybe (Sensitive SessionToken)
Sensitive SecretKey
AccessKey
accessKeyId :: AccessKey
secretAccessKey :: Sensitive SecretKey
sessionToken :: Maybe (Sensitive SessionToken)
expiration :: Maybe ISO8601
$sel:accessKeyId:AuthEnv :: AuthEnv -> AccessKey
$sel:secretAccessKey:AuthEnv :: AuthEnv -> Sensitive SecretKey
$sel:sessionToken:AuthEnv :: AuthEnv -> Maybe (Sensitive SessionToken)
$sel:expiration:AuthEnv :: AuthEnv -> Maybe ISO8601
..} Region
r UTCTime
t = Meta -> ClientRequest -> Signed a
forall a. Meta -> ClientRequest -> Signed a
Signed Meta
meta ClientRequest
rq
  where
    meta :: Meta
meta = V2 -> Meta
forall a. ToLog a => a -> Meta
Meta (UTCTime -> Endpoint -> ByteString -> V2
V2 UTCTime
t Endpoint
end ByteString
signature)

    rq :: ClientRequest
rq =
      (Endpoint -> Maybe Seconds -> ClientRequest
newClientRequest Endpoint
end Maybe Seconds
timeout)
        { method :: ByteString
Client.method = ByteString
meth,
          path :: ByteString
Client.path = ByteString
path',
          queryString :: ByteString
Client.queryString = QueryString -> ByteString
forall a. ToByteString a => a -> ByteString
toBS QueryString
authorised,
          requestHeaders :: [Header]
Client.requestHeaders = [Header]
headers',
          requestBody :: RequestBody
Client.requestBody = RequestBody -> RequestBody
toRequestBody RequestBody
body
        }

    meth :: ByteString
meth = StdMethod -> ByteString
forall a. ToByteString a => a -> ByteString
toBS StdMethod
method
    path' :: ByteString
path' = EscapedPath -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (Path 'NoEncoding -> EscapedPath
forall (a :: Encoding). Path a -> EscapedPath
escapePath (Path 'NoEncoding -> EscapedPath)
-> Path 'NoEncoding -> EscapedPath
forall a b. (a -> b) -> a -> b
$ Path 'NoEncoding
basePath Path 'NoEncoding -> Path 'NoEncoding -> Path 'NoEncoding
forall a. Semigroup a => a -> a -> a
<> Path 'NoEncoding
path)

    end :: Endpoint
end@Endpoint {Bool
Int
ByteString
Path 'NoEncoding
$sel:host:Endpoint :: Endpoint -> ByteString
basePath :: Path 'NoEncoding
host :: ByteString
secure :: Bool
port :: Int
scope :: ByteString
$sel:basePath:Endpoint :: Endpoint -> Path 'NoEncoding
$sel:secure:Endpoint :: Endpoint -> Bool
$sel:port:Endpoint :: Endpoint -> Int
$sel:scope:Endpoint :: Endpoint -> ByteString
..} = Region -> Endpoint
endpoint Region
r

    authorised :: QueryString
authorised = ByteString -> ByteString -> QueryString -> QueryString
forall a.
ToQuery a =>
ByteString -> a -> QueryString -> QueryString
pair ByteString
"Signature" (Bool -> ByteString -> ByteString
URI.urlEncode Bool
True ByteString
signature) QueryString
query

    signature :: ByteString
signature =
      HMAC SHA256 -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
Bytes.encodeBase64
        (HMAC SHA256 -> ByteString)
-> (ByteString -> HMAC SHA256) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> HMAC SHA256
forall a. ByteArrayAccess a => ByteString -> a -> HMAC SHA256
Crypto.hmacSHA256 (Sensitive SecretKey -> ByteString
forall a. ToByteString a => a -> ByteString
toBS Sensitive SecretKey
secretAccessKey)
        (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
BS8.intercalate
          ByteString
"\n"
          [ ByteString
meth,
            ByteString
host,
            ByteString
path',
            QueryString -> ByteString
forall a. ToByteString a => a -> ByteString
toBS QueryString
query'
          ]

    query' :: QueryString
query' =
      ByteString -> ByteString -> QueryString -> QueryString
forall a.
ToQuery a =>
ByteString -> a -> QueryString -> QueryString
pair ByteString
"Version" ByteString
version
        (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 ByteString
"SignatureVersion" (ByteString
"2" :: ByteString)
        (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 ByteString
"SignatureMethod" (ByteString
"HmacSHA256" :: ByteString)
        (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 ByteString
"Timestamp" ByteString
time
        (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 ByteString
"AWSAccessKeyId" (AccessKey -> ByteString
forall a. ToByteString a => a -> ByteString
toBS AccessKey
accessKeyId)
        (QueryString -> QueryString) -> QueryString -> QueryString
forall a b. (a -> b) -> a -> b
$ QueryString
query QueryString -> QueryString -> QueryString
forall a. Semigroup a => a -> a -> a
<> QueryString
-> ((ByteString, ByteString) -> QueryString)
-> Maybe (ByteString, ByteString)
-> QueryString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe QueryString
forall a. Monoid a => a
mempty (ByteString, ByteString) -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery Maybe (ByteString, ByteString)
token

    token :: Maybe (ByteString, ByteString)
token = (ByteString
"SecurityToken" :: ByteString,) (ByteString -> (ByteString, ByteString))
-> (Sensitive SessionToken -> ByteString)
-> Sensitive SessionToken
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sensitive SessionToken -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (Sensitive SessionToken -> (ByteString, ByteString))
-> Maybe (Sensitive SessionToken) -> Maybe (ByteString, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Sensitive SessionToken)
sessionToken

    headers' :: [Header]
headers' = HeaderName -> ByteString -> [Header] -> [Header]
hdr HeaderName
HTTP.hDate ByteString
time [Header]
headers

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