git.iko.soy/typeable/mandrill
on master help sign in
Adding extra parameter to send
cff82f4Alfredo Di Napoli
.gitignorenew file+1
compare with master
unifiedsplit
@@ -0,0 +1 @@
1+dist
README.mdnew file+11
@@ -0,0 +1,11 @@
1+
2+# Haskell Client for the Mandrill JSON API
3+
4+This module implement a low-level, 1:1 API to the [Mandrill](http://mandrillapp.com)
5+transactional email service.
6+
7+# Supported API versions
8+
9+* 1.0 (partially)
10+ - [Messages call](https://mandrillapp.com/api/docs/messages.JSON.html)
11+ + send
mandrill.cabal+3−1
@@ -16,7 +16,8 @@ library
16 Network.API.Mandrill.Messages
16 Network.API.Mandrill.Messages
17 Network.API.Mandrill.Types
17 Network.API.Mandrill.Types
18 Network.API.Mandrill.HTTP
18 Network.API.Mandrill.HTTP
19− -- other-modules:
19+ other-modules:
20+ Network.API.Mandrill.Utils
20 -- other-extensions:
21 -- other-extensions:
21 build-depends:
22 build-depends:
22 base >=4.7 && < 5
23 base >=4.7 && < 5
@@ -25,6 +26,7 @@ library
25 , aeson >= 0.7.0.3 && < 0.8
26 , aeson >= 0.7.0.3 && < 0.8
26 , lens >= 4.1 && < 4.6
27 , lens >= 4.1 && < 4.6
27 , blaze-html >= 0.5.0.0
28 , blaze-html >= 0.5.0.0
29+ , time
28 hs-source-dirs:
30 hs-source-dirs:
29 src
31 src
30 default-language:
32 default-language:
src/Network/API/Mandrill/Messages.hs+15−5
@@ -1,9 +1,19 @@
1
1
2module Network.API.Mandrill.Messages where
2module Network.API.Mandrill.Messages where
3
3
4−import Network.API.Mandrill.Types
4+import Network.API.Mandrill.Types
5−import Network.API.Mandrill.Settings
5+import Network.API.Mandrill.Settings
6−import Network.API.Mandrill.HTTP
6+import Network.API.Mandrill.HTTP
7+import Data.Time
8+import qualified Data.Text as T
7
9
10+--------------------------------------------------------------------------------
11+-- | Send a new transactional message through Mandrill
12+send :: MandrillKey
13+ -> MandrillMessage
14+ -> Maybe Bool
15+ -> Maybe T.Text
16+ -> Maybe UTCTime
8−send :: MandrillKey -> MandrillMessage -> Bool -> IO MandrillResponse
17+ -> IO MandrillResponse
18+send k msg async ip_pool send_at =
9−send k msg async = toMandrillResponse Send (MandrillSendRq k msg async)
19+ toMandrillResponse Send (MandrillSendRq k msg async ip_pool send_at)
src/Network/API/Mandrill/Types.hs+89−13
@@ -3,17 +3,22 @@
3{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
4module Network.API.Mandrill.Types where
4module Network.API.Mandrill.Types where
5
5
6+import Network.API.Mandrill.Utils
7+import Data.Char
8+import Data.Time
6import qualified Data.Text as T
9import qualified Data.Text as T
7import qualified Data.Text.Lazy as TL
10import qualified Data.Text.Lazy as TL
8−import Control.Lens
11+import Control.Lens
9−import Control.Monad
12+import Control.Monad
10−import Data.Monoid
13+import Data.Monoid
11−import Data.Aeson
14+import Data.Aeson
12−import Data.Aeson.Types
15+import Data.Aeson.Types
13−import Data.Aeson.TH
16+import Data.Aeson.TH
14import qualified Text.Blaze.Html as Blaze
17import qualified Text.Blaze.Html as Blaze
15import qualified Text.Blaze.Html.Renderer.Text as Blaze
18import qualified Text.Blaze.Html.Renderer.Text as Blaze
16
19
20+
21+--------------------------------------------------------------------------------
17data MandrillError = MandrillError {
22data MandrillError = MandrillError {
18 _merr_status :: !T.Text
23 _merr_status :: !T.Text
19 , _merr_code :: !Int
24 , _merr_code :: !Int
@@ -24,16 +29,51 @@ data MandrillError = MandrillError {
24makeLenses ''MandrillError
29makeLenses ''MandrillError
25deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillError
30deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillError
26
31
32+
33+--------------------------------------------------------------------------------
34+data MandrillEmailStatus = ES_Sent
35+ | ES_Queued
36+ | ES_Scheduled
37+ | ES_Rejected
38+ | ES_Invalid deriving Show
39+
40+deriveJSON defaultOptions { constructorTagModifier = map toLower . drop 3 } ''MandrillEmailStatus
41+
42+
43+--------------------------------------------------------------------------------
44+data MandrillRejectReason = RR_HardBounce
45+ | RR_SoftBounce
46+ | RR_Spam
47+ | RR_Unsub
48+ | RR_Custom
49+ | RR_InvalidSender
50+ | RR_Invalid
51+ | RR_TestModeLimit
52+ | RR_Rule deriving Show
53+
54+deriveJSON defaultOptions {
55+ constructorTagModifier = modRejectReason . drop 3
56+ } ''MandrillRejectReason
57+
58+
59+--------------------------------------------------------------------------------
27data MandrillResult = MandrillResult {
60data MandrillResult = MandrillResult {
28 _mres_email :: !T.Text
61 _mres_email :: !T.Text
62+ -- ^ The email address of the recipient
29− , _mres_status :: !T.Text
63+ , _mres_status :: MandrillEmailStatus
64+ -- ^ The sending status of the recipient
65+ , _mres_reject_reason :: Maybe MandrillRejectReason
66+ -- ^ The reason for the rejection if the recipient status is "rejected"
30 , _mres__id :: !T.Text
67 , _mres__id :: !T.Text
31− , _mres_reject_reason :: Maybe T.Text
68+ -- ^ The message's unique id
32 } deriving Show
69 } deriving Show
33
70
34makeLenses ''MandrillResult
71makeLenses ''MandrillResult
35deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillResult
72deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillResult
36
73
74+--------------------------------------------------------------------------------
75+-- | The main datatypes which models the response from the Mandrill API,
76+-- which can be either a success or a failure.
37data MandrillResponse =
77data MandrillResponse =
38 MandrillSuccess [MandrillResult]
78 MandrillSuccess [MandrillResult]
39 | MandrillFailure MandrillError deriving Show
79 | MandrillFailure MandrillError deriving Show
@@ -47,20 +87,38 @@ instance FromJSON MandrillResponse where
47 Nothing -> fail $ show o <> " is not a valid MandrillError"
87 Nothing -> fail $ show o <> " is not a valid MandrillError"
48 parseJSON v = typeMismatch "Expected an Object or an Array for MandrillResponse" v
88 parseJSON v = typeMismatch "Expected an Object or an Array for MandrillResponse" v
49
89
90+
91+--------------------------------------------------------------------------------
92+data MandrillRecipientTag = To | Cc | Bcc deriving Show
93+
94+deriveJSON defaultOptions { constructorTagModifier = map toLower } ''MandrillRecipientTag
95+
96+
97+--------------------------------------------------------------------------------
98+-- | An array of recipient information.
50data MandrillRecipient = MandrillRecipient {
99data MandrillRecipient = MandrillRecipient {
51 _mrec_email :: !T.Text
100 _mrec_email :: !T.Text
101+ -- ^ The email address of the recipient
52− , _mrec_name :: !T.Text
102+ , _mrec_name :: Maybe T.Text
103+ -- ^ The optional display name to use for the recipient
53− , _mrec_type :: !T.Text
104+ , _mrec_type :: Maybe MandrillRecipientTag
105+ -- ^ The header type to use for the recipient.
106+ -- defaults to "to" if not provided
54 } deriving Show
107 } deriving Show
55
108
56makeLenses ''MandrillRecipient
109makeLenses ''MandrillRecipient
57deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillRecipient
110deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillRecipient
58
111
112+
113+--------------------------------------------------------------------------------
59newtype MandrillHtml = MandrillHtml Blaze.Html
114newtype MandrillHtml = MandrillHtml Blaze.Html
60
115
61mkMandrillHtml :: T.Text -> MandrillHtml
116mkMandrillHtml :: T.Text -> MandrillHtml
62mkMandrillHtml = MandrillHtml . Blaze.toHtml
117mkMandrillHtml = MandrillHtml . Blaze.toHtml
63
118
119+mkMandrillHtml' :: Blaze.Html -> MandrillHtml
120+mkMandrillHtml' = MandrillHtml
121+
64instance Show MandrillHtml where
122instance Show MandrillHtml where
65 show (MandrillHtml h) = show $ Blaze.renderHtml h
123 show (MandrillHtml h) = show $ Blaze.renderHtml h
66
124
@@ -71,26 +129,44 @@ instance FromJSON MandrillHtml where
71 parseJSON (String h) = return $ MandrillHtml (Blaze.toHtml h)
129 parseJSON (String h) = return $ MandrillHtml (Blaze.toHtml h)
72 parseJSON v = typeMismatch "Expecting a String for MandrillHtml" v
130 parseJSON v = typeMismatch "Expecting a String for MandrillHtml" v
73
131
132+
133+--------------------------------------------------------------------------------
134+-- | The information on the message to send
74data MandrillMessage = MandrillMessage {
135data MandrillMessage = MandrillMessage {
75 _mmsg_html :: MandrillHtml
136 _mmsg_html :: MandrillHtml
137+ -- ^ The full HTML content to be sent
76− , _mmsg_text :: !T.Text
138+ , _mmsg_text :: Maybe T.Text
139+ -- ^ Optional full text content to be sent
77 , _mmsg_subject :: !T.Text
140 , _mmsg_subject :: !T.Text
141+ -- ^ The message subject
78 , _mmsg_from_email :: !T.Text
142 , _mmsg_from_email :: !T.Text
143+ -- ^ The sender email address
79− , _mmsg_from_name :: !T.Text
144+ , _mmsg_from_name :: Maybe T.Text
145+ -- ^ Optional from name to be used
80 , _mmsg_to :: [MandrillRecipient]
146 , _mmsg_to :: [MandrillRecipient]
147+ -- ^ A list of recipient information
81 } deriving Show
148 } deriving Show
82
149
83makeLenses ''MandrillMessage
150makeLenses ''MandrillMessage
84deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillMessage
151deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillMessage
85
152
153+
154+--------------------------------------------------------------------------------
86-- * Send payloads
155-- * Send payloads
156+--------------------------------------------------------------------------------
87
157
158+
159+--------------------------------------------------------------------------------
88type MandrillKey = T.Text
160type MandrillKey = T.Text
89
161
162+
163+--------------------------------------------------------------------------------
90data MandrillSendRq = MandrillSendRq {
164data MandrillSendRq = MandrillSendRq {
91 _msrq_key :: MandrillKey
165 _msrq_key :: MandrillKey
92 , _msrq_message :: MandrillMessage
166 , _msrq_message :: MandrillMessage
93− , _msrq_async :: Bool
167+ , _msrq_async :: Maybe Bool
168+ , _msrq_ip_pool :: Maybe T.Text
169+ , _msrq_send_at :: Maybe UTCTime
94 } deriving Show
170 } deriving Show
95
171
96makeLenses ''MandrillSendRq
172makeLenses ''MandrillSendRq
src/Network/API/Mandrill/Utils.hsnew file+17
@@ -0,0 +1,17 @@
1+
2+module Network.API.Mandrill.Utils where
3+
4+import Data.Char
5+
6+--------------------------------------------------------------------------------
7+-- | Turns camelCase strings into suitable dashified ones.
8+-- >>> modRejectReason "TestModeLimit"
9+-- "test-mode-limit"
10+modRejectReason :: String -> String
11+modRejectReason [] = []
12+modRejectReason (x:xs) = toLower x : go xs
13+ where
14+ go [] = []
15+ go (y:ys) = case isUpper y of
16+ False -> y : go ys
17+ True -> '-' : toLower y : go ys