-- |
-- 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 forall a. Algorithm a
sign 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
$sel:body:Request :: forall a. Request a -> RequestBody
body :: RequestBody
body, Service
$sel:service:Request :: forall a. Request a -> Service
service :: Service
service} AuthEnv
a Region
region UTCTime
ts =
  forall a.
V4 -> RequestBody -> (ClientRequest -> ClientRequest) -> Signed a
Base.signRequest V4
meta forall a. Monoid a => a
mempty ClientRequest -> ClientRequest
auth
  where
    auth :: ClientRequest -> ClientRequest
auth = Lens' ClientRequest ByteString
clientRequestQuery forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ (ByteString
"&X-Amz-Signature=" forall a. Semigroup a => a -> a -> a
<> forall a. ToByteString a => a -> ByteString
toBS (V4 -> Signature
Base.metaSignature V4
meta))

    meta :: V4
meta = 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 (forall a. Request a -> Request a
prepare Request a
rq)

    presigner :: Credential -> SignedHeaders -> QueryString -> QueryString
presigner Credential
c SignedHeaders
shs =
      forall a.
ToQuery a =>
ByteString -> a -> QueryString -> QueryString
pair (forall s. CI s -> s
CI.original HeaderName
hAMZAlgorithm) ByteString
Base.algorithm
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ToQuery a =>
ByteString -> a -> QueryString -> QueryString
pair (forall s. CI s -> s
CI.original HeaderName
hAMZCredential) (forall a. ToByteString a => a -> ByteString
toBS Credential
c)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ToQuery a =>
ByteString -> a -> QueryString -> QueryString
pair (forall s. CI s -> s
CI.original HeaderName
hAMZDate) (forall (a :: Format). UTCTime -> Time a
Time UTCTime
ts :: AWSTime)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ToQuery a =>
ByteString -> a -> QueryString -> QueryString
pair (forall s. CI s -> s
CI.original HeaderName
hAMZExpires) Seconds
ex
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ToQuery a =>
ByteString -> a -> QueryString -> QueryString
pair (forall s. CI s -> s
CI.original HeaderName
hAMZSignedHeaders) (forall a. ToByteString a => a -> ByteString
toBS SignedHeaders
shs)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ToQuery a =>
ByteString -> a -> QueryString -> QueryString
pair (forall s. CI s -> s
CI.original HeaderName
hAMZToken) (forall a. ToByteString a => a -> ByteString
toBS 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
_ -> forall {s :: Symbol}. Tag s ByteString
unsignedPayload
        Hashed (HashedStream Digest SHA256
h Integer
_ ConduitM () ByteString (ResourceT IO) ()
_) -> forall (s :: Symbol) a. a -> Tag s a
Base.Tag forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== ByteString
"s3" -> forall {s :: Symbol}. Tag s ByteString
unsignedPayload
          | Bool
otherwise -> forall (s :: Symbol) a. a -> Tag s a
Base.Tag forall a b. (a -> b) -> a -> b
$ forall a. ByteArrayAccess a => a -> ByteString
encodeBase16 Digest SHA256
h

    unsignedPayload :: Tag s ByteString
unsignedPayload = 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]
$sel:headers:Request :: forall a. Request a -> [Header]
headers :: [Header]
headers} = Request a
r {$sel:headers:Request :: [Header]
headers = HeaderName -> ByteString -> [Header] -> [Header]
hdr HeaderName
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)
_ -> forall a. Monoid a => [a] -> a
mconcat [ByteString
host, ByteString
":", forall a. ToByteString a => a -> ByteString
toBS Int
port]

    Endpoint {ByteString
$sel:host:Endpoint :: Endpoint -> ByteString
host :: ByteString
host, Int
$sel:port:Endpoint :: Endpoint -> Int
port :: Int
port, Bool
$sel:secure:Endpoint :: Endpoint -> Bool
secure :: 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
body :: RequestBody
$sel:body:Request :: forall a. Request a -> RequestBody
body} AuthEnv
a Region
r UTCTime
ts =
  case RequestBody
body of
    Chunked ChunkedBody
x -> forall a. ChunkedBody -> Algorithm a
Chunked.chunked ChunkedBody
x Request a
rq AuthEnv
a Region
r UTCTime
ts
    Hashed HashedBody
x -> 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) = forall a.
Hash
-> Request a
-> AuthEnv
-> Region
-> UTCTime
-> (V4, ClientRequest -> ClientRequest)
Base.base (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 forall a.
V4 -> RequestBody -> (ClientRequest -> ClientRequest) -> Signed a
Base.signRequest V4
meta (RequestBody -> RequestBody
toRequestBody (HashedBody -> RequestBody
Hashed HashedBody
x)) ClientRequest -> ClientRequest
auth