"Signing AWS requests with Signature Version 4" in Elm https://docs.aws.amazon.com/general/latest/gr/sigv4_signing.html

AWS.elm

module AWS exposing (Config, HttpRequest, Service(..), httpTask, sign__)

import Base16
import Crypto.HMAC
import Crypto.Hash
import DateFormat
import Http
import Json.Encode
import Task exposing (Task)
import Time
import Url
import Url.Builder
import Word.Bytes


type alias Config =
    { awsSecretAccessKey : String
    , awsRegion : String
    , accessKeyId : String
    , service : Service
    }


type Service
    = ServiceIam
    | ServiceDynamoDB


type alias HttpRequest x a =
    { method : String
    , headers : List ( String, String )
    , query : List ( String, String )
    , stringBody : String
    , resolver : Http.Resolver x a
    , timeout : Maybe Float
    }


{-| The equivalent of doing Http.task, but with AWS signing logistics done for you
-}
httpTask :
    Config
    -> Time.Posix
    -> HttpRequest x a
    -> Result String (Task x a)
httpTask config now { method, headers, query, stringBody, resolver, timeout } =
    let
        contentType =
            headers
                -- we try to use any content-type header given
                |> List.filter (\( k, v ) -> String.toLower k == "content-type")
                |> List.head
                |> Maybe.map Tuple.second
                -- otherwise default to json
                |> Maybe.withDefault "application/json; charset=utf-8"

        signatureResult =
            sign__
                config
                now
                { headers = headers
                , method = method
                , payload = stringBody
                , query = query
                }
    in
    case signatureResult of
        Err err ->
            Err err

        Ok signature ->
            let
                finalHeaders =
                    ( "Authorization", authorizationHeader config signature )
                        :: signature.headers

                httpHeaders =
                    finalHeaders
                        -- Http.Body includes content-type header; avoid duplicating it here
                        |> List.filter (\( k, v ) -> String.toLower k /= "content-type")
                        -- xhr2 doesn't allow overwriting `Host`
                        |> List.filter (\( k, v ) -> String.toLower k /= "host")
                        |> List.map (\( k, v ) -> Http.header k v)

                queryParams =
                    case
                        String.toList <|
                            Url.Builder.toQuery <|
                                List.map (\( k, v ) -> Url.Builder.string k v) query
                    of
                        '?' :: xs ->
                            Just (String.fromList xs)

                        _ ->
                            Nothing

                endpointUrl =
                    endpoint config
                        |> (\url -> { url | query = queryParams })
                        |> Url.toString

                task =
                    Http.task
                        { method = method
                        , headers = httpHeaders
                        , url = endpointUrl
                        , body = Http.stringBody contentType stringBody
                        , resolver = resolver
                        , timeout = timeout
                        }
            in
            Ok task


endpoint : Config -> Url.Url
endpoint { service, awsRegion } =
    let
        urlWithoutRegion =
            { protocol = Url.Https
            , host = serviceName service ++ ".amazonaws.com"
            , port_ = Nothing
            , path = "/"
            , query = Nothing
            , fragment = Nothing
            }
    in
    case service of
        ServiceIam ->
            urlWithoutRegion

        ServiceDynamoDB ->
            { urlWithoutRegion | host = serviceName service ++ "." ++ awsRegion ++ ".amazonaws.com" }


serviceName : Service -> String
serviceName service =
    case service of
        ServiceIam ->
            "iam"

        ServiceDynamoDB ->
            "dynamodb"


algorithm =
    "AWS4-HMAC-SHA256"


authorizationHeader : Config -> Signature -> String
authorizationHeader config signature =
    String.join ""
        [ algorithm
        , " Credential="
        , config.accessKeyId
        , "/"
        , signature.credentialScope
        , ", SignedHeaders="
        , signature.signedHeaders
        , ", Signature="
        , signature.text
        ]


type alias Signature =
    { text : String
    , credentialScope : String
    , headers : List ( String, String )
    , signedHeaders : String
    , algorithm : String
    }


{-| Signing AWS requests with Signature Version 4 <https://docs.aws.amazon.com/general/latest/gr/sigv4_signing.html>

    import Time

    nowMillisecond : Int
    nowMillisecond =
        1440938160000

    requestDateTime : Time.Posix
    requestDateTime =
        Time.millisToPosix nowMillisecond

    awsConfig : Config
    awsConfig =
        { awsSecretAccessKey = "wJalrXUtnFEMI/K7MDENG+bPxRfiCYEXAMPLEKEY"
        , awsRegion = "us-east-1"
        , accessKeyId = ""
        , service = ServiceIam
        }

    AWS.sign__
        awsConfig
        requestDateTime
        { method = "GET"
        , query =
            [ ( "Action", "ListUsers" )
            , ( "Version", "2010-05-08" )
            ]
        , headers =
            [ ( "Content-Type", "application/x-www-form-urlencoded; charset=utf-8" )
            ]
        , payload = ""
        } |> Result.map .text
    --> Ok "5d672d79c15b13162d9279b0855cfba6789a8edb4c82c400e06b5924a6f2b5d7"

NOTE: this function is only exposed to allow testing

-}
sign__ :
    Config
    -> Time.Posix
    ->
        { method : String
        , query : List ( String, String )
        , headers : List ( String, String )
        , payload : String
        }
    -> Result String Signature
sign__ config now request =
    let
        url =
            endpoint config

        yyyymmddThhmmssz =
            DateFormat.format
                [ DateFormat.yearNumber
                , DateFormat.monthFixed
                , DateFormat.dayOfMonthFixed
                , DateFormat.text "T"
                , DateFormat.hourMilitaryFixed
                , DateFormat.minuteFixed
                , DateFormat.secondFixed
                , DateFormat.text "Z"
                ]
                Time.utc
                now

        yyyymmdd =
            DateFormat.format
                [ DateFormat.yearNumber
                , DateFormat.monthFixed
                , DateFormat.dayOfMonthFixed
                ]
                Time.utc
                now

        headers =
            request.headers
                |> List.append
                    [ ( "X-Amz-Date", yyyymmddThhmmssz )
                    , ( "Host", url.host )
                    ]

        credentialScope =
            String.join "/" [ yyyymmdd, config.awsRegion, serviceName config.service, "aws4_request" ]

        signedHeaders =
            canonicalHeaderKeys headers

        canonicalRequest =
            String.join "\n"
                [ request.method
                , url.path
                , canonicalQuery request.query
                , canonicalHeaders headers
                , signedHeaders
                , Crypto.Hash.sha256 request.payload
                ]

        stringToSign =
            String.join "\n"
                [ algorithm
                , yyyymmddThhmmssz
                , credentialScope
                , Crypto.Hash.sha256 canonicalRequest
                ]

        signingKey =
            Word.Bytes.fromUTF8 ("AWS4" ++ config.awsSecretAccessKey)
                |> (\k -> Crypto.HMAC.digestBytes Crypto.HMAC.sha256 k (Word.Bytes.fromUTF8 yyyymmdd))
                |> (\k -> Crypto.HMAC.digestBytes Crypto.HMAC.sha256 k (Word.Bytes.fromUTF8 config.awsRegion))
                |> (\k -> Crypto.HMAC.digestBytes Crypto.HMAC.sha256 k (Word.Bytes.fromUTF8 (serviceName config.service)))
                |> (\k -> Crypto.HMAC.digestBytes Crypto.HMAC.sha256 k (Word.Bytes.fromUTF8 "aws4_request"))

        result =
            case List.head (List.filter (\( k, v ) -> String.toLower k == "host") request.headers) of
                Nothing ->
                    -- ok, we can proceed to sign
                    Crypto.HMAC.digestBytes Crypto.HMAC.sha256 signingKey (Word.Bytes.fromUTF8 stringToSign)
                        |> Base16.encode

                Just s ->
                    -- since the sign__ function is already a Result, let's fail explicitly
                    Err "Manually specifying `Host` header is not allowed by xhr2"
    in
    case result of
        Err err ->
            Err err

        Ok text ->
            Ok
                { text = String.toLower text
                , credentialScope = credentialScope
                , headers = headers
                , signedHeaders = signedHeaders
                , algorithm = algorithm
                }


canonicalQuery : List ( String, String ) -> String
canonicalQuery keyValues =
    List.sortBy (\( k, v ) -> k ++ v) keyValues
        |> List.map (\( k, v ) -> Url.percentEncode k ++ "=" ++ Url.percentEncode v)
        |> String.join "&"


canonicalHeaders : List ( String, String ) -> String
canonicalHeaders keyValues =
    List.map (\( k, v ) -> ( String.toLower k, String.trim v )) keyValues
        |> List.sortBy Tuple.first
        |> List.map (\( k, v ) -> k ++ ":" ++ v ++ "\n")
        |> String.join ""


canonicalHeaderKeys : List ( String, String ) -> String
canonicalHeaderKeys keyValues =
    List.map (\( k, v ) -> String.toLower k) keyValues
        |> List.sort
        |> String.join ";"