-- |
-- 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 {UTCTime
ByteString
Endpoint
metaSignature :: ByteString
metaEndpoint :: Endpoint
metaTime :: UTCTime
$sel:metaSignature:V2 :: V2 -> ByteString
$sel:metaEndpoint:V2 :: V2 -> Endpoint
$sel:metaTime:V2 :: V2 -> UTCTime
..} =
    [ByteStringBuilder] -> ByteStringBuilder
buildLines
      [ ByteStringBuilder
"[Version 2 Metadata] {",
        ByteStringBuilder
"  time      = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build UTCTime
metaTime,
        ByteStringBuilder
"  endpoint  = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (Endpoint -> ByteString
host Endpoint
metaEndpoint),
        ByteStringBuilder
"  signature = " forall a. Semigroup a => a -> a -> a
<> 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 forall a. Algorithm a
sign (forall a b. a -> b -> a
const 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
$sel:retry:Service :: Service -> Retry
$sel:error:Service :: Service -> Status -> [Header] -> ByteStringLazy -> Error
$sel:check:Service :: Service -> Status -> Bool
$sel:timeout:Service :: Service -> Maybe Seconds
$sel:endpoint:Service :: Service -> Region -> Endpoint
$sel:endpointPrefix:Service :: Service -> ByteString
$sel:s3AddressingStyle:Service :: Service -> S3AddressingStyle
$sel:version:Service :: Service -> ByteString
$sel:signingName:Service :: Service -> ByteString
$sel:signer:Service :: Service -> Signer
$sel:abbrev:Service :: Service -> Abbrev
retry :: Retry
error :: Status -> [Header] -> ByteStringLazy -> Error
check :: Status -> Bool
timeout :: Maybe Seconds
endpoint :: Region -> Endpoint
endpointPrefix :: ByteString
s3AddressingStyle :: S3AddressingStyle
version :: ByteString
signingName :: ByteString
signer :: Signer
abbrev :: Abbrev
..}, [Header]
StdMethod
QueryString
Path 'NoEncoding
RequestBody
$sel:body:Request :: forall a. Request a -> RequestBody
$sel:headers:Request :: forall a. Request a -> [Header]
$sel:query:Request :: forall a. Request a -> QueryString
$sel:path:Request :: forall a. Request a -> Path 'NoEncoding
$sel:method:Request :: forall a. Request a -> StdMethod
body :: RequestBody
headers :: [Header]
query :: QueryString
path :: Path 'NoEncoding
method :: StdMethod
..} AuthEnv {Maybe ISO8601
Maybe (Sensitive SessionToken)
Sensitive SecretKey
AccessKey
$sel:expiration:AuthEnv :: AuthEnv -> Maybe ISO8601
$sel:sessionToken:AuthEnv :: AuthEnv -> Maybe (Sensitive SessionToken)
$sel:secretAccessKey:AuthEnv :: AuthEnv -> Sensitive SecretKey
$sel:accessKeyId:AuthEnv :: AuthEnv -> AccessKey
expiration :: Maybe ISO8601
sessionToken :: Maybe (Sensitive SessionToken)
secretAccessKey :: Sensitive SecretKey
accessKeyId :: AccessKey
..} Region
r UTCTime
t = forall a. Meta -> ClientRequest -> Signed a
Signed Meta
meta ClientRequest
rq
  where
    meta :: Meta
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 = 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 = forall a. ToByteString a => a -> ByteString
toBS StdMethod
method
    path' :: ByteString
path' = forall a. ToByteString a => a -> ByteString
toBS (forall (a :: Encoding). Path a -> EscapedPath
escapePath forall a b. (a -> b) -> a -> b
$ Path 'NoEncoding
basePath forall a. Semigroup a => a -> a -> a
<> Path 'NoEncoding
path)

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

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

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

    token :: Maybe (ByteString, ByteString)
token = (ByteString
"SecurityToken" :: ByteString,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToByteString a => a -> ByteString
toBS 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 = forall a. ToByteString a => a -> ByteString
toBS (forall (a :: Format). UTCTime -> Time a
Time UTCTime
t :: ISO8601)