AWS Messaging & Targeting Blog

SES and Haskell

Introduction

Amazon SES and most of the other AWS services have SDKs for languages like Java, .NET, PHP, Python, and Ruby. Most SDKs are just wrappers around the HTTP APIs that the services provide. If your favorite language isn’t supported by an AWS SDK, you can write your own client or use third-party APIs to call SES. In this post we are going to look at implementing a very minimal SES client in Haskell, a purely functional programming language.

I’ll cover some basic housekeeping before moving forward with the tutorial. In order to best follow this tutorial, you will need to have an intermediate level of understanding of Haskell and a basic understanding of SES. Haskell has several string-like types and this can create some confusion for beginners. String and Text are for textual data while ByteString is usually for binary data. Since the cryptographic functions provided in the cryptohash library work on ByteStrings, we will use ByteString for essentially everything in our example with the exception of error messages and parsing SES responses. We will also use the http-conduit library to make the HTTP requests to AWS and the GHC extension OverloadedStrings so we can type ByteStrings as string literals. This blog will be in the form of a literate haskell file where the code and explanations are together. First we will show the imports of libraries that we will be using.

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Applicative
import Control.Monad
import Crypto.Hash (Digest, SHA256, hmac, hmacGetDigest, hash, digestToHexByteString)
import Data.Byteable (toBytes)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as B16 (encode)
import qualified Data.ByteString.Char8 as C
import Data.CaseInsensitive (original)
import Data.Char (toLower)
import Data.Text (Text, unpack)
import Data.Time (getCurrentTime)
import Data.Time.Format (formatTime, FormatTime)
import Data.Time.Clock (UTCTime)
import Data.List (intersperse, lines, sortBy)
import Data.Monoid ((<>))
import Network.HTTP.Conduit
import Network.HTTP.Types
import Network.HTTP.Types.Header
import Network.HTTP.Types.Method
import System.Locale (defaultTimeLocale)
import System.Environment (getEnv)

import Blaze.ByteString.Builder (toByteString)
import Data.Aeson

Signing AWS Requests

The first and arguably most difficult part of calling SES via HTTP is signing requests for authentication. We are going to implement the latest version of the request signing process which is documented here.

First, we need a function that can create a canonical request from the raw HTTP request. This essentially comes down to appending several parameters separated by newlines.


canonicalRequest :: Request -> ByteString -> ByteString
canonicalRequest req body = C.concat $
    intersperse "n"
        [ method req
        , path req
        , queryString req
        , canonicalHeaders req
        , signedHeaders req
        , hexHash body
        ]
hexHash :: ByteString -> ByteString
hexHash p = digestToHexByteString (hash p :: Digest SHA256)

The canonical headers parameter is created by separating each header name and header value by a colon and then separating each of those strings with a new line. In http-conduit, the host header is not included in the requestHeaders field of the Request record so we need to add that manually.

headers :: Request -> [Header]
headers req = sortBy ((a,_) (b,_) -> compare a b) (("host", host req) : requestHeaders req)

canonicalHeaders :: Request -> ByteString
canonicalHeaders req =
    C.concat $ map ((hn,hv) -> bsToLower (original hn) <> ":" <> hv <> "n") hs
  where hs = headers req

bsToLower :: ByteString -> ByteString
bsToLower = C.map toLower

The signed headers parameter is a list of lowercase header names separated by semicolons.

signedHeaders :: Request -> ByteString
signedHeaders req =
    C.concat . intersperse ";"  $ map ((hn,_) -> bsToLower (original hn)) hs
  where hs = headers req

Now we have to create the derived key. The HMAC algorithm takes a key and plaintext and returns a fixed length string. We create the derived key by repeatedly using the HMAC algorithm to hash a value and then using the returned value as the key for the subsequent hash. The starting key is the user’s AWS secret access key prepended by the string “AWS4”. The values that will be hashed are the date, region, service, and finally, the string “aws4_request”.

v4DerivedKey :: ByteString -> -- ^ AWS Secret Access Key
                ByteString -> -- ^ Date in YYYYMMDD format
                ByteString -> -- ^ AWS region
                ByteString -> -- ^ AWS service
                ByteString
v4DerivedKey secretAccessKey date region service = hmacSHA256 kService "aws4_request"
  where kDate = hmacSHA256 ("AWS4" <> secretAccessKey) date
        kRegion = hmacSHA256 kDate region
        kService = hmacSHA256 kRegion service

hmacSHA256 :: ByteString -> ByteString -> ByteString
hmacSHA256 key p = toBytes $ (hmacGetDigest $ hmac key p :: Digest SHA256)

Next, we create the string to sign. This string contains the information we have computed up to this point along with the AWS region, the AWS service name, and the current time. For SES, the service name is “ses”.

stringToSign :: UTCTime    -> -- ^ current time
                ByteString -> -- ^ The AWS region
                ByteString -> -- ^ The AWS service
                ByteString -> -- ^ Hashed canonical request
                ByteString
stringToSign date region service hashConReq = C.concat
    [ "AWS4-HMAC-SHA256n"
    , C.pack (formatAmzDate date) , "n"
    , C.pack (format date) , "/"
    , region , "/"
    , service
    , "/aws4_requestn"
    , hashConReq
    ]

format :: UTCTime -> String
format = formatTime defaultTimeLocale "%Y%m%d"

formatAmzDate :: UTCTime -> String
formatAmzDate = formatTime defaultTimeLocale "%Y%m%dT%H%M%SZ"

Finally, we create the signature by combining the canonical request, the string to sign, and the derived key. Although the Request type has a field for the request body, we explicitly pass the body of the request around because we only want to deal with strict ByteStrings for simplicity.

createSignature ::  Request         -> -- ^ Http request
                    ByteString      -> -- ^ Body of the request
                    UTCTime         -> -- ^ Current time
                    ByteString      -> -- ^ Secret Access Key
                    ByteString      -> -- ^ AWS region
                    ByteString
createSignature req body now key region = v4Signature dKey toSign
  where canReqHash = hexHash $ canonicalRequest req body
        toSign = stringToSign now region "ses" canReqHash
        dKey = v4DerivedKey key (C.pack $ format now) region "ses"

v4Signature :: ByteString -> ByteString -> ByteString
v4Signature derivedKey payLoad = B16.encode $ hmacSHA256 derivedKey payLoad

With the version 4 signing implemented, we can move on to implementing the SendEmail call.

SES SendEmailCall

SES is currently available in three AWS regions: us-east-1, us-west-2, and eu-west-1. The HTTP endpoints for SES can be found here.

We define a simple record that carries all of the information required to call the SendEmail API.

data SendEmailRequest = SendEmailRequest
    { region            :: ByteString
    , accessKeyId       :: ByteString
    , secretAccessKey   :: ByteString
    , source            :: ByteString
    , to                :: [ByteString]
    , subject           :: ByteString
    , body              :: ByteString
    } deriving Show

usEast1 :: ByteString
usEast1 = "us-east-1"

usWest2 :: ByteString
usWest2 = "us-west-2"

euWest1 :: ByteString
euWest1 = "eu-west-1"

The http-conduit library parses the URL and then we configure it further based on the parameters of the SendEmailRequest. By setting the accept header to “text/json”, SES will return a response in JSON which we can then parse with the aeson library. The x-amz-date header is required to make AWS requests. Finally, we sign the request and add the authentication header before sending the request to SES.

sendEmail :: SendEmailRequest -> IO (Either String SendEmailResponse)
sendEmail sendReq = do
    fReq <- parseUrl $ "https://email." ++ C.unpack (region sendReq) ++ ".amazonaws.com"
    now <- getCurrentTime
    let req = fReq
                { requestHeaders =
                    [ ("Accept", "text/json")
                    , ("Content-Type", "application/x-www-form-urlencoded")
                    , ("x-amz-date", C.pack $ formatAmzDate now)
                    ]
                , method = "POST"
                , requestBody = RequestBodyBS reqBody
                }
        sig = createSignature req reqBody now (secretAccessKey sendReq) (region sendReq)
    resp <- withManager (httpLbs (authenticateRequest sendReq now req reqBody))
    case responseStatus resp of
        (Status 200 _) -> return $ eitherDecode (responseBody resp)
        (Status code msg) ->
            return $ Left ("Request failed with status code <" ++
                show code ++ "> and message <" ++ C.unpack msg ++ ">")
  where
    reqBody = renderSimpleQuery False $
                    [ ("Action", "SendEmail")
                    , ("Source", source sendReq)
                    ] ++ toAddressQuery (to sendReq) ++
                    [ ("Message.Subject.Data", subject sendReq)
                    , ("Message.Body.Text.Data", body sendReq)
                    ]

authenticateRequest :: SendEmailRequest -> UTCTime -> Request -> ByteString -> Request
authenticateRequest sendReq now req body =
    req { requestHeaders =
            authHeader now (accessKeyId sendReq)
                           (signedHeaders req) sig
                           (region sendReq) :
                           (requestHeaders req)
        }
  where sig = createSignature req body now (secretAccessKey sendReq) (region sendReq)
  
toAddressQuery :: [ByteString] -> SimpleQuery
toAddressQuery tos =
    zipWith (index address ->
                ( "Destination.ToAddresses.member." <>
                    C.pack (show index)
                , address)
            ) [1..] tos

authHeader ::   UTCTime     -> -- ^ Current time
                ByteString  -> -- ^ Secret access key
                ByteString  -> -- ^ Signed headers
                ByteString  -> -- ^ Signature
                ByteString  -> -- ^ AWS Region
                Header
authHeader now sId signHeads sig region =
    ( "Authorization"
    , C.concat
        [ "AWS4-HMAC-SHA256 Credential="
        , sId , "/"
        , C.pack (format now) , "/" 
        , region
        , "/ses/aws4_request, SignedHeaders="
        , signHeads
        , ", Signature="
        , sig
        ]
    )

SES provides a response to successful requests with the request ID and message ID. To handle SES responses, we will use the Either type and follow a common practice in Haskell, which is to use the Left side for information about a failure and the Right side for the result of a success. If we receive any response code other than HTTP success code 200, we will return an error in the left side of the Either type. For successful calls, we will use aeson to decode the request. We have created a data structure to hold the request and message IDs and a FromJSON instance to decode the JSON.

data SendEmailResponse = SendEmailResponse
    { requestId     :: Text
    , messageId     :: Text
    } deriving Show

instance FromJSON SendEmailResponse where
    parseJSON (Object o) = do
        response <- o .: "SendEmailResponse"
        reqId <- response .: "ResponseMetadata" >>= (.: "RequestId")
        msgId <- response .: "SendEmailResult" >>= (.: "MessageId")
        return $ SendEmailResponse reqId msgId
    parseJSON _ = mzero

To make an actual call to SES we use our AWS access key ID and secret access key to construct the appropriate SendEmailRequest. We then pass that request to the sendEmail function.

main :: IO ()
main = do
    awsId <- C.pack <$> getEnv "AWS_ACCESS_KEY_ID"
    awsSecret <- C.pack <$> getEnv "AWS_SECRET_ACCESS_KEY"
    let sendRequest = SendEmailRequest usEast1 awsId awsSecret "sender@example.com"
                        ["receiver@example.com"] "Sent from Haskell"
                        "This email was sent through SES using Haskell!"
    response <- sendEmail sendRequest
    case response of
        Left err -> putStrLn $ "Failed to send : " ++ err
        Right resp ->
            putStrLn $ "Successfully sent with message ID : " ++ unpack (messageId resp)

Now we have a minimal working example to call SES from Haskell! Happy sending!