module Web.MailChimp
( Key
, Client(..)
, makeClient
, ListClient(..)
, ListId
, ListMemberClient(..)
, makeListMemberClient
, ListMemberRequest(..)
, makeListMemberRequest
, ListMemberResponse(..)
, ListMemberId
, ListMemberStatus(..)
, Id
, Paths_mailchimp.version
, makeManager
)
where
import Data.Aeson
import Data.Proxy (Proxy (Proxy))
import Data.Void (Void)
import Data.ByteString.Char8 (unpack)
import Network.HTTP.Client (Manager)
import qualified Paths_mailchimp
import Web.MailChimp.Common
import Web.MailChimp.Extra
import Web.MailChimp.Key
import Web.MailChimp.List
import Web.MailChimp.List.Member
import Servant.API
import Servant.Client hiding (Client)
import qualified Servant.Client as Servant
import Control.Monad.IO.Class
import Control.Monad.Trans.Except (ExceptT, runExceptT)
type Api =
"3.0"
:> BasicAuth "" Void
:> (Get '[JSON] Object :<|> ListApi)
data Client =
Client
{
getLinks
:: forall m . MonadIO m
=> m (Either ServantError Object)
, makeListClient
:: ListId
-> ListClient
}
makeClient
:: Manager
-> Key
-> Maybe Client
makeClient manager key =
case makeBaseUrl key of
Nothing ->
Nothing
Just baseUrl ->
let
makeGetLinks :<|> client' = client (Proxy :: Proxy Api) basicAuthData
getLinks :: MonadIO m => m (Either ServantError Object)
getLinks = run (makeGetLinks manager baseUrl)
makeListClient = makeListClient' manager baseUrl client'
basicAuthData = BasicAuthData "" key
in
Just Client {..}
makeListClient'
:: Manager
-> BaseUrl
-> Servant.Client ListApi
-> ListId
-> ListClient
makeListClient' manager baseUrl client' listId =
let
listMemberClient =
makeListMemberClient' manager baseUrl (client' listId)
in
ListClient {..}
makeListMemberClient'
:: Manager
-> BaseUrl
-> Servant.Client ListMemberApi
-> ListMemberClient
makeListMemberClient' manager baseUrl listClient =
let
makeAddListMember
:<|> md
:<|> md2
:<|> md3
:<|> md4
:<|> makeDeleteListMember = listClient
addListMember lm = run (makeAddListMember lm manager baseUrl)
getListMembers :: MonadIO m => m (Either ServantError [ListMemberResponse])
getListMembers = run (md manager baseUrl)
getListMember s = run (md2 s manager baseUrl)
updateListMember s lm = run (md3 s lm manager baseUrl)
addOrUpdateListMember s lm = run (md4 s lm manager baseUrl)
deleteListMember s = run (makeDeleteListMember s manager baseUrl)
in
ListMemberClient {..}
run
:: MonadIO m
=> ExceptT e IO a
-> m (Either e a)
run =
liftIO . runExceptT
makeListMemberClient
:: Manager
-> Key
-> ListId
-> Maybe ListMemberClient
makeListMemberClient manager key listId =
listMemberClient . (`makeListClient` listId)
<$> makeClient manager key
makeBaseUrl
:: Key
-> Maybe BaseUrl
makeBaseUrl key =
case fmap unpack (parseDataCenter key) of
Left _ ->
Nothing
Right dataCenter ->
Just $
BaseUrl
Https
(mappend dataCenter ".api.mailchimp.com")
443
""