dbd48ca · typeable/mandrill

.travis.yml+6−1

compare with master

unifiedsplit

@@ -21,6 +21,8 @@ before_install:

21 - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER

22 - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH

23 - cabal --version

24+ - cabal update

25+ - cabal install hpc-coveralls

24

26

25install:

27install:

26 - cabal update

28 - cabal update

@@ -41,4 +43,7 @@ script:

41 else

43 else

42 echo "expected '$SRC_TGZ' not found";

44 echo "expected '$SRC_TGZ' not found";

43 exit 1;

45 exit 1;

44− fi

46+ fi

47+

48+after_script:

49+ - hpc-coveralls mandrill-tests

README.md+25

@@ -1,10 +1,35 @@

1[![Build Status](https://travis-ci.org/adinapoli/mandrill.svg?branch=master)](https://travis-ci.org/adinapoli/mandrill)

2+[![Coverage Status](https://img.shields.io/coveralls/adinapoli/mandrill.svg)](https://coveralls.io/r/adinapoli/mandrill)A

2

3

3# Haskell Client for the Mandrill JSON API

4# Haskell Client for the Mandrill JSON API

4

5

5This module implement a low-level, 1:1 mapping API to

6This module implement a low-level, 1:1 mapping API to

6the [Mandrill](http://mandrillapp.com) transactional email service.

7the [Mandrill](http://mandrillapp.com) transactional email service.

7

8

9+# Example

10+

11+This package was built with pragmatism and reuse in mind. This means

12+this API comes in two flavours: an IO-based and an handy monad transformers

13+which can be plugged in your stack of choice.

14+Example:

15+

16+``` haskell

17+{-# LANGUAGE OverloadedStrings #-}

18+import Text.Email.Validate

19+import Network.API.Mandrill

20+

21+main :: IO ()

22+main = do

23+ case validate "foo@example.com" of

24+ Left err -> print $ "Invalid email!" ++ show err

25+ Right addr -> runMandrill "MYTOKENHERE" $ do

26+ let msg = "<p>My Html</p>"

27+ res <- sendEmail (newTextMessage addr addr "Hello" msg)

28+ case res of

29+ MandrillSuccess k -> liftIO (print k)

30+ MandrillFailure f -> liftIO (print f)

31+```

32+

8# Supported API versions

33# Supported API versions

9

34

10* 1.0 (partially)

35* 1.0 (partially)

examples/Send.hsnew file+13

@@ -0,0 +1,13 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+import Text.Email.Validate

3+import Network.API.Mandrill

4+

5+main :: IO ()

6+main = case validate "foo@example.com" of

7+ Left err -> print $ "Invalid email!" ++ show err

8+ Right addr -> runMandrill "SUPER-SECRET-TOKEN" $ do

9+ let msg = "<p>My Html</p>"

10+ res <- sendEmail (newTextMessage addr addr "Hello" msg)

11+ case res of

12+ MandrillSuccess k -> liftIO (print k)

13+ MandrillFailure f -> liftIO (print f)

mandrill.cabal+6−1

@@ -16,8 +16,10 @@ source-repository head

16

17library

18 exposed-modules:

19+ Network.API.Mandrill

19 Network.API.Mandrill.Settings

20 Network.API.Mandrill.Settings

20 Network.API.Mandrill.Types

21 Network.API.Mandrill.Types

22+ Network.API.Mandrill.Trans

21 Network.API.Mandrill.Users

23 Network.API.Mandrill.Users

22 Network.API.Mandrill.Users.Types

24 Network.API.Mandrill.Users.Types

23 Network.API.Mandrill.Messages

25 Network.API.Mandrill.Messages

@@ -25,6 +27,7 @@ library

25 other-modules:

27 other-modules:

26 Network.API.Mandrill.Utils

28 Network.API.Mandrill.Utils

27 Network.API.Mandrill.HTTP

29 Network.API.Mandrill.HTTP

30+ Network.API.Mandrill.Orphans

28 -- other-extensions:

31 -- other-extensions:

29 build-depends:

32 build-depends:

30 base >=4.6 && < 5

33 base >=4.6 && < 5

@@ -37,7 +40,9 @@ library

37 , lens >= 4.1 && < 4.6

40 , lens >= 4.1 && < 4.6

38 , blaze-html >= 0.5.0.0

41 , blaze-html >= 0.5.0.0

39 , QuickCheck >= 2.6 && < 2.8

42 , QuickCheck >= 2.6 && < 2.8

43+ , mtl < 3.0

40 , time

44 , time

45+ , email-validate >= 1.0.0

41 , old-locale

46 , old-locale

42 hs-source-dirs:

47 hs-source-dirs:

43 src

48 src

@@ -65,7 +70,7 @@ test-suite mandrill-tests

65 , aeson

70 , aeson

66 , bytestring

71 , bytestring

67 , QuickCheck

72 , QuickCheck

68− , tasty >= 0.7 && < 0.9

73+ , tasty >= 0.9.0.1

69 , tasty-quickcheck

74 , tasty-quickcheck

70 , tasty-hunit

75 , tasty-hunit

71 , raw-strings-qq < 1.2

76 , raw-strings-qq < 1.2

src/Network/API/Mandrill.hsnew file+101

@@ -0,0 +1,101 @@

1+

2+module Network.API.Mandrill (

3+ module M

4+ , sendEmail

5+ , emptyMessage

6+ , newTextMessage

7+ , newHtmlMessage

8+ , liftIO

9+ ) where

10+

11+import Control.Monad.Reader

12+import Control.Lens

13+import Data.Time

14+import Text.Blaze.Html

15+import Network.API.Mandrill.Types as M

16+import Network.API.Mandrill.Messages as M

17+import Network.API.Mandrill.Messages.Types as M

18+import Network.API.Mandrill.Trans as M

19+import Data.Monoid

20+import Text.Email.Validate

21+import qualified Data.Text as T

22+import qualified Data.Aeson as JSON

23+

24+

25+--------------------------------------------------------------------------------

26+emptyMessage :: EmailAddress -> EmailAddress -> MandrillMessage

27+emptyMessage f t = MandrillMessage {

28+ _mmsg_html = mempty

29+ , _mmsg_text = Nothing

30+ , _mmsg_subject = T.empty

31+ , _mmsg_from_email = f

32+ , _mmsg_from_name = Nothing

33+ , _mmsg_to = [newRecipient t]

34+ , _mmsg_headers = JSON.Null

35+ , _mmsg_important = Nothing

36+ , _mmsg_track_opens = Nothing

37+ , _mmsg_track_clicks = Nothing

38+ , _mmsg_auto_text = Nothing

39+ , _mmsg_auto_html = Nothing

40+ , _mmsg_inline_css = Nothing

41+ , _mmsg_url_strip_qs = Nothing

42+ , _mmsg_preserve_recipients = Nothing

43+ , _mmsg_view_content_link = Nothing

44+ , _mmsg_bcc_address = Nothing

45+ , _mmsg_tracking_domain = Nothing

46+ , _mmsg_signing_domain = Nothing

47+ , _mmsg_return_path_domain = Nothing

48+ , _mmsg_merge = Nothing

49+ , _mmsg_global_merge_vars = []

50+ , _mmsg_merge_vars = []

51+ , _mmsg_tags = []

52+ , _mmsg_subaccount = Nothing

53+ , _mmsg_google_analytics_domains = []

54+ , _mmsg_google_analytics_campaign = Nothing

55+ , _mmsg_metadata = JSON.Null

56+ , _mmsg_recipient_metadata = []

57+ , _mmsg_attachments = []

58+ , _mmsg_images = []

59+ }

60+

61+

62+

63+--------------------------------------------------------------------------------

64+newHtmlMessage :: EmailAddress

65+ -> EmailAddress

66+ -> T.Text

67+ -> Html

68+ -> MandrillMessage

69+newHtmlMessage f t subj html = let body = mkMandrillHtml html in

70+ ((mmsg_html .~ body) . (mmsg_subject .~ subj)) $ (emptyMessage f t)

71+

72+

73+--------------------------------------------------------------------------------

74+newTextMessage :: EmailAddress

75+ -> EmailAddress

76+ -> T.Text

77+ -> T.Text

78+ -> MandrillMessage

79+newTextMessage f t subj txt = let body = unsafeMkMandrillHtml txt in

80+ ((mmsg_html .~ body) .

81+ (mmsg_text .~ Just txt) .

82+ (mmsg_subject .~ subj)) (emptyMessage f t)

83+

84+

85+--------------------------------------------------------------------------------

86+sendEmail :: MonadIO m

87+ => MandrillMessage

88+ -> MandrillT m (MandrillResponse [MessagesResponse])

89+sendEmail msg = do

90+ key <- ask

91+ liftIO $ send key msg (Just True) Nothing Nothing

92+

93+

94+--------------------------------------------------------------------------------

95+sendTextEmail :: MonadIO m

96+ => MandrillMessage

97+ -> MandrillT m (MandrillResponse [MessagesResponse])

98+sendTextEmail msg = do

99+ key <- ask

100+ now <- liftIO getCurrentTime

101+ liftIO $ send key msg (Just True) Nothing (Just now)

src/Network/API/Mandrill/Orphans.hsnew file+17

@@ -0,0 +1,17 @@

1+

2+module Network.API.Mandrill.Orphans where

3+

4+import Data.Aeson

5+import Data.Aeson.Types

6+import Text.Email.Validate

7+import qualified Data.Text.Encoding as TE

8+

9+

10+instance ToJSON EmailAddress where

11+ toJSON = String . TE.decodeUtf8 . toByteString

12+

13+instance FromJSON EmailAddress where

14+ parseJSON (String s) = case validate (TE.encodeUtf8 s) of

15+ Left err -> fail err

16+ Right v -> return v

17+ parseJSON o = typeMismatch "Expecting a String for EmailAddress." o

src/Network/API/Mandrill/Trans.hsnew file+17

@@ -0,0 +1,17 @@

1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2+module Network.API.Mandrill.Trans where

3+

4+import Control.Monad.Reader

5+import Control.Applicative

6+import Network.API.Mandrill.Types

7+

8+newtype MandrillT m a = MandrillT {

9+ runMandrillT :: ReaderT MandrillKey m a

10+ } deriving (MonadTrans, MonadReader MandrillKey,

11+ Functor, Applicative, Monad, MonadIO)

12+

13+runMandrill :: MonadIO m

14+ => MandrillKey

15+ -> MandrillT m a

16+ -> m a

17+runMandrill key action = runReaderT (runMandrillT action) key

src/Network/API/Mandrill/Types.hs+24−10

@@ -5,13 +5,14 @@

5module Network.API.Mandrill.Types where

6

7import Network.API.Mandrill.Utils

8+import Network.API.Mandrill.Orphans()

8import Test.QuickCheck

9import Test.QuickCheck

10+import Text.Email.Validate

9import Data.Char

11import Data.Char

12+import Data.Maybe

10import Data.Time

13import Data.Time

11import Control.Applicative

14import Control.Applicative

12import System.Locale (defaultTimeLocale)

15import System.Locale (defaultTimeLocale)

13−import Data.Map (Map)

14−import qualified Data.Map as Map

15import qualified Data.ByteString as B

16import qualified Data.ByteString as B

16import qualified Data.ByteString.Base64 as Base64

17import qualified Data.ByteString.Base64 as Base64

17import qualified Data.Text as T

18import qualified Data.Text as T

@@ -90,7 +91,7 @@ deriveJSON defaultOptions { constructorTagModifier = map toLower } ''MandrillRec

90--------------------------------------------------------------------------------

91--------------------------------------------------------------------------------

91-- | An array of recipient information.

92-- | An array of recipient information.

92data MandrillRecipient = MandrillRecipient {

93data MandrillRecipient = MandrillRecipient {

93− _mrec_email :: !T.Text

94+ _mrec_email :: EmailAddress

94 -- ^ The email address of the recipient

95 -- ^ The email address of the recipient

95 , _mrec_name :: Maybe T.Text

96 , _mrec_name :: Maybe T.Text

96 -- ^ The optional display name to use for the recipient

97 -- ^ The optional display name to use for the recipient

@@ -102,17 +103,30 @@ data MandrillRecipient = MandrillRecipient {

102makeLenses ''MandrillRecipient

103makeLenses ''MandrillRecipient

103deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillRecipient

104deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillRecipient

104

105

106+newRecipient :: EmailAddress -> MandrillRecipient

107+newRecipient email = MandrillRecipient email Nothing Nothing

108+

105instance Arbitrary MandrillRecipient where

109instance Arbitrary MandrillRecipient where

106− arbitrary = pure $ MandrillRecipient "test@example.com" Nothing Nothing

110+ arbitrary = pure MandrillRecipient {

111+ _mrec_email = fromJust (emailAddress "test@example.com")

112+ , _mrec_name = Nothing

113+ , _mrec_type = Nothing

114+ }

107

115

108--------------------------------------------------------------------------------

116--------------------------------------------------------------------------------

109newtype MandrillHtml = MandrillHtml Blaze.Html

117newtype MandrillHtml = MandrillHtml Blaze.Html

110

118

111−mkMandrillHtml :: T.Text -> MandrillHtml

119+unsafeMkMandrillHtml :: T.Text -> MandrillHtml

112−mkMandrillHtml = MandrillHtml . Blaze.toHtml

120+unsafeMkMandrillHtml = MandrillHtml . Blaze.preEscapedToHtml

121+

122+-- This might be slightly hairy because it violates

123+-- the nice encapsulation that newtypes offer.

124+mkMandrillHtml :: Blaze.Html -> MandrillHtml

125+mkMandrillHtml = MandrillHtml

113

126

127+instance Monoid MandrillHtml where

114−mkMandrillHtml' :: Blaze.Html -> MandrillHtml

128+ mempty = MandrillHtml mempty

115−mkMandrillHtml' = MandrillHtml

129+ mappend (MandrillHtml m1) (MandrillHtml m2) = MandrillHtml (m1 <> m2)

116

130

117instance Show MandrillHtml where

131instance Show MandrillHtml where

118 show (MandrillHtml h) = show $ Blaze.renderHtml h

132 show (MandrillHtml h) = show $ Blaze.renderHtml h

@@ -191,7 +205,7 @@ data MandrillMessage = MandrillMessage {

191 -- ^ Optional full text content to be sent

205 -- ^ Optional full text content to be sent

192 , _mmsg_subject :: !T.Text

206 , _mmsg_subject :: !T.Text

193 -- ^ The message subject

207 -- ^ The message subject

194− , _mmsg_from_email :: !T.Text

208+ , _mmsg_from_email :: EmailAddress

195 -- ^ The sender email address

209 -- ^ The sender email address

196 , _mmsg_from_name :: Maybe T.Text

210 , _mmsg_from_name :: Maybe T.Text

197 -- ^ Optional from name to be used

211 -- ^ Optional from name to be used

@@ -274,7 +288,7 @@ instance Arbitrary MandrillMessage where

274 arbitrary = MandrillMessage <$> arbitrary

288 arbitrary = MandrillMessage <$> arbitrary

275 <*> pure Nothing

289 <*> pure Nothing

276 <*> pure "Test Subject"

290 <*> pure "Test Subject"

277− <*> pure "sender@example.com"

291+ <*> pure (fromJust $ emailAddress "sender@example.com")

278 <*> pure Nothing

292 <*> pure Nothing

279 <*> resize 2 arbitrary

293 <*> resize 2 arbitrary

280 <*> pure emptyObject

294 <*> pure emptyObject

test/Tests.hs−2

@@ -1,9 +1,7 @@

1{-# LANGUAGE CPP #-}

2module Tests where

3

4−import Test.QuickCheck

5import Test.Tasty.HUnit

4import Test.Tasty.HUnit

6−import Text.RawString.QQ

7import Data.Either

5import Data.Either

8import Data.Aeson

6import Data.Aeson

9import Network.API.Mandrill.Messages.Types

7import Network.API.Mandrill.Messages.Types