mime-mail-ses 0.4.1 → 0.4.2

raw patch · 7 files changed

+369/−57 lines, 7 filesdep +base16-bytestringdep +case-insensitivedep +mime-mail-sesdep −old-localedep −transformersdep ~basedep ~bytestringdep ~http-clientnew-component:exe:send-awsnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: base16-bytestring, case-insensitive, mime-mail-ses, optparse-applicative, tasty, tasty-hunit

Dependencies removed: old-locale, transformers

Dependency ranges changed: base, bytestring, http-client, http-client-tls, mime-mail, time

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• Network/Mail/Mime/SES.hs +17/−46
• Network/Mail/Mime/SES/Internal.hs +140/−0
• README.md +20/−0
• mime-mail-ses.cabal +38/−11
• send-aws/Main.hs +80/−0
• test/by-the-book/Main.hs +69/−0

@@ -1,3 +1,8 @@+## 0.5.1++* 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.

@@ -15,9 +15,6 @@  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@@ -25,17 +22,11 @@ import           Data.Conduit                (Sink, await, ($$), (=$)) 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.XML.Types              (Content (ContentText), Event (EventBeginElement, EventContent)) import           Network.HTTP.Client         (Manager,-#if MIN_VERSION_http_client(0, 5, 0)-                                              parseRequest,-#else-                                              checkStatus,-                                              parseUrl,-#endif                                               requestHeaders, responseBody,                                               responseStatus, urlEncodedBody,                                               withResponse)@@ -45,11 +36,7 @@ import           Network.Mail.Mime           (Mail, renderMail') import           Text.XML.Stream.Parse       (def, parseBytes) -#if MIN_VERSION_time(1,5,0)-import           Data.Time                   (defaultTimeLocale)-#else-import           System.Locale               (defaultTimeLocale)-#endif+import Network.Mail.Mime.SES.Internal  data SES = SES     { sesFrom         :: !ByteString@@ -80,32 +67,21 @@             -> m () sendMailSES manager ses msg = liftIO $ do     now <- getCurrentTime-    let date = S8.pack $ format now-        sig = makeSig date $ sesSecretKey ses-        region = T.unpack $ sesRegion ses-#if MIN_VERSION_http_client(0, 5, 0)-    req' <- parseRequest $ concat ["https://email.", region , ".amazonaws.com"]-#else-    req' <- parseUrl $ concat ["https://email.", region , ".amazonaws.com"]-#endif-    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)-                ] ++ case sesSessionToken ses of-                    Just token -> [("X-Amz-Security-Token", token)]-                    Nothing    -> []-#if !MIN_VERSION_http_client(0, 5, 0)-            , checkStatus = \_ _ _ -> Nothing-#endif-            }-    withResponse req manager $ \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)         $$ parseBytes def         =$ checkForError (responseStatus res)@@ -116,7 +92,6 @@         : ("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"  -- | @since 0.4.1 -- Same as 'sendMailSES' but uses the global 'Manager'.@@ -181,10 +156,6 @@     }     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"

@@ -0,0 +1,140 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE CPP #-}++module Network.Mail.Mime.SES.Internal where++import           Crypto.Hash                 (SHA256, hmac, hmacGetDigest, hash)+import           Data.Bifunctor              (bimap)+import           Data.Byteable               (toBytes)+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)+#if MIN_VERSION_base(4, 11, 0)+#else+import           Data.Monoid ((<>))+#endif++import           Data.Time                   (UTCTime)+import           Data.Time.Format            (formatTime)+import           Network.HTTP.Client         (Request, RequestBody(RequestBodyLBS, RequestBodyBS),+#if MIN_VERSION_http_client(0, 5, 0)+                                             parseRequest,+#else+                                             checkStatus,+                                             parseUrl,+#endif+                                             method, host, path, requestHeaders, queryString, requestBody+                                             )+#if MIN_VERSION_time(1,5,0)+import           Data.Time                   (defaultTimeLocale)+#else+import           System.Locale               (defaultTimeLocale)+#endif++-- | Create a canonical request according to <https://docs.aws.amazon.com/general/latest/gr/sigv4-create-canonical-request.html>.+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 <https://docs.aws.amazon.com/general/latest/gr/sigv4-create-string-to-sign.html>.+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 <https://docs.aws.amazon.com/general/latest/gr/sigv4-calculate-signature.html>.+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 <https://docs.aws.amazon.com/general/latest/gr/sigv4-add-signature-to-request.html>.+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+#if MIN_VERSION_http_client(0, 5, 0)+  requestBase <- (parseRequest url)+#else+  requestBase <- parseUrl url {checkStatus = \_ _ _ -> Nothing}+#endif+  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 . toBytes . hash @SHA256++keyedHash :: ByteString -> ByteString -> ByteString+keyedHash key payload = toBytes . hmacGetDigest $ hmac @SHA256 key payload

@@ -1,3 +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.

@@ -1,5 +1,5 @@ Name:                mime-mail-ses-Version:             0.4.1+Version:             0.4.2 Synopsis:            Send mime-mail messages via Amazon SES description:         Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/mime-mail-ses>. Homepage:            http://github.com/snoyberg/mime-mail@@ -9,27 +9,54 @@ Maintainer:          michael@snoyman.com Category:            Web Build-type:          Simple-Cabal-version:       >=1.6+Cabal-version:       >=1.10 extra-source-files:  ChangeLog.md                      README.md  Library-  Exposed-modules:     Network.Mail.Mime.SES+  Default-Language:    Haskell2010+  Exposed-modules:     Network.Mail.Mime.SES, Network.Mail.Mime.SES.Internal   Build-depends:       base               >= 4.9       && < 5+                     , base16-bytestring                      , base64-bytestring  >= 0.1+                     , byteable                      , bytestring         >= 0.9-                     , time               >= 1.1-                     , old-locale+                     , case-insensitive+                     , conduit+                     , cryptohash         >= 0.7.3                      , http-client        >= 0.2.2.2                      , http-client-tls    >= 0.2.4                      , http-conduit       >= 2.1-                     , mime-mail          >= 0.3-                     , transformers       >= 0.2                      , http-types         >= 0.6.8+                     , mime-mail          >= 0.3+                     , text+                     , time               >= 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

@@ -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+  }

@@ -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 <https://docs.aws.amazon.com/general/latest/gr/sigv4_signing.html>.++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)+  ]