8622d4d · typeable/mandrill

git.iko.soy/typeable/mandrill

add verify domain call

commit8622d4d8c9ec0fdb09f34c1203578523e6d4a43f authorMark Wotton <mwotton@gmail.com> dateTue 10 May 2016, 16:48 (10 years ago) parentfc4ab63

7 files changed+97−2

compare with master

unifiedsplit

mandrill.cabal+1 src/Network/API/Mandrill/Senders.hs+62 src/Network/API/Mandrill/Settings.hs+3 src/Network/API/Mandrill/Types.hs+13−2 test/Main.hs+1 test/RawData.hs+8 test/Tests.hs+9

mandrill.cabal+1

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

2626 Network.API.Mandrill.Messages

2727 Network.API.Mandrill.Messages.Types

2828 Network.API.Mandrill.Inbound

29+ Network.API.Mandrill.Senders

2930 other-modules:

3031 Network.API.Mandrill.Utils

3132 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 =

1919 -- Inbound API

2020 | RoutesAdd

2121 | DomainsAdd

22+ -- Senders API

23+ | VerifyDomain

2224

2325 deriving Show

2426

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

3537 toUrl MessagesSearch = "messages/search.json"

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

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

11{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DeriveFunctor #-}

32{-# LANGUAGE DeriveFoldable #-}

3+{-# LANGUAGE DeriveFunctor #-}

44{-# LANGUAGE DeriveTraversable #-}

55{-# LANGUAGE OverloadedStrings #-}

66{-# LANGUAGE RankNTypes #-}

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

99module Network.API.Mandrill.Types where

1010

1111import Control.Applicative

12+import Control.Monad (mzero)

1213import Data.Char

1314import Data.Maybe

1415import Data.Time

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

3738import qualified Data.Text.Lazy as TL

3839import qualified Text.Blaze.Html as Blaze

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

40−

41+import qualified Text.Email.Validate as TEV

4142

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

4344#if MIN_VERSION_time(1,5,0)

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

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

387388 Just d -> pure $ MandrillDate d

388389 _ -> 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

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

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

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

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

4748 ]

4849 ]

test/RawData.hs+8

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

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

229229}

230230|]

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

66import Data.Either

77import Network.API.Mandrill.Inbound

88import Network.API.Mandrill.Messages.Types

9+import Network.API.Mandrill.Senders

910import Network.API.Mandrill.Types

1011import Network.API.Mandrill.Users.Types

1112import RawData

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

6768 where

6869 parsePayload :: Either String RouteAddResponse

6970 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