{-# LANGUAGE TemplateHaskell #-}
module Network.API.Mandrill.Inbound where
import           Data.Aeson                    (FromJSON, ToJSON, parseJSON,
                                                toJSON)
import           Data.Aeson.TH                 (defaultOptions, deriveJSON)
import           Data.Aeson.Types              (fieldLabelModifier)
import           Data.Text                     (Text)
import           Lens.Micro.TH                 (makeLenses)
import           Network.API.Mandrill.HTTP     (toMandrillResponse)
import           Network.API.Mandrill.Settings
import           Network.API.Mandrill.Types
import           Network.HTTP.Client           (Manager)

data DomainAddRq =
  DomainAddRq
  { DomainAddRq -> MandrillKey
_darq_key    :: MandrillKey
  , DomainAddRq -> MandrillKey
_darq_domain :: Text
  } deriving Int -> DomainAddRq -> ShowS
[DomainAddRq] -> ShowS
DomainAddRq -> String
(Int -> DomainAddRq -> ShowS)
-> (DomainAddRq -> String)
-> ([DomainAddRq] -> ShowS)
-> Show DomainAddRq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DomainAddRq] -> ShowS
$cshowList :: [DomainAddRq] -> ShowS
show :: DomainAddRq -> String
$cshow :: DomainAddRq -> String
showsPrec :: Int -> DomainAddRq -> ShowS
$cshowsPrec :: Int -> DomainAddRq -> ShowS
Show

makeLenses ''DomainAddRq
deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''DomainAddRq

data DomainAddResponse =
  DomainAddResponse
  { DomainAddResponse -> MandrillKey
_dares_domain     :: Text
  , DomainAddResponse -> MandrillDate
_dares_created_at :: MandrillDate
  , DomainAddResponse -> Bool
_dares_valid_mx   :: Bool
  } deriving Int -> DomainAddResponse -> ShowS
[DomainAddResponse] -> ShowS
DomainAddResponse -> String
(Int -> DomainAddResponse -> ShowS)
-> (DomainAddResponse -> String)
-> ([DomainAddResponse] -> ShowS)
-> Show DomainAddResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DomainAddResponse] -> ShowS
$cshowList :: [DomainAddResponse] -> ShowS
show :: DomainAddResponse -> String
$cshow :: DomainAddResponse -> String
showsPrec :: Int -> DomainAddResponse -> ShowS
$cshowsPrec :: Int -> DomainAddResponse -> ShowS
Show



makeLenses ''DomainAddResponse
deriveJSON defaultOptions { fieldLabelModifier = drop 7 } ''DomainAddResponse

data RouteAddResponse =
  RouteAddResponse
  { RouteAddResponse -> MandrillKey
_rares_id      :: Text
  , RouteAddResponse -> MandrillKey
_rares_pattern :: Text
  , RouteAddResponse -> MandrillKey
_rares_url     :: Text
  } deriving Int -> RouteAddResponse -> ShowS
[RouteAddResponse] -> ShowS
RouteAddResponse -> String
(Int -> RouteAddResponse -> ShowS)
-> (RouteAddResponse -> String)
-> ([RouteAddResponse] -> ShowS)
-> Show RouteAddResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RouteAddResponse] -> ShowS
$cshowList :: [RouteAddResponse] -> ShowS
show :: RouteAddResponse -> String
$cshow :: RouteAddResponse -> String
showsPrec :: Int -> RouteAddResponse -> ShowS
$cshowsPrec :: Int -> RouteAddResponse -> ShowS
Show



makeLenses ''RouteAddResponse
deriveJSON defaultOptions { fieldLabelModifier = drop 7 } ''RouteAddResponse

data RouteAddRq =
  RouteAddRq
  { RouteAddRq -> MandrillKey
_rarq_key     :: Text
  , RouteAddRq -> MandrillKey
_rarq_domain  :: Text
  , RouteAddRq -> MandrillKey
_rarq_pattern :: Text
  , RouteAddRq -> MandrillKey
_rarq_url     :: Text
  } deriving Int -> RouteAddRq -> ShowS
[RouteAddRq] -> ShowS
RouteAddRq -> String
(Int -> RouteAddRq -> ShowS)
-> (RouteAddRq -> String)
-> ([RouteAddRq] -> ShowS)
-> Show RouteAddRq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RouteAddRq] -> ShowS
$cshowList :: [RouteAddRq] -> ShowS
show :: RouteAddRq -> String
$cshow :: RouteAddRq -> String
showsPrec :: Int -> RouteAddRq -> ShowS
$cshowsPrec :: Int -> RouteAddRq -> ShowS
Show

makeLenses ''RouteAddRq
deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''RouteAddRq

addDomain :: MandrillKey
     -- ^ The API key
     -> Text
     -- ^ The domain to add
     -> Maybe Manager
     -> IO (MandrillResponse DomainAddResponse)
addDomain :: MandrillKey
-> MandrillKey
-> Maybe Manager
-> IO (MandrillResponse DomainAddResponse)
addDomain MandrillKey
k MandrillKey
dom = MandrillCalls
-> DomainAddRq
-> Maybe Manager
-> IO (MandrillResponse DomainAddResponse)
forall ep a rq.
(MandrillEndpoint ep, FromJSON a, ToJSON rq) =>
ep -> rq -> Maybe Manager -> IO (MandrillResponse a)
toMandrillResponse MandrillCalls
DomainsAdd (MandrillKey -> MandrillKey -> DomainAddRq
DomainAddRq MandrillKey
k MandrillKey
dom)



addRoute :: MandrillKey
     -- ^ The API key
     -> Text
     -- ^ The domain to add
     -> Text
     -- ^ the pattern including wildcards
     -> Text
     -- ^ URL to forward to
     -> Maybe Manager
     -> IO (MandrillResponse RouteAddResponse)
addRoute :: MandrillKey
-> MandrillKey
-> MandrillKey
-> MandrillKey
-> Maybe Manager
-> IO (MandrillResponse RouteAddResponse)
addRoute MandrillKey
k MandrillKey
dom MandrillKey
pattern MandrillKey
forward = MandrillCalls
-> RouteAddRq
-> Maybe Manager
-> IO (MandrillResponse RouteAddResponse)
forall ep a rq.
(MandrillEndpoint ep, FromJSON a, ToJSON rq) =>
ep -> rq -> Maybe Manager -> IO (MandrillResponse a)
toMandrillResponse MandrillCalls
RoutesAdd (MandrillKey
-> MandrillKey -> MandrillKey -> MandrillKey -> RouteAddRq
RouteAddRq MandrillKey
k MandrillKey
dom MandrillKey
pattern MandrillKey
forward)