packages feed

hailgun-send 0.1.0.0 → 0.1.1.0

raw patch · 2 files changed

+47/−24 lines, 2 filesdep ~basedep ~hailgundep ~text

Dependency ranges changed: base, hailgun, text

Files

Main.hs view
@@ -1,30 +1,34 @@ module Main where -import Mail.Hailgun+import           Mail.Hailgun -import Control.Applicative ((<$>))+import           Control.Applicative   ((<$>))+import qualified Data.ByteString       as B import qualified Data.ByteString.Char8 as BC-import Data.Configurator (load, require, Worth(..))-import qualified Data.List as DL-import qualified Data.Text as T-import System.Console.GetOpt (getOpt, OptDescr(..), ArgDescr(..), ArgOrder(..), usageInfo)-import System.Environment (getArgs)-import System.Exit (exitFailure)+import           Data.Configurator     (Worth (..), load, require)+import qualified Data.List             as DL+import qualified Data.Text             as T+import           System.Console.GetOpt (ArgDescr (..), ArgOrder (..),+                                        OptDescr (..), getOpt, usageInfo)+import           System.Environment    (getArgs)+import           System.Exit           (exitFailure)+import Data.Maybe (catMaybes)  -- The purpose of this module is to provide a way to send emails to the Mailgun service using the -- command line. This is mainly for the purposes of testing initially. Using this executable should -- be the basis for our integration tests. It should also be the starting point for everybody that -- wishes to test this library out. -data Flag +data Flag    = Help    | From { email :: UnverifiedEmailAddress }    | To { email :: UnverifiedEmailAddress }    | Subject { subject :: MessageSubject }    | TextMessage { textFilePath :: FilePath }    | HTMLMessage { htmlFilePath :: FilePath }+   | Attach { attachFile :: FilePath }    deriving (Eq, Show)-   + options :: [OptDescr Flag] options =    [ Option "h" ["help"]    (NoArg Help)                     "displays this help message"@@ -34,6 +38,7 @@    , Option "s" ["subject"] (ReqArg Subject "subject")      "You need to send an email subject."    , Option "x" ["text"]    (ReqArg TextMessage "email.text")   "You need to provide a text email file at a minimum."    , Option "m" ["html"]    (ReqArg HTMLMessage "email.html")   "You can provide a HTML version of the email to send."+   , Option "a" ["attachment"] (ReqArg Attach "attachment.file") "You can provide one or more files as attachments to the email."    ]    where       fromP = From . BC.pack@@ -50,15 +55,16 @@    hailgunConf <- load [Required configFile]    domain <- require hailgunConf mailgunDomainLabel    apiKey <- require hailgunConf mailgunApiKeyLabel-   return HailgunContext +   return HailgunContext       { hailgunDomain = domain       , hailgunApiKey = apiKey+      , hailgunProxy = Nothing -- TODO add proxy support to this command       } -handleSend :: [Flag] -> MessageContent -> Either HailgunErrorMessage HailgunMessage-handleSend flags emailBody =+handleSend :: [Flag] -> MessageContent -> [Attachment] -> Either HailgunErrorMessage HailgunMessage+handleSend flags emailBody attachments  =    case (unverifiedFrom, subjects) of-      ([from], [subject]) -> hailgunMessage subject emailBody from simpleRecipients+      ([from], [subject]) -> hailgunMessage subject emailBody from simpleRecipients attachments       ([], []) -> fail "You need to provide both a from address and a subject to send an email."       (_ , []) -> fail "You have more than one from address and only one is allowed"       ([], _ ) -> fail "You have more than one subject and only one is allowed"@@ -113,9 +119,11 @@             potentialEmailBody <- prepareEmailBody flags             case potentialEmailBody of                Nothing -> putStrLn "At the very least you must provide a text file to send as the email body."-               (Just messageContent) -> case handleSend flags messageContent of-                  Left error -> putStrLn $ "Error generating mail: " ++ error -                  Right message -> sendMessage message+               (Just messageContent) -> do+                  attachments <- loadAttachments flags+                  case handleSend flags messageContent attachments of+                     Left error -> putStrLn $ "Error generating mail: " ++ error+                     Right message -> sendMessage message       (_, _, xs) -> do          putStrLn "Error parsing arguments:"          mapM_ putStrLn xs@@ -124,6 +132,21 @@    where       printUsage = putStrLn $ usageInfo usageMessage options +loadAttachments :: [Flag] -> IO [Attachment]+loadAttachments flags = sequence . fmap loadAttachment . catMaybes . fmap getAttachmentPathFromFlag $ flags++loadAttachment :: FilePath -> IO Attachment+loadAttachment path = do+   body <- B.readFile path+   return Attachment+      { attachmentFilePath = path+      , attachmentBody = AttachmentBS body+      }++getAttachmentPathFromFlag :: Flag -> Maybe FilePath+getAttachmentPathFromFlag (Attach path) = Just path+getAttachmentPathFromFlag _             = Nothing+ prepareEmailBody :: [Flag] -> IO (Maybe MessageContent) prepareEmailBody flags = case (DL.find isTextMessage flags, DL.find isHtmlMessage flags) of    (Nothing, _) -> return Nothing@@ -131,7 +154,7 @@    (Just (TextMessage textPath), Just (HTMLMessage htmlPath)) -> do       textContents <- BC.readFile textPath       htmlContents <- BC.readFile htmlPath-      return . Just $ TextAndHTML +      return . Just $ TextAndHTML          { textContent = textContents          , htmlContent = htmlContents          }
hailgun-send.cabal view
@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.0.0+version:             0.1.1.0  -- A short (one-line) description of the package. synopsis:            A program to send emails throught the Mailgun api.@@ -58,11 +58,11 @@   -- other-extensions:          -- Other library packages from which modules are imported.-  build-depends:       base >=4.6 && <4.7-                       , hailgun > 0.1.0.0 && < 0.2-                       , bytestring >= 0.9 && <= 0.11-                       , text == 0.11.*-                       , configurator == 0.3.*+  build-depends:       base               >=4.6       && < 5+                       , hailgun          == 0.3.*+                       , bytestring       >= 0.9      && <= 0.11+                       , text             >= 0.11     && < 1.2+                       , configurator     == 0.3.*      -- Directories containing source files.   -- hs-source-dirs: