module Amazonka.Sign.V2Header
( v2Header,
newSigner,
toSignerQueryBS,
constructSigningHeader,
constructSigningQuery,
constructFullPath,
unionNecessaryHeaders,
)
where
import qualified Amazonka.Bytes as Bytes
import qualified Amazonka.Crypto as Crypto
import Amazonka.Data
import qualified Amazonka.Data.Query as Query
import Amazonka.Prelude
import Amazonka.Types hiding (presign, sign)
import qualified Data.ByteString.Builder as Build
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as LBS
import qualified Data.CaseInsensitive as CI
import qualified Data.Function as Function
import qualified Data.List as List
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Types as HTTP
import qualified Network.HTTP.Types.URI as URI
data =
{ :: UTCTime,
:: Endpoint,
:: ByteString,
:: HTTP.RequestHeaders,
:: ByteString
}
instance ToLog V2Header where
build :: V2Header -> ByteStringBuilder
build V2Header {RequestHeaders
ByteString
UTCTime
Endpoint
$sel:metaTime:V2Header :: V2Header -> UTCTime
$sel:metaEndpoint:V2Header :: V2Header -> Endpoint
$sel:metaSignature:V2Header :: V2Header -> ByteString
$sel:headers:V2Header :: V2Header -> RequestHeaders
$sel:signer:V2Header :: V2Header -> ByteString
metaTime :: UTCTime
metaEndpoint :: Endpoint
metaSignature :: ByteString
headers :: RequestHeaders
signer :: ByteString
..} =
[ByteStringBuilder] -> ByteStringBuilder
buildLines
[ ByteStringBuilder
"[Version 2 Header 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
" headers = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> RequestHeaders -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build RequestHeaders
headers,
ByteStringBuilder
" signer = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build ByteString
signer,
ByteStringBuilder
"}"
]
v2Header :: Signer
= (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)
sign :: Algorithm a
sign :: forall a. Algorithm a
sign Request {RequestHeaders
StdMethod
QueryString
Path 'NoEncoding
RequestBody
Service
service :: Service
method :: StdMethod
path :: Path 'NoEncoding
query :: QueryString
headers :: RequestHeaders
body :: RequestBody
$sel:service:Request :: forall a. Request a -> Service
$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 -> RequestHeaders
$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 = V2Header -> Meta
forall a. ToLog a => a -> Meta
Meta (UTCTime
-> Endpoint
-> ByteString
-> RequestHeaders
-> ByteString
-> V2Header
V2Header UTCTime
t Endpoint
end ByteString
signature RequestHeaders
headers ByteString
signer)
signer :: ByteString
signer = RequestHeaders
-> ByteString -> ByteString -> QueryString -> ByteString
newSigner RequestHeaders
headers' ByteString
meth ByteString
path' QueryString
query
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
query,
requestHeaders :: RequestHeaders
Client.requestHeaders = RequestHeaders
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 {Path 'NoEncoding
basePath :: Path 'NoEncoding
$sel:basePath:Endpoint :: Endpoint -> Path 'NoEncoding
basePath} = Region -> Endpoint
endpoint Region
r
Service {Maybe Seconds
timeout :: Maybe Seconds
$sel:timeout:Service :: Service -> Maybe Seconds
timeout, Region -> Endpoint
endpoint :: Region -> Endpoint
$sel:endpoint:Service :: Service -> Region -> Endpoint
endpoint} = Service
service
signature :: ByteString
signature =
HMAC SHA1 -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
Bytes.encodeBase64
(HMAC SHA1 -> ByteString)
-> (ByteString -> HMAC SHA1) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> HMAC SHA1
forall a. ByteArrayAccess a => ByteString -> a -> HMAC SHA1
Crypto.hmacSHA1 (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
signer
headers' :: RequestHeaders
headers' =
RequestHeaders
headers
RequestHeaders
-> (RequestHeaders -> RequestHeaders) -> RequestHeaders
forall a b. a -> (a -> b) -> b
& HeaderName -> ByteString -> RequestHeaders -> RequestHeaders
hdr HeaderName
HTTP.hAuthorization (ByteString
"AWS " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> AccessKey -> ByteString
forall a. ToByteString a => a -> ByteString
toBS AccessKey
accessKeyId ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
signature)
RequestHeaders
-> (RequestHeaders -> RequestHeaders) -> RequestHeaders
forall a b. a -> (a -> b) -> b
& HeaderName -> ByteString -> RequestHeaders -> RequestHeaders
hdr HeaderName
HTTP.hDate ByteString
time
time :: ByteString
time = RFC822 -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (UTCTime -> RFC822
forall (a :: Format). UTCTime -> Time a
Time UTCTime
t :: RFC822)
newSigner ::
HTTP.RequestHeaders ->
ByteString ->
ByteString ->
Query.QueryString ->
ByteString
newSigner :: RequestHeaders
-> ByteString -> ByteString -> QueryString -> ByteString
newSigner RequestHeaders
headers ByteString
method ByteString
path QueryString
query = ByteString
signer
where
signer :: ByteString
signer =
ByteString -> [ByteString] -> ByteString
BS8.intercalate
ByteString
"\n"
( ByteString
method
ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: (Header -> ByteString) -> RequestHeaders -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Header -> ByteString
constructSigningHeader (RequestHeaders -> RequestHeaders
forall a. Ord a => [a] -> [a]
List.sort RequestHeaders
filteredHeaders)
[ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString -> ByteString -> ByteString
constructFullPath ByteString
path (QueryString -> ByteString
toSignerQueryBS QueryString
filteredQuery)]
)
filteredHeaders :: RequestHeaders
filteredHeaders = RequestHeaders -> RequestHeaders
unionNecessaryHeaders ((Header -> Bool) -> RequestHeaders -> RequestHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter Header -> Bool
isInterestingHeader RequestHeaders
headers)
filteredQuery :: QueryString
filteredQuery = QueryString -> QueryString
constructSigningQuery QueryString
query
toSignerQueryBS :: Query.QueryString -> ByteString
toSignerQueryBS :: QueryString -> ByteString
toSignerQueryBS =
ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (QueryString -> ByteString) -> QueryString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringBuilder -> ByteString
Build.toLazyByteString (ByteStringBuilder -> ByteString)
-> (QueryString -> ByteStringBuilder) -> QueryString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteStringBuilder
cat ([ByteString] -> ByteStringBuilder)
-> (QueryString -> [ByteString])
-> QueryString
-> ByteStringBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. Ord a => [a] -> [a]
List.sort ([ByteString] -> [ByteString])
-> (QueryString -> [ByteString]) -> QueryString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> QueryString -> [ByteString]
enc Maybe ByteString
forall a. Maybe a
Nothing
where
enc :: Maybe ByteString -> Query.QueryString -> [ByteString]
enc :: Maybe ByteString -> QueryString -> [ByteString]
enc Maybe ByteString
p = \case
Query.QList [QueryString]
xs -> (QueryString -> [ByteString]) -> [QueryString] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe ByteString -> QueryString -> [ByteString]
enc Maybe ByteString
p) [QueryString]
xs
Query.QPair (Bool -> ByteString -> ByteString
URI.urlEncode Bool
True -> ByteString
k) QueryString
x
| Just ByteString
n <- Maybe ByteString
p -> Maybe ByteString -> QueryString -> [ByteString]
enc (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
kdelim ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
k)) QueryString
x
| Bool
otherwise -> Maybe ByteString -> QueryString -> [ByteString]
enc (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
k) QueryString
x
Query.QValue (Just (Bool -> ByteString -> ByteString
URI.urlEncode Bool
True -> ByteString
v))
| Just ByteString
n <- Maybe ByteString
p -> [ByteString
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
vsep ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
v]
| Bool
otherwise -> [ByteString
v]
QueryString
_
| Just ByteString
n <- Maybe ByteString
p -> [ByteString
n]
| Bool
otherwise -> []
cat :: [ByteString] -> ByteStringBuilder
cat :: [ByteString] -> ByteStringBuilder
cat [] = ByteStringBuilder
forall a. Monoid a => a
mempty
cat [ByteString
x] = ByteString -> ByteStringBuilder
Build.byteString ByteString
x
cat (ByteString
x : [ByteString]
xs) = ByteString -> ByteStringBuilder
Build.byteString ByteString
x ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
ksep ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> ByteStringBuilder
cat [ByteString]
xs
kdelim :: ByteString
kdelim = ByteString
"."
ksep :: ByteStringBuilder
ksep = ByteStringBuilder
"&"
vsep :: ByteString
vsep = ByteString
"="
hasAWSPrefix :: CI.CI ByteString -> Bool
hasAWSPrefix :: HeaderName -> Bool
hasAWSPrefix = ByteString -> ByteString -> Bool
BS8.isPrefixOf ByteString
"aws-" (ByteString -> Bool)
-> (HeaderName -> ByteString) -> HeaderName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> ByteString
forall s. CI s -> s
CI.foldedCase
isInterestingQueryKey :: ByteString -> Bool
isInterestingQueryKey :: ByteString -> Bool
isInterestingQueryKey = \case
ByteString
"acl" -> Bool
True
ByteString
"cors" -> Bool
True
ByteString
"defaultObjectAcl" -> Bool
True
ByteString
"location" -> Bool
True
ByteString
"logging" -> Bool
True
ByteString
"partNumber" -> Bool
True
ByteString
"policy" -> Bool
True
ByteString
"requestPayment" -> Bool
True
ByteString
"torrent" -> Bool
True
ByteString
"versioning" -> Bool
True
ByteString
"versionId" -> Bool
True
ByteString
"versions" -> Bool
True
ByteString
"website" -> Bool
True
ByteString
"uploads" -> Bool
True
ByteString
"uploadId" -> Bool
True
ByteString
"response-content-type" -> Bool
True
ByteString
"response-content-language" -> Bool
True
ByteString
"response-expires" -> Bool
True
ByteString
"response-cache-control" -> Bool
True
ByteString
"response-content-disposition" -> Bool
True
ByteString
"response-content-encoding" -> Bool
True
ByteString
"delete" -> Bool
True
ByteString
"lifecycle" -> Bool
True
ByteString
"tagging" -> Bool
True
ByteString
"restore" -> Bool
True
ByteString
"storageClass" -> Bool
True
ByteString
"websiteConfig" -> Bool
True
ByteString
"compose" -> Bool
True
ByteString
_ -> Bool
False
isInterestingHeader :: HTTP.Header -> Bool
(HeaderName
name, ByteString
_)
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
HTTP.hDate = Bool
True
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
HTTP.hContentMD5 = Bool
True
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
HTTP.hContentType = Bool
True
| HeaderName -> Bool
hasAWSPrefix HeaderName
name = Bool
True
| Bool
otherwise = Bool
False
constructSigningQuery :: Query.QueryString -> Query.QueryString
constructSigningQuery :: QueryString -> QueryString
constructSigningQuery = \case
Query.QValue {} -> Maybe ByteString -> QueryString
Query.QValue Maybe ByteString
forall a. Maybe a
Nothing
Query.QList [QueryString]
qs -> [QueryString] -> QueryString
Query.QList ((QueryString -> QueryString) -> [QueryString] -> [QueryString]
forall a b. (a -> b) -> [a] -> [b]
map QueryString -> QueryString
constructSigningQuery [QueryString]
qs)
Query.QPair ByteString
k QueryString
v
| ByteString -> Bool
isInterestingQueryKey ByteString
k -> ByteString -> QueryString -> QueryString
Query.QPair ByteString
k QueryString
v
| Bool
otherwise -> Maybe ByteString -> QueryString
Query.QValue Maybe ByteString
forall a. Maybe a
Nothing
constructSigningHeader :: HTTP.Header -> ByteString
(HeaderName
name, ByteString
value)
| HeaderName -> Bool
hasAWSPrefix HeaderName
name = HeaderName -> ByteString
forall s. CI s -> s
CI.foldedCase HeaderName
name ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
value
| Bool
otherwise = ByteString
value
constructFullPath :: ByteString -> ByteString -> ByteString
constructFullPath :: ByteString -> ByteString -> ByteString
constructFullPath ByteString
path ByteString
q
| ByteString -> Bool
BS8.null ByteString
q = ByteString
path
| Bool
otherwise = ByteString
path ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"?" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
q
unionNecessaryHeaders :: [HTTP.Header] -> [HTTP.Header]
=
(RequestHeaders -> RequestHeaders -> RequestHeaders)
-> RequestHeaders -> RequestHeaders -> RequestHeaders
forall a b c. (a -> b -> c) -> b -> a -> c
flip
((Header -> Header -> Bool)
-> RequestHeaders -> RequestHeaders -> RequestHeaders
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
List.unionBy ((HeaderName -> HeaderName -> Bool)
-> (Header -> HeaderName) -> Header -> Header -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
Function.on HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
(==) Header -> HeaderName
forall a b. (a, b) -> a
fst))
[ (HeaderName
HTTP.hContentMD5, ByteString
""),
(HeaderName
HTTP.hContentType, ByteString
"")
]