diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,43 @@ +## 0.4.5 + +* Bump lower dependency bounds +* Remove CPP +* Use `ram` instead of `memory` as a dependency. `memory` is abandoned. + +## 0.4.4 + +* Use `crypton` instead of `cryptohash` as a dependency. `cryptohash` is abandoned. +* Avoid deprecated conduit functions. +* New maintainer: Janus Troelsen + +## 0.4.3 + +* Add function 'sendMailSESWithResponse'. + +## 0.4.2 + +* Add executable `send-aws` for sending e-mails via Amazon SES from command line. +* Update Signature Version for Amazon SES from 3 to 4. + +## 0.4.1 + +* Add 'renderSendMailSESGlobal' and 'sendMailSESGlobal' function which uses the global manager. + +## 0.4.0.0 + +* Support IAM temp credentials. This is a backwards-incompatible change that adds + a field to the SES type to represent (optional) session tokens when using roles + attached to EC2 instances. +* Make fields in the `SES` data type strict to promote warnings to errors. + +## 0.3.2.3 + +http-client 0.5 support + +## 0.3.2.2 + +`time` 1.5 support + +## 0.3.2 + +Expose `SESException` datatype and constructor. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +1,20 @@ -Copyright (c)2011, Michael Snoyman - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. +Copyright (c) 2014 Michael Snoyman, http://www.yesodweb.com/ - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: - * Neither the name of Michael Snoyman nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Network/Mail/Mime/SES.hs b/Network/Mail/Mime/SES.hs --- a/Network/Mail/Mime/SES.hs +++ b/Network/Mail/Mime/SES.hs @@ -2,69 +2,101 @@ {-# LANGUAGE OverloadedStrings #-} module Network.Mail.Mime.SES ( sendMailSES + , sendMailSESWithResponse + , sendMailSESGlobal , renderSendMailSES + , renderSendMailSESGlobal , SES (..) + , usEast1 + , usWest2 + , euWest1 + , SESException (..) ) where import Control.Exception (Exception, throwIO) import Control.Monad.IO.Class (MonadIO, liftIO) -import Crypto.Hash (Digest, SHA256, hmac, - hmacGetDigest) -import Data.Byteable (toBytes) import Data.ByteString (ByteString) import Data.ByteString.Base64 (encode) import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L -import Data.Conduit (Sink, await, ($$), (=$)) +import Data.Conduit (ConduitT, await, connect, (.|)) import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.Encoding as E import Data.Time (getCurrentTime) -import Data.Time.Format (formatTime) import Data.Typeable (Typeable) +import Data.Void (Void) import Data.XML.Types (Content (ContentText), Event (EventBeginElement, EventContent)) -import Network.HTTP.Client (Manager, checkStatus, parseUrl, +import Network.HTTP.Client (Manager, requestHeaders, responseBody, responseStatus, urlEncodedBody, withResponse) import Network.HTTP.Client.Conduit (bodyReaderSource) import Network.HTTP.Types (Status) +import Network.HTTP.Client.TLS (getGlobalManager) import Network.Mail.Mime (Mail, renderMail') -import System.Locale (defaultTimeLocale) import Text.XML.Stream.Parse (def, parseBytes) +import Network.Mail.Mime.SES.Internal + data SES = SES - { sesFrom :: ByteString - , sesTo :: [ByteString] - , sesAccessKey :: ByteString - , sesSecretKey :: ByteString + { sesFrom :: !ByteString + , sesTo :: ![ByteString] + , sesAccessKey :: !ByteString + , sesSecretKey :: !ByteString + , sesSessionToken :: !(Maybe ByteString) + , sesRegion :: !Text } + deriving Show renderSendMailSES :: MonadIO m => Manager -> SES -> Mail -> m () renderSendMailSES m ses mail = liftIO (renderMail' mail) >>= sendMailSES m ses -sendMailSES :: MonadIO m => Manager -> SES -> L.ByteString -> m () -sendMailSES manager ses msg = liftIO $ do +-- | @since 0.4.1 +-- Same as 'renderSendMailSES' but uses the global 'Manager'. +renderSendMailSESGlobal :: MonadIO m => SES -> Mail -> m () +renderSendMailSESGlobal ses mail = do + mgr <- liftIO getGlobalManager + renderSendMailSES mgr ses mail + +sendMailSES :: MonadIO m => Manager -> SES + -> L.ByteString -- ^ Raw message data. You must ensure that + -- the message format complies with + -- Internet email standards regarding + -- email header fields, MIME types, and + -- MIME encoding. + -> m () +sendMailSES manager ses msg = + sendMailSESWithResponse manager ses msg checkForError + +-- | @since 0.4.3 +-- Generalised version of 'sendMailSES' which allows customising the final return type. +sendMailSESWithResponse :: MonadIO m => Manager -> SES + -> L.ByteString + -> (Status -> ConduitT Event Void IO a) + -- ^ What to do with the HTTP 'Status' returned in the 'Response'. + -> m a +sendMailSESWithResponse manager ses msg onResponseStatus = liftIO $ do now <- getCurrentTime - let date = S8.pack $ format now - sig = makeSig date $ sesSecretKey ses - req' <- parseUrl "https://email.us-east-1.amazonaws.com" - let auth = S8.concat - [ "AWS3-HTTPS AWSAccessKeyId=" - , sesAccessKey ses - , ", Algorithm=HmacSHA256, Signature=" - , sig - ] - let req = urlEncodedBody qs $ req' - { requestHeaders = - [ ("Date", date) - , ("X-Amzn-Authorization", auth) - ] - , checkStatus = \_ _ _ -> Nothing - } - withResponse req manager $ \res -> - bodyReaderSource (responseBody res) - $$ parseBytes def - =$ checkForError (responseStatus res) + requestBase <- buildRequest (concat ["https://email.", T.unpack (sesRegion ses) , ".amazonaws.com"]) + let headers = + [ ("Date", formatAmazonTime now) + ] + ++ case sesSessionToken ses of + Just token -> [("X-Amz-Security-Token", token)] + Nothing -> [] + let tentativeRequest = urlEncodedBody qs $ requestBase {requestHeaders = headers} + canonicalRequest = canonicalizeRequest tentativeRequest + stringToSign = makeStringToSign "ses" now (E.encodeUtf8 (sesRegion ses)) canonicalRequest + sig = makeSig "ses" now (E.encodeUtf8 (sesRegion ses)) (sesSecretKey ses) stringToSign + authorizationString = makeAuthorizationString "ses" now (E.encodeUtf8 (sesRegion ses)) + (patchedRequestHeaders tentativeRequest) (sesAccessKey ses) sig + finalRequest = tentativeRequest {requestHeaders = ("Authorization", authorizationString): requestHeaders tentativeRequest} + withResponse finalRequest manager $ \res -> + bodyReaderSource (responseBody res) `connect` + (parseBytes def + .| onResponseStatus (responseStatus res) + ) where qs = ("Action", "SendRawEmail") @@ -72,9 +104,21 @@ : ("RawMessage.Data", encode $ S8.concat $ L.toChunks msg) : zipWith mkDest [1 :: Int ..] (sesTo ses) mkDest num addr = (S8.pack $ "Destinations.member." ++ show num, addr) - format = formatTime defaultTimeLocale "%a, %e %b %Y %H:%M:%S %z" -checkForError :: Status -> Sink Event IO () +-- | @since 0.4.1 +-- Same as 'sendMailSES' but uses the global 'Manager'. +sendMailSESGlobal :: MonadIO m => SES + -> L.ByteString -- ^ Raw message data. You must ensure that + -- the message format complies with + -- Internet email standards regarding + -- email header fields, MIME types, and + -- MIME encoding. + -> m () +sendMailSESGlobal ses msg = do + mgr <- liftIO getGlobalManager + sendMailSES mgr ses msg + +checkForError :: Status -> ConduitT Event Void IO () checkForError status = do name <- getFirstStart if name == errorResponse @@ -113,6 +157,9 @@ , seRequestId = reqid } +-- | +-- +-- Exposed since: 0.3.2 data SESException = SESException { seStatus :: !Status , seCode :: !Text @@ -122,6 +169,11 @@ deriving (Show, Typeable) instance Exception SESException -makeSig :: ByteString -> ByteString -> ByteString -makeSig payload key = - encode $ toBytes (hmacGetDigest $ hmac key payload :: Digest SHA256) +usEast1 :: Text +usEast1 = "us-east-1" + +usWest2 :: Text +usWest2 = "us-west-2" + +euWest1 :: Text +euWest1 = "eu-west-1" diff --git a/Network/Mail/Mime/SES/Internal.hs b/Network/Mail/Mime/SES/Internal.hs new file mode 100644 --- /dev/null +++ b/Network/Mail/Mime/SES/Internal.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE OverloadedStrings #-} + +module Network.Mail.Mime.SES.Internal where + +import Crypto.Hash (SHA256, hash) +import Crypto.MAC.HMAC (hmac, hmacGetDigest) +import Data.Bifunctor (bimap) +import Data.ByteArray (convert) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as S8 +import qualified Data.ByteString.Lazy as L +import Data.Char (toLower) +import Data.CaseInsensitive (CI) +import qualified Data.CaseInsensitive as CI +import Data.List (sort) + +import Data.Time (UTCTime) +import Data.Time.Format (formatTime) +import Network.HTTP.Client (Request, RequestBody(RequestBodyLBS, RequestBodyBS), + parseRequest, + method, host, path, requestHeaders, queryString, requestBody + ) +import Data.Time (defaultTimeLocale) + +-- | Create a canonical request according to . +makeCanonicalRequest :: ByteString -> ByteString -> ByteString -> [(CI ByteString, ByteString)] -> ByteString -> ByteString +makeCanonicalRequest requesMethod requestPath requestQueryString headers payload = S8.intercalate "\n" + [ requesMethod + , requestPath + , requestQueryString + , S8.concat . fmap (\ (name, value) -> name <> ":" <> value <> "\n") + . sort . fmap (bimap (bytesToLowerCase . CI.original) id) + $ headers + , makeListOfHeaders $ headers + , unaryHashBase16 $ payload + ] + +canonicalizeRequest :: Request -> ByteString +canonicalizeRequest request + = makeCanonicalRequest + (method request) + (path request) + (queryString request) + (patchedRequestHeaders request) + (requestBodyAsByteString request) + +-- | Create a string to sign according to . +makeStringToSign :: ByteString -> UTCTime -> ByteString -> ByteString -> ByteString +makeStringToSign service time region canonicalRequest = S8.intercalate "\n" + [ "AWS4-HMAC-SHA256" + , formatAmazonTime time + , makeCredentialScope service time region + , unaryHashBase16 canonicalRequest + ] + +-- | Create a signature according to . +makeSig :: ByteString -> UTCTime -> ByteString -> ByteString -> ByteString -> ByteString +makeSig service time region secret stringToSign = + let f = flip keyedHash + in Base16.encode + . f stringToSign + . f "aws4_request" + . f service + . f region + . f (formatAmazonDate time) + $ ("AWS4" <> secret) + +-- | Create an authorization string according to . +makeAuthorizationString :: ByteString -> UTCTime -> ByteString -> [(CI ByteString, ByteString)] -> ByteString -> ByteString -> ByteString +makeAuthorizationString service time region headers keyId sig = S8.concat + [ "AWS4-HMAC-SHA256 Credential=" + <> keyId + <> "/" + <> makeCredentialScope service time region + , ", SignedHeaders=" <> makeListOfHeaders headers + , ", Signature=" <> sig + ] + +formatAmazonTime :: UTCTime -> ByteString +formatAmazonTime = S8.pack . formatTime defaultTimeLocale "%Y%m%dT%H%M%SZ" + +formatAmazonDate :: UTCTime -> ByteString +formatAmazonDate = S8.pack . formatTime defaultTimeLocale "%Y%m%d" + +buildRequest :: String -> IO Request +buildRequest url = do + requestBase <- (parseRequest url) + return requestBase + +requestBodyAsByteString :: Request -> ByteString +requestBodyAsByteString request = case requestBody request of + RequestBodyBS x -> x + RequestBodyLBS x -> L.toStrict x + _ -> error "Not implemented." + +requestBodyLength :: Request -> Int +requestBodyLength = B.length . requestBodyAsByteString + +makeListOfHeaders :: [(CI ByteString, ByteString)] -> ByteString +makeListOfHeaders = S8.intercalate ";" . sort . fmap (bytesToLowerCase . CI.original . fst) + +patchedRequestHeaders :: Request -> [(CI ByteString, ByteString)] +patchedRequestHeaders request = requestHeaders request ++ + [ (CI.mk "Host", host request) + , (CI.mk "Content-Length", S8.pack . show $ requestBodyLength request) + -- @http-client@ [adds the @Content-Length@ header automatically when sending the request](https://hackage.haskell.org/package/http-client-0.7.1/docs/Network-HTTP-Client.html#v:requestHeaders), + -- so we have to reconstruct it by hand. + ] + +makeCredentialScope :: ByteString -> UTCTime -> ByteString -> ByteString +makeCredentialScope service time region = S8.intercalate "/" [formatAmazonDate time, region, service, "aws4_request"] + +bytesToLowerCase :: ByteString -> ByteString +bytesToLowerCase = S8.pack . fmap toLower . S8.unpack + +unaryHashBase16 :: ByteString -> ByteString +unaryHashBase16 = Base16.encode . convert . hash @ByteString @SHA256 + +keyedHash :: ByteString -> ByteString -> ByteString +keyedHash key payload = convert . hmacGetDigest $ hmac @ByteString @ByteString @SHA256 key payload diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,23 @@ +## mime-mail-ses + +Send mime-mail messages via Amazon SES + +### send-aws + +The build target `mime-mail-ses:exe:send-aws` is a command line executable that +allows you to send an e-mail via Amazon SES. Most parameters are supplied +through command line options; the AWS secret key and the body of the message are +read from standard input. + +Example: + + % cabal run :send-aws -- \ + --subject 'Checking if AWS works.' \ + --from 'your e-mail address' \ + --to 'your e-mail address' \ + --key 'your key ID' \ + --region 'us-east-2' + Up to date + Enter AWS secret: your secret key + Enter message below. + This is a test letter sent from command line. diff --git a/mime-mail-ses.cabal b/mime-mail-ses.cabal --- a/mime-mail-ses.cabal +++ b/mime-mail-ses.cabal @@ -1,32 +1,62 @@ Name: mime-mail-ses -Version: 0.2.2.2 +Version: 0.4.5 Synopsis: Send mime-mail messages via Amazon SES +description: Hackage documentation generation is not reliable. For up to date documentation, please see: . Homepage: http://github.com/snoyberg/mime-mail License: MIT License-file: LICENSE Author: Michael Snoyman -Maintainer: michael@snoyman.com +Maintainer: Janus Troelsen Category: Web Build-type: Simple -Cabal-version: >=1.6 +Cabal-version: 2.0 +extra-doc-files: ChangeLog.md + README.md Library - Exposed-modules: Network.Mail.Mime.SES - Build-depends: base >= 4 && < 5 - , base64-bytestring >= 0.1 - , bytestring >= 0.9 - , time >= 1.1 - , old-locale - , http-client >= 0.2.2.2 - , http-client-conduit - , http-conduit >= 0.2.0.1 - , mime-mail >= 0.3 - , transformers >= 0.2 - , http-types >= 0.6.8 + Default-Language: Haskell2010 + Exposed-modules: Network.Mail.Mime.SES, Network.Mail.Mime.SES.Internal + Build-depends: base >= 4.16.4 && < 5 + , base16-bytestring ^>= 1.0 + , base64-bytestring ^>= 1.2 + , bytestring >= 0.11.4 && < 0.13 + , case-insensitive ^>= 1.2 + , conduit ^>= 1.3 + , crypton ^>= 1.1 + , http-client ^>= 0.7 + , http-client-tls ^>= 0.4 + , http-conduit ^>= 2.3 + , http-types ^>= 0.12 + , ram ^>= 0.22 + , mime-mail ^>= 0.5 + , text + , time >= 1.11.1.1 , xml-conduit , xml-types - , text - , conduit - , cryptohash >= 0.7.3 - , byteable ghc-options: -Wall + +Executable send-aws + default-language: Haskell2010 + hs-source-dirs: send-aws + Main-Is: Main.hs + build-depends: base + , http-client + , http-client-tls + , mime-mail + , mime-mail-ses + , optparse-applicative + , text + +Test-suite by-the-book + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test/by-the-book + main-is: Main.hs + build-depends: base + , bytestring + , case-insensitive + , mime-mail-ses + , tasty + , tasty-hunit + , time + ghc-options: -Wall diff --git a/send-aws/Main.hs b/send-aws/Main.hs new file mode 100644 --- /dev/null +++ b/send-aws/Main.hs @@ -0,0 +1,80 @@ +{-# language RecordWildCards #-} +{-# language OverloadedStrings #-} +{-# language CPP #-} + +module Main where + +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.IO as Text +import qualified Data.Text.Lazy.IO as LazyText +import Data.Text.Encoding +import Network.HTTP.Client +import Network.HTTP.Client.TLS +import Network.Mail.Mime +import Network.Mail.Mime.SES +import Options.Applicative +import Options.Applicative.Types +import System.IO + +#if MIN_VERSION_base(4, 11, 0) +#else +import Data.Monoid ((<>)) +#endif + +main = do + (Options {..}, manager) <- pure (,) + <*> execParser obtainOptions + <*> newManager tlsManagerSettings + + putStr "Enter AWS secret: " + hFlush stdout + secret <- Text.getLine + putStrLn "Enter message below." + message <- LazyText.getContents + + let letter = (emptyMail from) + { mailTo = to + , mailHeaders = [("Subject", subject)] + , mailParts = [[plainPart message]] + } + renderSendMailSES manager (makeSES letter key secret region) letter + +data Options = Options + { subject :: Text + , from :: Address + , to :: [Address] + , key :: Text + , region :: Text + } + +obtainOptions :: ParserInfo Options +obtainOptions = info (parseOptions <**> helper) (fullDesc <> progDesc "Send a message via Amazon Simple Email Service.") + where + parseOptions :: Parser Options + parseOptions = pure Options + <*> option readText (metavar "..." <> long "subject" <> help "The `subject` header of the letter.") + <*> option readAddress (metavar "..." <> long "from" <> help "Source address.") + <*> some (option readAddress (metavar "..." <> long "to" <> help "A destination.")) + <*> option readText (metavar "..." <> long "key" <> help "AWS access key identifier.") + <*> option readText (metavar "..." <> long "region" <> help "AWS region to connect to.") + + -- Monomorphic readers are required in place of simple `strOption` ≡ + -- `option str` because `str` has been monomorphic prior to + -- `optparse-applicative` version 0.14 and we want to support that. + + readText :: ReadM Text + readText = Text.pack <$> readerAsk + + readAddress :: ReadM Address + readAddress = Address Nothing <$> readText + +makeSES :: Mail -> Text -> Text -> Text -> SES +makeSES Mail {..} key secret region = SES + { sesFrom = (encodeUtf8 . addressEmail) mailFrom + , sesTo = fmap (encodeUtf8 . addressEmail) mailTo + , sesAccessKey = encodeUtf8 key + , sesSecretKey = encodeUtf8 secret + , sesSessionToken = Nothing + , sesRegion = region + } diff --git a/test/by-the-book/Main.hs b/test/by-the-book/Main.hs new file mode 100644 --- /dev/null +++ b/test/by-the-book/Main.hs @@ -0,0 +1,69 @@ +{-# language TypeApplications #-} +{-# language OverloadedStrings #-} + +module Main where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as ByteString +import Data.CaseInsensitive (CI) +import Data.Time + +import Test.Tasty +import Test.Tasty.HUnit +import Network.Mail.Mime.SES.Internal + +-- Examples taken from . + +time :: UTCTime +time = read @UTCTime "2015-08-30 12:36:00 +0000" + +service, secret, keyId, region, queryString, canonicalRequest, stringToSign, sig, authorizationString :: ByteString +service = "iam" +keyId = "AKIDEXAMPLE" +secret = "wJalrXUtnFEMI/K7MDENG+bPxRfiCYEXAMPLEKEY" +region = "us-east-1" +queryString = "Action=ListUsers&Version=2010-05-08" +canonicalRequest = ByteString.intercalate "\n" + [ "GET" + , "/" + , "Action=ListUsers&Version=2010-05-08" + , "content-type:application/x-www-form-urlencoded; charset=utf-8" + , "host:iam.amazonaws.com" + , "x-amz-date:20150830T123600Z" + , "" + , "content-type;host;x-amz-date" + , "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" + ] + +stringToSign = ByteString.intercalate "\n" + [ "AWS4-HMAC-SHA256" + , "20150830T123600Z" + , "20150830/us-east-1/iam/aws4_request" + , "f536975d06c0309214f805bb90ccff089219ecd68b2577efef23edd43b7e1a59" + ] + +sig = "5d672d79c15b13162d9279b0855cfba6789a8edb4c82c400e06b5924a6f2b5d7" + +authorizationString = "AWS4-HMAC-SHA256 \ + \Credential=AKIDEXAMPLE/20150830/us-east-1/iam/aws4_request\ + \, SignedHeaders=content-type;host;x-amz-date\ + \, Signature=5d672d79c15b13162d9279b0855cfba6789a8edb4c82c400e06b5924a6f2b5d7" + +headers :: [(CI ByteString, ByteString)] +headers = + [ ("Host", "iam.amazonaws.com") + , ("Content-Type", "application/x-www-form-urlencoded; charset=utf-8") + , ("X-Amz-Date", "20150830T123600Z") + ] + +main :: IO ( ) +main = defaultMain $ testGroup "Check Sig Version 4 internals." + [ testCase "Correctly generates a canonical request" + $ assertEqual "" canonicalRequest (makeCanonicalRequest "GET" "/" queryString headers "") + , testCase "Correctly generates a string to sign" + $ assertEqual "" stringToSign (makeStringToSign service time region canonicalRequest) + , testCase "Correctly generates a cryptographic signature" + $ assertEqual "" sig (makeSig service time region secret stringToSign) + , testCase "Correctly generates an authorization string" + $ assertEqual "" authorizationString (makeAuthorizationString service time region headers keyId sig) + ]