8622d4d · typeable/mandrill

mandrill.cabal+1

compare with master

unifiedsplit

@@ -26,6 +26,7 @@ library

26 Network.API.Mandrill.Messages

27 Network.API.Mandrill.Messages.Types

28 Network.API.Mandrill.Inbound

29+ Network.API.Mandrill.Senders

29 other-modules:

30 other-modules:

30 Network.API.Mandrill.Utils

31 Network.API.Mandrill.Utils

31 Network.API.Mandrill.HTTP

32 Network.API.Mandrill.HTTP

src/Network/API/Mandrill/Senders.hsnew file+62

@@ -0,0 +1,62 @@

1+{-# LANGUAGE TemplateHaskell #-}

2+module Network.API.Mandrill.Senders where

3+import Control.Lens

4+import Data.Aeson (FromJSON, ToJSON, parseJSON,

5+ toJSON)

6+import Data.Aeson.TH (defaultOptions, deriveJSON)

7+import Data.Aeson.Types (Value (..), fieldLabelModifier)

8+import Data.Text (Text)

9+import Data.Text.Encoding (decodeUtf8, encodeUtf8)

10+import Network.API.Mandrill.HTTP (toMandrillResponse)

11+import Network.API.Mandrill.Settings

12+import Network.API.Mandrill.Types

13+import Network.HTTP.Client (Manager)

14+import qualified Text.Email.Validate as TEV

15+

16+data VerifyDomainRq =

17+ VerifyDomainRq

18+ { _vdrq_key :: MandrillKey

19+ , _vdrq_domain :: Text

20+ , _vdrq_mailbox :: Text

21+ } deriving Show

22+

23+makeLenses ''VerifyDomainRq

24+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''VerifyDomainRq

25+

26+data VerifyDomainResponse =

27+ VerifyDomainResponse

28+ { _vdres_status :: Text

29+ , _vdres_domain :: Text

30+ , _vdres_email :: TEV.EmailAddress

31+ } deriving Show

32+

33+makeLenses ''VerifyDomainResponse

34+deriveJSON defaultOptions { fieldLabelModifier = drop 7 } ''VerifyDomainResponse

35+

36+

37+verifyDomain :: MandrillKey

38+ -- ^ The API key

39+ -> TEV.EmailAddress

40+ -- ^ Email address to use for verification

41+ -> Maybe Manager

42+ -> IO (MandrillResponse VerifyDomainResponse)

43+verifyDomain k email =

44+ toMandrillResponse VerifyDomain

45+ (VerifyDomainRq k (decodeUtf8 $ TEV.domainPart email) (decodeUtf8 $ TEV.localPart email))

46+-- addDomain :: MandrillKey

47+

48+-- addDomain k dom = toMandrillResponse DomainsAdd (DomainAddRq k dom)

49+

50+

51+

52+-- addRoute :: MandrillKey

53+-- -- ^ The API key

54+-- -> Text

55+-- -- ^ The domain to add

56+-- -> Text

57+-- -- ^ the pattern including wildcards

58+-- -> Text

59+-- -- ^ URL to forward to

60+-- -> Maybe Manager

61+-- -> IO (MandrillResponse RouteAddResponse)

62+-- addRoute k dom pattern forward = toMandrillResponse RoutesAdd (RouteAddRq k dom pattern forward)

src/Network/API/Mandrill/Settings.hs+3

@@ -19,6 +19,8 @@ data MandrillCalls =

19 -- Inbound API

20 | RoutesAdd

21 | DomainsAdd

22+ -- Senders API

23+ | VerifyDomain

22

24

23 deriving Show

25 deriving Show

24

26

@@ -35,3 +37,4 @@ instance MandrillEndpoint MandrillCalls where

35 toUrl MessagesSearch = "messages/search.json"

37 toUrl MessagesSearch = "messages/search.json"

36 toUrl DomainsAdd = "inbound/add-domain.json"

38 toUrl DomainsAdd = "inbound/add-domain.json"

37 toUrl RoutesAdd = "inbound/add-route.json"

39 toUrl RoutesAdd = "inbound/add-route.json"

40+ toUrl VerifyDomain = "senders/verify-domain.json"

src/Network/API/Mandrill/Types.hs+13−2

@@ -1,6 +1,6 @@

1{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DeriveFunctor #-}

3{-# LANGUAGE DeriveFoldable #-}

2{-# LANGUAGE DeriveFoldable #-}

3+{-# LANGUAGE DeriveFunctor #-}

4{-# LANGUAGE DeriveTraversable #-}

5{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE RankNTypes #-}

@@ -9,6 +9,7 @@

9module Network.API.Mandrill.Types where

10

11import Control.Applicative

12+import Control.Monad (mzero)

12import Data.Char

13import Data.Char

13import Data.Maybe

14import Data.Maybe

14import Data.Time

15import Data.Time

@@ -37,7 +38,7 @@ import qualified Data.Text.Encoding as TL

37import qualified Data.Text.Lazy as TL

38import qualified Data.Text.Lazy as TL

38import qualified Text.Blaze.Html as Blaze

39import qualified Text.Blaze.Html as Blaze

39import qualified Text.Blaze.Html.Renderer.Text as Blaze

40import qualified Text.Blaze.Html.Renderer.Text as Blaze

40−

41+import qualified Text.Email.Validate as TEV

41

42

42timeParse :: ParseTime t => TimeLocale -> String -> String -> Maybe t

43timeParse :: ParseTime t => TimeLocale -> String -> String -> Maybe t

43#if MIN_VERSION_time(1,5,0)

44#if MIN_VERSION_time(1,5,0)

@@ -386,3 +387,13 @@ instance FromJSON MandrillDate where

386 case timeParse defaultTimeLocale "%Y-%m-%d %I:%M:%S%Q" (T.unpack t) of

387 case timeParse defaultTimeLocale "%Y-%m-%d %I:%M:%S%Q" (T.unpack t) of

387 Just d -> pure $ MandrillDate d

388 Just d -> pure $ MandrillDate d

388 _ -> fail "could not parse Mandrill date"

389 _ -> fail "could not parse Mandrill date"

390+

391+

392+instance ToJSON TEV.EmailAddress where

393+ toJSON = String . TL.decodeUtf8 . TEV.toByteString

394+

395+instance FromJSON TEV.EmailAddress where

396+ parseJSON (String s) = case TEV.emailAddress (TL.encodeUtf8 s) of

397+ Nothing -> mzero

398+ Just x -> return x

399+ parseJSON _ = mzero

test/Main.hs+1

@@ -44,5 +44,6 @@ main = do

44 , testCase "messages/send.json API response parsing" testMessagesResponseRejected

45 , testCase "inbound/add-route.json API response parsing" testRouteAdd

46 , testCase "inbound/add-domain.json API response parsing" testDomainAdd

47+ , testCase "senders/verify-domain.json API response parsing" testVerifyDomain

47 ]

48 ]

49 ]

test/RawData.hs+8

@@ -228,3 +228,11 @@ routeAdd= [r|

228 "url": "http://example.com/webhook-url"

229}

230|]

231+

232+domainVerify = [r|

233+{

234+ "status": "example status",

235+ "domain": "example domain",

236+ "email": "email@domain.com"

237+}

238+|]

test/Tests.hs+9

@@ -6,6 +6,7 @@ import qualified Data.ByteString.Char8 as C8

6import Data.Either

7import Network.API.Mandrill.Inbound

8import Network.API.Mandrill.Messages.Types

9+import Network.API.Mandrill.Senders

9import Network.API.Mandrill.Types

10import Network.API.Mandrill.Types

10import Network.API.Mandrill.Users.Types

11import Network.API.Mandrill.Users.Types

11import RawData

12import RawData

@@ -67,3 +68,11 @@ testRouteAdd =

67 where

68 where

68 parsePayload :: Either String RouteAddResponse

69 parsePayload :: Either String RouteAddResponse

69 parsePayload = eitherDecodeStrict . C8.pack $ routeAdd

70 parsePayload = eitherDecodeStrict . C8.pack $ routeAdd

71+

72+testVerifyDomain :: Assertion

73+testVerifyDomain =

74+ assertBool ("senders/verify-domain.json" ++ show parsePayload)

75+ (isRight parsePayload)

76+ where

77+ parsePayload :: Either String VerifyDomainResponse

78+ parsePayload = eitherDecodeStrict . C8.pack $ domainVerify