@@ -0,0 +1,97 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+module Network.API.Mandrill.Types where
5+
6+import qualified Data.Text as T
7+import qualified Data.Text.Lazy as TL
8+import Control.Lens
9+import Control.Monad
10+import Data.Monoid
11+import Data.Aeson
12+import Data.Aeson.Types
13+import Data.Aeson.TH
14+import qualified Text.Blaze.Html as Blaze
15+import qualified Text.Blaze.Html.Renderer.Text as Blaze
16+
17+data MandrillError = MandrillError {
18+ _merr_status :: !T.Text
19+ , _merr_code :: !Int
20+ , _merr_name :: !T.Text
21+ , _merr_message :: !T.Text
22+ } deriving Show
23+
24+makeLenses ''MandrillError
25+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillError
26+
27+data MandrillResult = MandrillResult {
28+ _mres_email :: !T.Text
29+ , _mres_status :: !T.Text
30+ , _mres__id :: !T.Text
31+ , _mres_reject_reason :: Maybe T.Text
32+ } deriving Show
33+
34+makeLenses ''MandrillResult
35+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillResult
36+
37+data MandrillResponse =
38+ MandrillSuccess [MandrillResult]
39+ | MandrillFailure MandrillError deriving Show
40+
41+instance FromJSON MandrillResponse where
42+ parseJSON a@(Array _) = case (parseMaybe parseJSON a) :: Maybe [MandrillResult] of
43+ Just r -> return $ MandrillSuccess r
44+ Nothing -> fail $ show a <> " is not a valid MandrillResult"
45+ parseJSON o@(Object _) = case (parseMaybe parseJSON o) :: Maybe MandrillError of
46+ Just e -> return $ MandrillFailure e
47+ Nothing -> fail $ show o <> " is not a valid MandrillError"
48+ parseJSON v = typeMismatch "Expected an Object or an Array for MandrillResponse" v
49+
50+data MandrillRecipient = MandrillRecipient {
51+ _mrec_email :: !T.Text
52+ , _mrec_name :: !T.Text
53+ , _mrec_type :: !T.Text
54+ } deriving Show
55+
56+makeLenses ''MandrillRecipient
57+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillRecipient
58+
59+newtype MandrillHtml = MandrillHtml Blaze.Html
60+
61+mkMandrillHtml :: T.Text -> MandrillHtml
62+mkMandrillHtml = MandrillHtml . Blaze.toHtml
63+
64+instance Show MandrillHtml where
65+ show (MandrillHtml h) = show $ Blaze.renderHtml h
66+
67+instance ToJSON MandrillHtml where
68+ toJSON (MandrillHtml h) = String . TL.toStrict . Blaze.renderHtml $ h
69+
70+instance FromJSON MandrillHtml where
71+ parseJSON (String h) = return $ MandrillHtml (Blaze.toHtml h)
72+ parseJSON v = typeMismatch "Expecting a String for MandrillHtml" v
73+
74+data MandrillMessage = MandrillMessage {
75+ _mmsg_html :: MandrillHtml
76+ , _mmsg_text :: !T.Text
77+ , _mmsg_subject :: !T.Text
78+ , _mmsg_from_email :: !T.Text
79+ , _mmsg_from_name :: !T.Text
80+ , _mmsg_to :: [MandrillRecipient]
81+ } deriving Show
82+
83+makeLenses ''MandrillMessage
84+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillMessage
85+
86+-- * Send payloads
87+
88+type MandrillKey = T.Text
89+
90+data MandrillSendRq = MandrillSendRq {
91+ _msrq_key :: MandrillKey
92+ , _msrq_message :: MandrillMessage
93+ , _msrq_async :: Bool
94+ } deriving Show
95+
96+makeLenses ''MandrillSendRq
97+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillSendRq