@@ -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)