diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Dennis Gosnell (c) 2016 + +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. + + * 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. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,15 @@ + +Mail.Hailgun.Simple +=================== + +[![Build Status](https://secure.travis-ci.org/cdepillabout/hailgun-simple.svg)](http://travis-ci.org/cdepillabout/hailgun-simple) +[![Hackage](https://img.shields.io/hackage/v/hailgun-simple.svg)](https://hackage.haskell.org/package/hailgun-simple) +[![Stackage LTS](http://stackage.org/package/hailgun-simple/badge/lts)](http://stackage.org/lts/package/hailgun-simple) +[![Stackage Nightly](http://stackage.org/package/hailgun-simple/badge/nightly)](http://stackage.org/nightly/package/hailgun-simple) + +This module provides an easy-to-use, simple wrapper around the +[hailgun](https://hackage.haskell.org/package/hailgun) package. + +## Usage + +TODO 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-simple.cabal b/hailgun-simple.cabal new file mode 100644 --- /dev/null +++ b/hailgun-simple.cabal @@ -0,0 +1,30 @@ +name: hailgun-simple +version: 0.1.0.0 +synopsis: Easy-to-use wrapper for the hailgun package +description: Please see README.md +homepage: https://github.com/cdepillabout/hailgun-simple +license: BSD3 +license-file: LICENSE +author: Dennis Gosnell +maintainer: cdep.illabout@gmail.com +copyright: 2016 Dennis Gosnell +category: Mail +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Mail.Hailgun.Simple + build-depends: base >= 4.6 && < 5 + , email-validate >= 2.2 + , hailgun >= 0.4 + , mtl >= 2.2 + , text >= 1.2 + , transformers >= 0.4 + default-language: Haskell2010 + ghc-options: -Wall + +source-repository head + type: git + location: git@github.com:cdepillabout/hailgun-simple.git diff --git a/src/Mail/Hailgun/Simple.hs b/src/Mail/Hailgun/Simple.hs new file mode 100644 --- /dev/null +++ b/src/Mail/Hailgun/Simple.hs @@ -0,0 +1,221 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{- | +Module : Mail.Hailgun.Simple +Copyright : Dennis Gosnell 2016 +License : BSD3 +Maintainer : Dennis Gosnell (cdep.illabout@gmail.com) +Stability : experimental +Portability : unknown + +This module provides a simple, easy-to-use wrapper around the + package. hailgun +is a package providing a way to send email using +. + +Here is a short example of how to use this package: + +@ + \{\-\# LANGUAGE OverloadedStrings \#\-\} + \{\-\# LANGUAGE QuasiQuotes \#\-\} + + module FooBar where + + import "Control.Monad.Reader" ('Control.Monad.Reader.ReaderT') + import "Data.Text" ('Data.Text.Text') + import "Data.Text.Encoding" ('Data.Text.Encoding.encodeUtf8') + import "Text.Email.Validate" ('EmailAddress') + import Text.Shakespeare.Text (sbt) + import "Mail.Hailgun.Simple" + ('MessageContent'('TextOnly'), 'Email'(..), 'EmailError', + 'HailgunContext', 'ResponseFromMailgun', 'sendEmail') + + -- This function will send a new user an email. + sendEmailToNewUser + :: 'Text' -- ^ user's name + -> 'EmailAddress' -- ^ user's email address + -> 'ReaderT' 'HailgunContext' 'IO' ('Either' 'EmailError' 'ResponseFromMailgun') + sendEmailToNewUser name emailaddress = do + let email = 'Email' + { 'emailSubject' = "Thanks for signing up!" + , 'emailBody' = 'TextOnly' $ 'encodeUtf8' body + , 'emailReplyTo' = myEmailAddress + , 'emailRecipientsTo' = [emailaddress] + , 'emailRecipientsCC' = [] + , 'emailRecipientsBCC' = [] + , 'emailAttachments' = [] + } + 'sendEmail' email + where + body :: 'Text' + body = [sbt|Hi #{name}! + | + |Thanks for signing up to our service! + | + |From your friends at foobar.com :-)|] + + myEmailAddress :: 'EmailAddress' + myEmailAddress = undefined +@ +-} + +module Mail.Hailgun.Simple + ( -- * Sending an 'Email' + sendEmail + -- * 'Email' + , Email(..) + , MessageContent(..) + -- * Response + , ResponseFromMailgun(..) + -- * 'HailgunContext' + , HailgunContext(..) + , HasHailgunContext(getHailgunContext) + -- * Errors + , EmailError(..) + -- * Lower-level calls + , emailToHailgunMessage + , sendHailgunMessage + ) where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Reader (MonadReader, reader) +import Data.Bifunctor (bimap, first) +import Data.Data (Data) +import Data.Text (Text, pack) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) +import Mail.Hailgun + (Attachment, HailgunContext, HailgunErrorResponse(..), + HailgunMessage, HailgunSendResponse(..), MessageContent(..), + MessageRecipients(..), hailgunMessage) +import qualified Mail.Hailgun as Hailgun +import Text.Email.Validate (EmailAddress, toByteString) + +-- | This class provides one layer (or multiple layers) of indirection. It +-- makes it possible to pass 'sendEmail' a generic configuration datatype +-- that contains a 'HailgunContext' instead of a 'HailgunContext' directly. +-- +-- For instance, imagine you had a configuration datatype like this: +-- +-- @ +-- data Config = Config +-- { configDatabasePool :: Pool +-- , configHailgunContext :: 'HailgunContext' +-- } +-- @ +-- +-- You could create an instance of 'HasHailgunContext' for @Config@ like this: +-- +-- @ +-- instance 'HasHailgunContext' Config where +-- getHailgunContext :: Config -> 'HailgunContext' +-- getHailgunContext = configHailgunContext +-- @ +-- +-- Now, you can pass @Config@ to 'sendEmail' instead of a 'HailgunContext' +-- directly. +class HasHailgunContext r where + getHailgunContext :: r -> HailgunContext + +instance HasHailgunContext HailgunContext where + getHailgunContext = id + +-- | Datatype to represent possible errors with sending an email. +data EmailError + = EmailErrorIncorrectEmailFormat Text + -- ^ Email was in incorrect format. Since we are creating emails by hand, + -- this error should never occur. + | EmailErrorSendError Text + -- ^ Error from Mailgun when trying to send an email. + deriving (Generic, Show, Typeable) + +-- | Datatype representing an email to send. +data Email = Email + { emailSubject :: Text + , emailBody :: MessageContent + , emailReplyTo :: EmailAddress + , emailRecipientsTo :: [EmailAddress] + , emailRecipientsCC :: [EmailAddress] + , emailRecipientsBCC :: [EmailAddress] + , emailAttachments :: [Attachment] + } + +-- | Response returned from Mailgun's servers. +data ResponseFromMailgun = ResponseFromMailgun + { mailgunMessage :: Text -- ^ Freeform message from Mailgun + , mailgunId :: Text -- ^ ID of the message accepted by Mailgun + } deriving (Data, Generic, Show, Typeable) + +-- | Send an 'Email'. +-- +-- Returns an 'EmailErrorIncorrectEmailFormat' error if the format of the email +-- was not correct (for instance, if the email senders or receivers were +-- incorrect, or the attachments are specified incorrectly). If you are +-- constructing an 'Email' by hand (and not programatically), this error will +-- indicate a programmer error. +-- +-- Returns an 'EmailErrorSendError' if there was a problem with actually +-- sending the 'Email'. This will usually be an error from the Mailgun +-- servers. +sendEmail + :: forall r m + . ( HasHailgunContext r + , MonadIO m + , MonadReader r m + ) + => Email + -> m (Either EmailError ResponseFromMailgun) +sendEmail = either (pure . Left) sendHailgunMessage . emailToHailgunMessage + +-- | Wrapper around "Mail.Hailgun"'s 'hailgunMessage'. +emailToHailgunMessage :: Email -> Either EmailError HailgunMessage +emailToHailgunMessage Email { emailSubject + , emailBody + , emailReplyTo + , emailRecipientsTo + , emailRecipientsCC + , emailRecipientsBCC + , emailAttachments + } = + let recipients = + MessageRecipients + (fmap toByteString emailRecipientsTo) + (fmap toByteString emailRecipientsCC) + (fmap toByteString emailRecipientsBCC) + eitherHailgunMessage = + hailgunMessage + emailSubject + emailBody + (toByteString emailReplyTo) + recipients + emailAttachments + in first (EmailErrorIncorrectEmailFormat . pack) eitherHailgunMessage + +-- | Wrapper around "Mail.Hailgun"'s 'Hailgun.sendEmail'. Used by 'sendEmail'. +sendHailgunMessage + :: forall r m + . ( HasHailgunContext r + , MonadIO m + , MonadReader r m + ) + => HailgunMessage + -> m (Either EmailError ResponseFromMailgun) +sendHailgunMessage hailgunMsg = do + hailgunContext <- reader getHailgunContext + eitherSendResponse <- liftIO $ Hailgun.sendEmail hailgunContext hailgunMsg + pure $ + bimap + hailgunErrorResponseToEmailError + hailgunSendResponseToResponseFromMailgun + eitherSendResponse + +hailgunErrorResponseToEmailError :: HailgunErrorResponse -> EmailError +hailgunErrorResponseToEmailError = EmailErrorSendError . pack . herMessage + +hailgunSendResponseToResponseFromMailgun :: HailgunSendResponse + -> ResponseFromMailgun +hailgunSendResponseToResponseFromMailgun HailgunSendResponse {hsrMessage, hsrId} = + ResponseFromMailgun {mailgunMessage = pack hsrMessage, mailgunId = pack hsrId}