diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2014 Robert Massaioli + +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: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +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/Mail/Hailgun.hs b/Mail/Hailgun.hs new file mode 100644 --- /dev/null +++ b/Mail/Hailgun.hs @@ -0,0 +1,239 @@ +-- | Hailgun is a Haskell wrapper around the that use +-- type safety to ensure that you are sending a valid request to the Mailgun API's. Mailgun is a +-- service that lets you send emails. It also contains a number of other email handling API's that +-- will be implimented in the future. +module Mail.Hailgun + ( sendEmail + , hailgunMessage + , HailgunMessage + , HailgunContext(..) + , MessageSubject + , MessageContent(..) + , MessageRecipients(..) + , emptyMessageRecipients + , UnverifiedEmailAddress + , HailgunSendResponse(..) + , HailgunErrorMessage + , HailgunErrorResponse(..) + ) where + +import Control.Applicative ((<$>), (<*>)) +import Control.Monad (mzero) +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import qualified Data.Text as T +import Text.Email.Validate +import Network.HTTP.Client (Request(..), parseUrl, httpLbs, withManager, responseStatus, responseBody, applyBasicAuth) +import Network.HTTP.Client.MultipartFormData (Part(..), formDataBody, partBS) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import qualified Network.HTTP.Types.Status as NT +import qualified Network.HTTP.Types.Method as NM + +{- + - The basic rest API's look like this when used in curl: + - + - curl -s --user 'api:key-3ax6xnjp29jd6fds4gc373sgvjxteol0' \ + - https://api.mailgun.net/v2/samples.mailgun.org/messages \ + - -F from='Excited User ' \ + - -F to=baz@example.com \ + - -F to=bar@example.com \ + - -F subject='Hello' \ + - -F text='Testing some Mailgun awesomness!' + - + - This is what we need to emulate with this library. + -} + +type UnverifiedEmailAddress = B.ByteString -- ^ Represents an email address that is not yet verified. +type MessageSubject = String -- ^ Represents a message subject. + +-- | Any email content that you wish to send should be encoded into these types before it is sent. +-- Currently, according to the API, you should always send a Text Only part in the email and you can +-- optionally add a nicely formatted HTML version of that email to the sent message. +-- +-- @ +-- It is best to send multi-part emails using both text and HTML or text only. Sending HTML only +-- email is not well received by ESPs. +-- @ +-- () +-- +-- This API mirrors that advice so that you can always get it right. +data MessageContent + -- | The Text only version of the message content. + = TextOnly + { textContent :: B.ByteString + } + -- | A message that contains both a Text version of the email content and a HTML version of the email content. + | TextAndHTML + { textContent :: B.ByteString -- ^ The text content that you wish to send (please note that many clients will take the HTML version first if it is present but that the text version is a great fallback). + , htmlContent :: B.ByteString -- ^ The HTML content that you wish to send. + } + +-- | A Hailgun Email message that may be sent. It contains important information such as the address +-- that the email is from, the addresses that it should be going to, the subject of the message and +-- the content of the message. Any email that you wish to send via this api must be converted into +-- this structure first. To create a message then please use the hailgunMessage interface. +data HailgunMessage = HailgunMessage + { messageSubject :: MessageSubject + , messageContent :: MessageContent + , messageFrom :: EmailAddress + , messageTo :: [EmailAddress] + , messageCC :: [EmailAddress] + , messageBCC :: [EmailAddress] + } + -- TODO support sending attachments in the future + -- TODO inline image support for the future + -- TODO o:tag support + -- TODO o:campaign support + -- messageDKIMSupport :: Bool TODO o:dkim support + -- TODO o:deliverytime support for up to three days in the future + -- TODO o:testmode support + -- TODO o:tracking support + -- TODO o:tracking-clicks support + -- TODO o:tracking-opens support + -- TODO custom mime header support + -- TODO custome message data support + +-- | No recipients for your email. Useful singleton instance to avoid boilerplate in your code. For +-- example: +-- +-- @ +-- toBob = emptyMessageRecipients { recipientsTo = [\"bob\@bob.test\"] } +-- @ +emptyMessageRecipients :: MessageRecipients +emptyMessageRecipients = MessageRecipients [] [] [] + +-- | A collection of unverified email recipients separated into the To, CC and BCC groupings that +-- email supports. +data MessageRecipients = MessageRecipients + { recipientsTo :: [UnverifiedEmailAddress] -- ^ The people to email directly. + , recipientsCC :: [UnverifiedEmailAddress] -- ^ The people to \"Carbon Copy\" into the email. Honestly, why is that term not deprecated yet? + , recipientsBCC :: [UnverifiedEmailAddress] -- ^ The people to \"Blind Carbon Copy\" into the email. There really needs to be a better name for this too. + } + +-- | A generic error message that is returned by the Hailgun library. +type HailgunErrorMessage = String + +-- | A method to construct a HailgunMessage. You require a subject, content, From address and people +-- to send the email to and it will give you back a valid Hailgun email message. Or it will error +-- out while trying. +hailgunMessage + :: MessageSubject -- ^ The purpose of the email surmised. + -> MessageContent -- ^ The full body of the email. + -> UnverifiedEmailAddress -- ^ The email account that the recipients should respond to in order to get back to us. + -> MessageRecipients -- ^ The people that should recieve this email. + -> Either HailgunErrorMessage HailgunMessage -- ^ Either an error while trying to create a valid message or a valid message. +hailgunMessage subject content sender recipients = do + from <- validate sender + to <- mapM validate (recipientsTo recipients) + cc <- mapM validate (recipientsCC recipients) + bcc <- mapM validate (recipientsBCC recipients) + return HailgunMessage + { messageSubject = subject + , messageContent = content + , messageFrom = from + , messageTo = to + , messageCC = cc + , messageBCC = bcc + } + +toPostVars :: HailgunMessage -> [(BC.ByteString, BC.ByteString)] +toPostVars message = + [ (BC.pack "from", toByteString . messageFrom $ message) + , (BC.pack "subject", BC.pack $ messageSubject message) + ] ++ to + ++ cc + ++ bcc + ++ fromContent (messageContent message) + where + to = convertEmails (BC.pack "to") . messageTo $ message + cc = convertEmails (BC.pack "cc") . messageCC $ message + bcc = convertEmails (BC.pack "bcc") . messageBCC $ message + + fromContent :: MessageContent -> [(BC.ByteString, BC.ByteString)] + fromContent t@(TextOnly _) = [ (BC.pack "text", textContent t) ] + fromContent th@(TextAndHTML {}) = (BC.pack "html", htmlContent th) : fromContent (TextOnly . textContent $ th) + + convertEmails :: BC.ByteString -> [EmailAddress] -> [(BC.ByteString, BC.ByteString)] + convertEmails prefix = fmap ((,) prefix . toByteString) + +-- | When comunnicating to the Mailgun service you need to have some common pieces of information to +-- authenticate successfully. This context encapsulates that required information. +data HailgunContext = HailgunContext + -- TODO better way to represent a domain + { hailgunDomain :: String -- ^ The domain of the mailgun account that you wish to send the emails through. + , hailgunApiKey :: String -- ^ The API key for the mailgun account so that you can successfully make requests. Please note that it should include the 'key' prefix. + } + +-- TODO replace with MailgunSendResponse +-- | The response to an email being accepted by the Mailgun API. +data HailgunSendResponse = HailgunSendResponse + { hsrMessage :: String -- ^ The freeform message from the mailgun API. + , hsrId :: String -- ^ The ID of the message that has been accepted by the Mailgun api. + } + +-- TODO make this Hailgun specific and different for the Mailgun api. That way there is the correct +-- separation of concerns. +-- | An error that comes from Mailgun or the Hailgun API. +data HailgunErrorResponse = HailgunErrorResponse + { herMessage :: String -- ^ A generic message describing the error. + } + +toHailgunError :: String -> HailgunErrorResponse +toHailgunError = HailgunErrorResponse + +instance FromJSON HailgunSendResponse where + parseJSON (Object v) = HailgunSendResponse + <$> v .: T.pack "message" + <*> v .: T.pack "id" + parseJSON _ = mzero + +instance FromJSON HailgunErrorResponse where + parseJSON (Object v) = HailgunErrorResponse + <$> v .: T.pack "message" + parseJSON _ = mzero + +encodeFormData :: MonadIO m => [(BC.ByteString, BC.ByteString)] -> Request -> m Request +encodeFormData fields = formDataBody (map toPart fields) + where + toPart :: (BC.ByteString, BC.ByteString) -> Part + toPart (name, content) = partBS (T.pack . BC.unpack $ name) content + +-- | Send an email using the Mailgun API's. This method is capable of sending a message over the +-- Mailgun service. All it needs is the appropriate context. +sendEmail + :: HailgunContext -- ^ The Mailgun context to operate in. + -> HailgunMessage -- ^ The Hailgun message to be sent. + -> IO (Either HailgunErrorResponse HailgunSendResponse) -- ^ The result of the sent email. Either a sent email or a successful send. +sendEmail context message = do + initRequest <- parseUrl url + let request = initRequest { method = NM.methodPost, checkStatus = \_ _ _ -> Nothing } + requestWithBody <- encodeFormData (toPostVars message) request + let authedRequest = applyBasicAuth (BC.pack "api") (BC.pack . hailgunApiKey $ context) requestWithBody + response <- withManager tlsManagerSettings (httpLbs authedRequest) + case NT.statusCode . responseStatus $ response of + 200 -> return . convertGood . eitherDecode' . responseBody $ response + 400 -> return . Left . convertBad . eitherDecode' . responseBody $ response + 401 -> return . Left . convertBad . eitherDecode' . responseBody $ response + 402 -> return . Left . convertBad . eitherDecode' . responseBody $ response + 404 -> return . Left . convertBad . eitherDecode' . responseBody $ response + 500 -> serverError + 502 -> serverError + 503 -> serverError + 504 -> serverError + c -> retError . unexpectedError $ c + where + url = "https://api.mailgun.net/v2/" ++ hailgunDomain context ++ "/messages" + retError = return . Left . toHailgunError + + serverError = retError "Server Errors - something is wrong on Mailgun’s end" + unexpectedError x = "Unexpected Non-Standard Mailgun Error: " ++ show x + +convertGood :: Either String HailgunSendResponse -> Either HailgunErrorResponse HailgunSendResponse +convertGood (Left error) = Left . toHailgunError $ error +convertGood (Right response) = Right response + +convertBad :: Either String HailgunErrorResponse -> HailgunErrorResponse +convertBad (Left error) = toHailgunError error +convertBad (Right e) = e diff --git a/README.markdown b/README.markdown new file mode 100644 --- /dev/null +++ b/README.markdown @@ -0,0 +1,48 @@ +# Hailgun + +The hailgun library is a Haskell library that integrates with Mailgun. Mailgun is a service that +allows controlled sending of emails. The intial focus of the API is on sending emails rather than +recieving them. + +This library was implimented based upon the information provided on the [Mailgun API Reference][1]. +The goal of this library is match this API 1-1. + +## Building this library + +This library just uses [cabal][5] to build itself. To do so for development then follow the following +steps: + + cabal sandbox init + cabal install --only-dependencies + cabal build + +At that point in time you should have a working version of the library so you could run the example +hailgun-send command by: + + cabal run hailgun-send -- --help + +And you can continue trying this libary from here. + +## Trying this library + +You probably want to know that this library works to prove that it would be a good choice for your +project. Follow these steps to get started with the library and Mailgun and send a test email: + + 1. [Sign up for Mailgun][2]. + 1. Mailgun will give you options to use [Curl][3] to send emails to yourself right after signup. + You should do so to test that your account works. (Optional) + 1. Grab the sandbox domain that was generated and the API key by visiting the [Mailgun control panel][4]. + 1. Create a file caled hailgun.send.conf in the current directory and put the API Key and the + mailgun sandbox domain in the file. You can copy the hailgun.send.conf.default file to see the + correct format. + 1. Now you may use hailgun-send to send emails by passing in the correct command line arguments. + You can see the command line argument options with `cabal run hailgun-send -- --help` + +If you are lucky this has only taken you a few minutes to get working and you are now sending emails +through the Mailgun API from the terminal. + + [1]: http://documentation.mailgun.com/api_reference.html + [2]: https://mailgun.com/signup + [3]: http://man.cx/curl + [4]: https://mailgun.com/cp + [5]: http://www.haskell.org/cabal/ diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hailgun.cabal b/hailgun.cabal new file mode 100644 --- /dev/null +++ b/hailgun.cabal @@ -0,0 +1,76 @@ +-- Initial hailgun.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: hailgun + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: Mailgun REST api interface for Haskell. + +-- A longer description of the package. +description: Mailgun is an online service that sends emails. It is a great point of + integration for many SaaS services and this Haskell library cleanly interfaces + with Mailgun so that you can send emails from your Haskell applications. + +-- The license under which the package is released. +license: MIT + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Robert Massaioli + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: robertmassaioli@gmail.com + +-- A copyright notice. +copyright: (c) 2014 Robert Massaioli + +category: Network + +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +-- README. +extra-source-files: README.markdown + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + + +library + exposed-modules: Mail.Hailgun + build-depends: base >=4.6 && <4.7 + , bytestring >= 0.9 && <= 0.11 + , aeson == 0.7.* + , text == 0.11.* + , transformers == 0.3.* + , http-client == 0.3.* + , http-client-tls == 0.2.* + , email-validate ==2.0.* + , http-types == 0.8.* + + ghc-options: -W + default-language: Haskell2010 + +executable hailgun-send + hs-source-dirs: src + main-is: Send.hs + default-language: Haskell2010 + ghc-options: -W + + build-depends: base == 4.6.* + , hailgun + , bytestring >= 0.9 && <= 0.11 + , text == 0.11.* + , configurator == 0.3.* diff --git a/src/Send.hs b/src/Send.hs new file mode 100644 --- /dev/null +++ b/src/Send.hs @@ -0,0 +1,138 @@ +module Main where + +import Mail.Hailgun + +import Control.Applicative ((<$>)) +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) + +-- 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 + = Help + | From { email :: UnverifiedEmailAddress } + | To { email :: UnverifiedEmailAddress } + | Subject { subject :: MessageSubject } + | TextMessage { textFilePath :: FilePath } + | HTMLMessage { htmlFilePath :: FilePath } + deriving (Eq, Show) + +options :: [OptDescr Flag] +options = + [ Option "h" ["help"] (NoArg Help) "displays this help message" + , Option "f" ["from"] (ReqArg fromP "me@test.test") "You are required to provide sender of this email." + , Option "t" ["to"] (ReqArg toP "them@test.test") "You will need to provide atleast one person that you wish to send the email to." + -- TODO Confirm that this is required. + , 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." + ] + where + fromP = From . BC.pack + toP = To . BC.pack + +hailgunConfFile :: FilePath +hailgunConfFile = "hailgun.send.conf" + +mailgunDomainLabel = T.pack "mailgun-domain" +mailgunApiKeyLabel = T.pack "mailgun-api-key" + +loadHailgunContext :: FilePath -> IO HailgunContext +loadHailgunContext configFile = do + hailgunConf <- load [Required configFile] + domain <- require hailgunConf mailgunDomainLabel + apiKey <- require hailgunConf mailgunApiKeyLabel + return HailgunContext + { hailgunDomain = domain + , hailgunApiKey = apiKey + } + +handleSend :: [Flag] -> MessageContent -> Either HailgunErrorMessage HailgunMessage +handleSend flags emailBody = + case (unverifiedFrom, subjects) of + ([from], [subject]) -> hailgunMessage subject emailBody from simpleRecipients + ([], []) -> 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" + _ -> fail "You have too many from adresses and subjects, you should only have one of each." + where + unverifiedTo = fmap email . filter isTo $ flags + unverifiedFrom = fmap email . filter isFrom $ flags + subjects = fmap subject . filter isSubject $ flags + + simpleRecipients = emptyMessageRecipients { recipientsTo = unverifiedTo } + +isSubject :: Flag -> Bool +isSubject (Subject _) = True +isSubject _ = False + +isTo :: Flag -> Bool +isTo (To _) = True +isTo _ = False + +isFrom :: Flag -> Bool +isFrom (From _) = True +isFrom _ = False + +isTextMessage :: Flag -> Bool +isTextMessage (TextMessage _) = True +isTextMessage _ = False + +isHtmlMessage :: Flag -> Bool +isHtmlMessage (HTMLMessage _) = True +isHtmlMessage _ = False + +sendMessage :: HailgunMessage -> IO () +sendMessage message = do + hailgunContext <- loadHailgunContext hailgunConfFile + response <- sendEmail hailgunContext message + case response of + Left error -> putStrLn $ "Failed to send email: " ++ herMessage error + Right result -> do + putStrLn "Sent Email!" + putStrLn $ "Id: " ++ hsrId result + putStrLn $ "Message: " ++ hsrMessage result + +usageMessage = "Send emails using the Mailgun api." + +main :: IO () +main = do + arguments <- getArgs + case getOpt Permute options arguments of + (flags, _, []) -> if Help `elem` flags + then printUsage + else do + 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 + (_, _, xs) -> do + putStrLn "Error parsing arguments:" + mapM_ putStrLn xs + printUsage + exitFailure + where + printUsage = putStrLn $ usageInfo usageMessage options + +prepareEmailBody :: [Flag] -> IO (Maybe MessageContent) +prepareEmailBody flags = case (DL.find isTextMessage flags, DL.find isHtmlMessage flags) of + (Nothing, _) -> return Nothing + (Just (TextMessage textPath), Nothing) -> Just . TextOnly <$> BC.readFile textPath + (Just (TextMessage textPath), Just (HTMLMessage htmlPath)) -> do + textContents <- BC.readFile textPath + htmlContents <- BC.readFile htmlPath + return . Just $ TextAndHTML + { textContent = textContents + , htmlContent = htmlContents + } + _ -> return Nothing -- The type safety should prevent this scenario.