diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2015, Dananji Liyanage +Copyright (c) 2016, Dananji All rights reserved. @@ -13,7 +13,7 @@ disclaimer in the documentation and/or other materials provided with the distribution. - * Neither the name of Dananji Liyanage nor the names of other + * Neither the name of Dananji nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. diff --git a/MailchimpSimple.cabal b/MailchimpSimple.cabal --- a/MailchimpSimple.cabal +++ b/MailchimpSimple.cabal @@ -1,82 +1,40 @@ --- Initial MailchimpSimple.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - --- The name of the package. -name: MailchimpSimple - --- The package version. See the Haskell package versioning policy (PVP) --- for standards guiding when and how versions should be incremented. --- http://www.haskell.org/haskellwiki/Package_versioning_policy --- PVP summary: +-+------- breaking API changes --- | | +----- non-breaking API additions --- | | | +--- code changes with no API change -version: 0.1.0.0 - --- A short (one-line) description of the package. -synopsis: A Haskell library to handle mailing lists in MailchimpSimple using its JSON API. - --- A longer description of the package. -description: Library to handle mailing lists in MailchimpSimple using its JSON API - --- URL for the project homepage or repository. -homepage: https://github.com/Dananji/MailchimpSimple - --- The license under which the package is released. -license: BSD3 - --- The file containing the license text. -license-file: LICENSE - --- The package author(s). -author: Dananji Liyanage - --- An email address to which users can send suggestions, bug reports, and --- patches. -maintainer: dan9131@gmail.com - --- A copyright notice. --- copyright: - -category: Web - -build-type: Simple - --- Extra files to be distributed with the package, such as examples or a --- README. -extra-source-files: README.md - --- Constraint on the version of Cabal needed to build this package. -cabal-version: >=1.10 - +Name: MailchimpSimple +Version: 0.2.0.0 +Synopsis: Haskell library to interact with Mailchimp JSON API Version 3.0 +Description: This package contains the basic functions supported by Mailchimp JSON API. For HTTP Authentication, it uses Basic HTTP Authentication. +Homepage: https://github.com/Dananji/MailchimpSimple +License: BSD3 +License-file: LICENSE +Author: Dananji +Maintainer: dan9131@gmail.com +Category: Web +Build-type: Simple +Extra-source-files: README.md +Cabal-version: >=1.10 library - -- Modules exported by the library. - exposed-modules: MailchimpSimple, MailchimpSimple.Types, MailchimpSimple.Logger - - -- Modules included in this library but not exported. + exposed-modules: MailchimpSimple, Utils.Types, Utils.Logger -- other-modules: - - -- LANGUAGE extensions used by modules in this package. other-extensions: OverloadedStrings, DeriveGeneric - - -- Other library packages from which modules are imported. - build-depends: base >=4.7 && <4.8 - , http-conduit >=2.1 && <2.2 - , http-types >=0.8 && <0.9 - , transformers >=0.3 && <0.4 - , aeson >=0.7 && <0.8 - , filepath >=1.3 && <1.4 - , bytestring >=0.10 && <0.11 - , aeson-lens >=0.5 && <0.6 - , lens >=4.11 && <4.12 - , text >=1.1 && <1.2 - , vector >=0.10 && <0.11 - , time >=1.4 && <1.5 - , directory >=1.2 && <1.3 - - -- Directories containing source files. - -- hs-source-dirs: - - -- Base language which the package is written in. + build-depends: base >=4.8 && <4.9 + , http-conduit >=2.1 + , http-types >=0.9 + , transformers >=0.4 + , safe >=0.3 + , lens >=4.13 + , filepath >=1.4 + , bytestring >=0.10 + , base16-bytestring >=0.1 + , text >=1.2 + , aeson >=0.11 + , aeson-lens >=0.5 + , vector >=0.11 + , cryptohash >=0.11 + , time >=1.5 + , directory >=1.2 + hs-source-dirs: src default-language: Haskell2010 - + +Source-repository head + type: git + location: https://github.com/Dananji/MailchimpSimple diff --git a/MailchimpSimple.hs b/MailchimpSimple.hs deleted file mode 100644 --- a/MailchimpSimple.hs +++ /dev/null @@ -1,246 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module MailchimpSimple - ( - -- * Handling Mailing lists in Mailchimp - addSubscriber - , batchSubscribe - , listMailingLists - , listSubscribers - -- * Sending & Creating campaigns - , getTemplates - , createCampaign - , sendEmail - ) where - -import Network.HTTP.Conduit ( parseUrl, RequestBody (RequestBodyLBS), requestBody, method, withManager, httpLbs, Response (..) - , HttpException (..), Cookie(..)) -import Network.HTTP.Types ( methodPost, Status(..), http11 ) -import Control.Monad.IO.Class ( liftIO ) -import Control.Exception ( catch, IOException, Exception ) -import Data.Aeson ( encode, decode, eitherDecode, Value, Array ) -import Data.List ( transpose, intercalate ) -import System.Exit ( exitWith, ExitCode(..) ) -import System.FilePath.Posix ( pathSeparator ) -import qualified Data.ByteString.Lazy as BL ( ByteString, empty ) - -import Data.Aeson.Lens ( key ) -import Data.Maybe ( Maybe(..), fromJust ) -import Control.Lens.Getter ( (^.)) -import qualified Data.Text as T ( pack ) -import qualified Data.Vector as V ( head, tail, empty ) - --- App modules -import MailchimpSimple.Types - - --- | List mailing lists in a particular account with the given API key -listMailingLists - :: String -- ^ API key - -> IO [MailListResponse] -- ^ Array of 'MailListResponse' response -listMailingLists apiKey = do - url <- endPointUrl apiKey - let mList = MailList { l_apikey = apiKey - , l_filters = Filters { list_id = "" - , list_name = "" } - , l_start = 0 - , l_limit = 25 - , l_sort_field = "web" - , l_sort_dir = "DESC" } - let lUrl = url ++ "/lists/list.json" - response <- processResponse lUrl mList apiKey - let resBody = decode (responseBody response) :: Maybe Value - let vArray = resBody ^. key "data" :: Maybe Array - let listResponse = getValues vArray - return listResponse - where getValues ls - | ls /= (Just V.empty) = constructMLRes (fmap V.head ls) : getValues (fmap V.tail ls) - | otherwise = [] - constructMLRes elem = do let lName = elem ^. key "name" :: Maybe String - let lID = elem ^. key "id" :: Maybe String - MailListResponse { l_name = lName, l_id = lID} - - --- | List subscribers in a mailing list with the given list ID -listSubscribers - :: String -- ^ API key - -> String -- ^ List ID - -> IO [ListSubscribersResponse] -- ^ Array of 'ListSubscribersResponse' response -listSubscribers apiKey listID = do - url <- endPointUrl apiKey - let sList = Subscribers { su_apikey = apiKey - , su_id = listID - , su_status = "subscribed" } - let lUrl = url ++ "/lists/members.json" - response <- processResponse lUrl sList apiKey - let resBody = decode (responseBody response) :: Maybe Value - let vArray = resBody ^. key "data" :: Maybe Array - let listSubResponse = getValues vArray - return listSubResponse - where getValues ls - | ls /= (Just V.empty) = constructMLRes (fmap V.head ls) : getValues (fmap V.tail ls) - | otherwise = [] - constructMLRes elem = (ListSubscribersResponse { s_name = sName - , s_euid = sEuid - , s_list_name = sListName - , s_emailType = sEmailType }) - where sName = elem ^. key "email" :: Maybe String - sEuid = elem ^. key "euid" :: Maybe String - sListName = elem ^. key "list_name" :: Maybe String - sEmailType = elem ^. key "email_type" :: Maybe String - --- | Get the templates saved in hte Mailchimp account -getTemplates - :: String -- ^ API key - -> IO [TemplateResponse] -- ^ Array of 'TemplateResponse' response -getTemplates apiKey = do - url <- endPointUrl apiKey - let templates = Template { t_apikey = apiKey - , t_types = TemplateTypes { user = True - , gallery = True - , base = True } } - let tUrl = url ++ "/templates/list.json" - response <- processResponse tUrl templates apiKey - let resBody = decode (responseBody response) :: Maybe Value - let galleryT = resBody ^. key "gallery" :: Maybe Array - let userT = resBody ^. key "user" :: Maybe Array - let allTemplates = (getValues galleryT) ++ (getValues userT) - return allTemplates - where getValues ls - | ls /= (Just V.empty) = constructTRes (fmap V.head ls) : getValues (fmap V.tail ls) - | otherwise = [] - constructTRes elem = do let tName = elem ^. key "name" :: Maybe String - let tID = elem ^. key "id" :: Maybe Int - TemplateResponse { t_name = tName, t_id = tID } - --- | Create a new campaign and save it in the Campaigns list -createCampaign - :: String -- ^ API key - -> String -- ^ List ID - -> String -- ^ Sender's name - -> String -- ^ Sender's email - -> String -- ^ Campaign type, choose from "regular", "plaintext", "absplit", "rss", "auto" - -> String -- ^ Subject of the campaign - -> String -- ^ Receipient's name - -> Int -- ^ Template ID - -> String -- ^ Content of the campaign. Example: HTML "

Title

" - -> IO (Maybe String) -- ^ Campaign ID -createCampaign apiKey - listID - fromName - fromEmail - cType - subject - toName - templateID - content = do - url <- endPointUrl apiKey - let campaign = Campaign { c_apikey = apiKey - , c_type = cType - , c_options = Options { o_list_id = listID - , o_subject = subject - , o_from_email = fromEmail - , o_from_name = fromName - , o_to_name = toName - , o_template_id = templateID } - , c_content = (HTML content) } - let eUrl = url ++ "/campaigns/create.json" - response <- processResponse eUrl campaign apiKey - let resBody = decode (responseBody response) :: Maybe Value - let cid = resBody ^. key "id" :: Maybe String - return cid - --- | Send a saved email campaign -sendEmail - :: String -- ^ API key - -> String -- ^ Campaign ID - -> IO (Either String SendMailResponse) -- ^ 'SendMailResponse' JSON response -sendEmail apiKey cid = do - url <- endPointUrl apiKey - let mail = SendMail { m_apikey = apiKey - , m_cid = cid } - let sUrl = url ++ "/campaigns/send.json" - response <- processResponse sUrl mail apiKey - let sendRes = eitherDecode (responseBody response) :: Either String SendMailResponse - return sendRes - --- | Add a new subscriber -addSubscriber - :: String -- ^ API key - -> String -- ^ List ID - -> String -- ^ Email address to be added - -> String -- ^ Email type, choose from "html", "text" - -> IO (Either String SubscriptionResponse) -- ^ 'SubscriptionResponse' response -addSubscriber apiKey listID email emailType = do - url <- endPointUrl apiKey - let subscription = Subscription { s_apikey = apiKey - , s_id = listID - , s_email = (Email email) - , s_email_type = emailType - , s_dou_opt = True - , s_up_ex = True - , s_rep_int = True - , s_send = True } - let sUrl = url ++ "/lists/subscribe.json" - response <- processResponse sUrl subscription apiKey - let resBody = eitherDecode (responseBody response) :: Either String SubscriptionResponse - return resBody - --- | Add a batch of subscribers -batchSubscribe - :: String -- ^ API key - -> String -- ^ List ID - -> [String] -- ^ List of email addresses to be added - -> IO BatchSubscriptionResponse -- ^ 'BatchSubscriptionResponse' response -batchSubscribe apiKey listID emails = do - url <- endPointUrl apiKey - let emailArry = [ Batch { b_email = (Email x), b_email_type = "html"} | x <- emails] - let batchSubscription = BatchSubscription { b_apikey = apiKey - , b_id = listID - , b_batch = emailArry - , b_dou_opt = True - , b_up_ex = True - , b_rep_int = True } - let bUrl = url ++ "/lists/batch-subscribe.json" - response <- processResponse bUrl batchSubscription apiKey - let resBody = decode (responseBody response) :: Maybe Value - let batchResponse = BatchSubscriptionResponse { add_count = resBody ^. key "add_count" :: Maybe Int - , adds = getValues (resBody ^. key "adds" :: Maybe Array) } - return batchResponse - where getValues ls - | ls /= (Just V.empty) = constructBSRes (fmap V.head ls) : getValues (fmap V.tail ls) - | otherwise = [] - constructBSRes elem = decode (encode elem) :: Maybe SubscriptionResponse - - --- | Build the response from URL and JSON data -processResponse url jsonData apiKey = do - initReq <- liftIO $ parseUrl url - let req = initReq { requestBody = RequestBodyLBS $ encode jsonData - , method = methodPost } - catch (withManager $ httpLbs req) - (\(StatusCodeException s h c) -> do let ex = (show s ++ "," ++ show h ++ "," ++ show c) - getResponse s h c apiKey - exitWith (ExitFailure 0)) - --- | Construct the erroneous HTTP responses when an exception occurs -getResponse s h c apiKey = do - url <- endPointUrl apiKey - initReq <- parseUrl url - let req = initReq { method = methodPost } - response <- withManager $ httpLbs req - let errorRes = response { responseStatus = s - , responseVersion = http11 - , responseBody = "" - , responseHeaders = h - , responseCookieJar = c } - return errorRes - --- | Construct the end-point URL -endPointUrl :: String -> IO String -endPointUrl apiKey = return ("https://" ++ (last (splitString '-' apiKey)) ++ ".api.mailchimp.com/2.0") - --- | Utility function to split strings -splitString :: Char -> String -> [String] -splitString d [] = [] -splitString d s = x : splitString d (drop 1 y) where (x,y) = span (/= d) s diff --git a/MailchimpSimple/Logger.hs b/MailchimpSimple/Logger.hs deleted file mode 100644 --- a/MailchimpSimple/Logger.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module MailchimpSimple.Logger ( LogLevels(..) - , writeLog ) where - -import Data.Time -import System.FilePath.Posix -import System.Directory ( doesDirectoryExist , createDirectory ) - --- | Constructor for the Log levels -data LogLevels = ERROR | DEBUG | INFO deriving (Show, Eq) - --- { --- Constructor for the Log entry = (LogEntry LogLevels logging logInputData logMessage) --- logLevel -> Logging purpose (ERROR/INFO/DEBUG) --- loggingMethod-> Module of the program which writes the log --- logInputData -> Input data at the point of logging --- logMessage -> Output message of the method --- } -data Logger = LogEntry LogLevels String String String deriving (Show, Eq) - -toString :: Logger -> IO String -toString (LogEntry lLevel lMethod lInputData lMessage) = do - utcTime <- getCurrentTime - let myTime = addUTCTime 19800 utcTime - return $ show myTime ++ ", [" ++ show lLevel ++ "], [" ++ lMethod ++ "], Input: " ++ lInputData ++ ", " ++ lMessage - --- { --- Append the log entry to an external log file --- Error logs to 'error.log' file --- Other logs to 'access.log' file --- } -writeLog :: LogLevels -> String -> String -> String -> IO () -writeLog lLevel lMethod lInputData lMessage = do - logEntry <- toString (LogEntry lLevel lMethod lInputData lMessage) - let logEntryProcessed = logEntry ++ "\n" - exists <- doesDirectoryExist "log" - if (exists == True) then return () else (createDirectory "log") - if lLevel == ERROR - then appendFile ("log" ++ [pathSeparator] ++ "error.log") logEntryProcessed - else appendFile ("log" ++ [pathSeparator] ++ "access.log") logEntryProcessed diff --git a/MailchimpSimple/Types.hs b/MailchimpSimple/Types.hs deleted file mode 100644 --- a/MailchimpSimple/Types.hs +++ /dev/null @@ -1,352 +0,0 @@ -{-# LANGUAGE DeriveGeneric, OverloadedStrings #-} - -module MailchimpSimple.Types - ( - -- * Request JSON data types - Subscription(..) - , EmailId(..) - , MailList(..) - , Filters(..) - , Subscribers(..) - , BatchSubscription(..) - , Batch(..) - , Campaign(..) - , Options(..) - , Content(..) - , SendMail(..) - , Template(..) - , TemplateTypes(..) - -- * Response JSON data types - , SubscriptionResponse(..) - , MailListResponse(..) - , ListSubscribersResponse(..) - , BatchSubscriptionResponse(..) - , SendMailResponse(..) - , TemplateResponse(..) - ) where - -import Data.Aeson -- ( FromJSON(..), ToJSON(..), toJSON, parseJSON, (.:), (.:?), (.=), object, Value(..) ) -import Data.Aeson.TH hiding ( Options ) -import GHC.Generics hiding ( head ) -import Control.Monad ( mzero ) -import Data.Maybe ( catMaybes ) - --- | JSON data structure for a single subscription -data Subscription = - Subscription { - s_apikey :: String -- ^ API key of the Mailchimp account - , s_id :: String -- ^ List ID of the mailing list, by calling - , s_email :: EmailId -- ^ Example: jon@example.com - , s_email_type :: String -- ^ Give html/text - , s_dou_opt :: Bool - , s_up_ex :: Bool - , s_rep_int :: Bool - , s_send :: Bool - } deriving (Show) - -instance FromJSON Subscription where - parseJSON (Object v) = do - sApikey <- v .: "apikey" - sID <- v .: "id" - sEmail <- v .: "email" - sEmailType <- v .: "email_type" - sDouOpt <- v .: "double_optin" - sUpEx <- v .: "update_existing" - sRepInt <- v .: "replace_interests" - sSent <- v .: "send_welcome" - return $ Subscription sApikey sID sEmail sEmailType sDouOpt sUpEx sRepInt sSent - parseJSON _ = mzero -instance ToJSON Subscription where - toJSON (Subscription s_apikey s_id s_email s_email_type s_dou_opt s_up_ex s_rep_int s_send) = object [ "apikey" .= s_apikey - , "id" .= s_id - , "email" .= s_email - , "email_type" .= s_email_type - , "double_optin" .= s_dou_opt - , "update_existing" .= s_up_ex - , "replace_interests" .= s_rep_int - , "send_welcome" .= s_send ] - --- | Enum type JSON data structure for Email related variables -data EmailId = Email String - | EmailUniqueId String - | ListEmailId String - deriving (Show) - -instance FromJSON EmailId where - parseJSON (Object v) = do - email <- fmap (fmap Email) $ v .:? "email" - euid <- fmap (fmap EmailUniqueId) $ v .:? "euid" - leid <- fmap (fmap ListEmailId) $ v .:? "leid" - case catMaybes [email, euid, leid] of - (x:_) -> return x - _ -> mzero - parseJSON _ = mzero -instance ToJSON EmailId where - toJSON (Email t) = object ["email" .= t] - toJSON (EmailUniqueId t) = object ["euid" .= t] - toJSON (ListEmailId t) = object ["leid" .= t] - - --- | JSON data structure for batch subscriptions -data BatchSubscription = - BatchSubscription { - b_apikey :: String -- ^ API key of the Mailchimp account - , b_id :: String -- ^ List ID of the mailing list - , b_batch :: [Batch] -- ^ Array of tuples of email address and email type - , b_dou_opt :: Bool - , b_up_ex :: Bool - , b_rep_int :: Bool - } deriving (Show) - -instance FromJSON BatchSubscription where - parseJSON (Object v) = do - bApikey <- v .: "apikey" - bID <- v .: "id" - bBatch <- v .: "batch" - bDouOpt <- v .: "double_optin" - bUpEx <- v .: "update_existing" - bRepInt <- v .: "replace_interests" - return $ BatchSubscription bApikey bID bBatch bDouOpt bUpEx bRepInt - parseJSON _ = mzero -instance ToJSON BatchSubscription where - toJSON (BatchSubscription b_apikey b_id b_batch b_dou_opt b_up_ex b_rep_int) = object [ "apikey" .= b_apikey - , "id" .= b_id - , "batch" .= b_batch - , "double_optin" .= b_dou_opt - , "update_existing" .= b_up_ex - , "replace_interests" .= b_rep_int ] - -data Batch = - Batch { b_email :: EmailId - , b_email_type :: String - } deriving (Show) - -instance FromJSON Batch where - parseJSON (Object v) = do - bEmail <- v .: "email" - bEmailType <- v .: "email_type" - return $ Batch bEmail bEmailType - parseJSON _ = mzero -instance ToJSON Batch where - toJSON (Batch b_email b_email_type) = object [ "email" .= b_email - , "email_type" .= b_email_type ] - -data MailList = - MailList { - l_apikey :: String -- ^ API key of the Mailchimp account - , l_filters :: Filters - , l_start :: Int - , l_limit :: Int - , l_sort_field :: String - , l_sort_dir :: String - } deriving (Show) - -instance FromJSON MailList where - parseJSON (Object v) = do - lApikey <- v .: "apikey" - lFilters <- v .: "filters" - lStart <- v .: "start" - lLimit <- v .: "limit" - lSortField <- v .: "sort_field" - lSortDir <- v .: "sort_dir" - return $ MailList lApikey lFilters lStart lLimit lSortField lSortDir - parseJSON _ = mzero -instance ToJSON MailList where - toJSON (MailList l_apikey l_filters l_start l_limit l_sort_field l_sort_dir) = object [ "apikey" .= l_apikey - , "filters" .= l_filters - , "start" .= l_start - , "limit" .= l_limit - , "sort_field" .= l_sort_field - , "sort_dir" .= l_sort_dir ] - -data Filters = - Filters { - list_id :: String - , list_name :: String - } deriving (Show) - -instance FromJSON Filters where - parseJSON (Object v) = do - lID <- v .: "id" - lName <- v .: "name" - return $ Filters lID lName - parseJSON _ = mzero -instance ToJSON Filters where - toJSON (Filters list_id list_name) = object [ "id" .= list_id - , "name" .= list_name ] - -data Subscribers = - Subscribers { - su_apikey :: String -- ^ API key of the Mailchimp account - , su_id :: String -- ^ List ID of the mailing list - , su_status :: String - } deriving (Show) - -instance FromJSON Subscribers where - parseJSON (Object v) = do - suApikey <- v .: "apikey" - suID <- v .: "id" - suStatus <- v .: "status" - return $ Subscribers suApikey suID suStatus - parseJSON _ = mzero -instance ToJSON Subscribers where - toJSON (Subscribers su_apikey su_id su_status) = object [ "apikey" .= su_apikey - , "id" .= su_id - , "status" .= su_status] - -data Campaign = - Campaign { - c_apikey :: String - , c_type :: String - , c_options :: Options - , c_content :: Content - } deriving (Show, Generic) - -instance FromJSON Campaign where -instance ToJSON Campaign where - toJSON (Campaign c_apikey c_type c_options c_content) = object [ "apikey" .= c_apikey - , "type" .= c_type - , "options" .= c_options - , "content" .= c_content ] - -data Options = - Options { - o_list_id :: String - , o_subject :: String - , o_from_email :: String - , o_from_name :: String - , o_to_name :: String - , o_template_id :: Int - } deriving (Show, Generic) - -instance FromJSON Options where -instance ToJSON Options where - toJSON (Options o_list_id o_subject o_from_email o_from_name o_to_name o_template_id) = object [ "list_id" .= o_list_id - , "subject" .= o_subject - , "from_email" .= o_from_email - , "from_name" .= o_from_name - , "to_name" .= o_to_name - , "template_id" .= o_template_id ] -data Content = HTML String - | Text String - | URL String - deriving (Show) - -instance ToJSON Content where - toJSON (HTML t) = object ["html" .= t] - toJSON (Text t) = object ["text" .= t] - toJSON (URL t) = object ["url" .= t] - -instance FromJSON Content where - parseJSON (Object v) = do - html <- fmap (fmap HTML) $ v .:? "html" - text <- fmap (fmap Text) $ v .:? "text" - url <- fmap (fmap URL) $ v .:? "url" - case catMaybes [html, text, url] of - (x:_) -> return x - _ -> mzero - parseJSON _ = mzero - -data SendMail = - SendMail { - m_apikey :: String -- ^ API key of the Mailchimp account - , m_cid :: String -- ^ Campaign ID of the campaign to be sent - } deriving (Show, Generic) - -instance FromJSON SendMail where -instance ToJSON SendMail where - toJSON (SendMail m_apikey m_cid) = object [ "apikey" .= m_apikey - , "cid" .= m_cid ] - -data Template = - Template { - t_apikey :: String - , t_types :: TemplateTypes - } deriving (Show, Generic) - -instance FromJSON Template where -instance ToJSON Template where - toJSON (Template t_apikey t_types) = object [ "apikey" .= t_apikey - , "types" .= t_types ] - -data TemplateTypes = - TemplateTypes { - user :: Bool - , gallery :: Bool - , base :: Bool - } deriving (Show, Generic) - -instance FromJSON TemplateTypes where -instance ToJSON TemplateTypes where - --- | Response JSON from 'lists/subscribe.json' call -data SubscriptionResponse = - SubscriptionResponse { - email :: String - , euid :: String - , leid :: String - } deriving (Show) - -instance FromJSON SubscriptionResponse where - parseJSON (Object v) = do - srEmail <- v .: "email" - srEuid <- v .: "euid" - srLeid <- v .: "leid" - return $ SubscriptionResponse srEmail srEuid srLeid - parseJSON _ = mzero -instance ToJSON SubscriptionResponse where - toJSON (SubscriptionResponse email euid leid) = object [ "email" .= email - , "euid" .= euid - , "leid" .= leid ] - --- | Response JSON from 'lists/list.json' call, which lists the mailing lists --- in the given account with relevant API key -data MailListResponse = - MailListResponse { - l_name :: Maybe String -- ^ List name - , l_id :: Maybe String -- ^ List ID - } deriving (Show, Generic) - -instance FromJSON MailListResponse where -instance ToJSON MailListResponse where - --- | Response JSON from 'lists/members.json' call, which contains the details --- each subscriber in the given mailing list -data ListSubscribersResponse = - ListSubscribersResponse { - s_name :: Maybe String -- ^ Subscriber's name - , s_euid :: Maybe String -- ^ Subscriber's euid - , s_list_name :: Maybe String - , s_emailType :: Maybe String - } deriving (Show, Generic) - -instance FromJSON ListSubscribersResponse where -instance ToJSON ListSubscribersResponse where - --- | Response JSON from the 'lists/batch-subscribe.json' call, which contains the --- information of the subscriptions of each newly added member -data BatchSubscriptionResponse = - BatchSubscriptionResponse { - add_count :: Maybe Int - , adds :: [Maybe SubscriptionResponse] - } deriving (Show, Generic) - -instance FromJSON BatchSubscriptionResponse where -instance ToJSON BatchSubscriptionResponse where - -data SendMailResponse = - SendMailResponse { - complete :: Bool - } deriving (Show, Generic) - -instance FromJSON SendMailResponse where -instance ToJSON SendMailResponse where - -data TemplateResponse = - TemplateResponse { - t_name :: Maybe String - , t_id :: Maybe Int - } deriving (Show, Generic) - -instance FromJSON TemplateResponse where -instance ToJSON TemplateResponse where diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,23 +1,26 @@ -# MailchimpSimple -A library to handle mailing lists in Mailchimp (http://mailchimp.com/) - -# Introduction -This library is written in Haskell, to interact with Mailchimp's JSON API. The initial commit supports only the Mailchimp 2.0 version. -This currently implements couple of methods in the 'lists' section, they are; - -- Adding subscribers -- List out the subscribers in a mailing list -- List the mailing lists for given 'apikey' -- Past activities performed on a mailing list - -I hope to develop this further to support Mailchimp version 3.0 as well. Here is the link for the blog post written on this [http://dananjiliyanage.blogspot.com/2015/07/develop-mailchimp-library-with-haskell.html] - -# How to use - -Given that you have installed Haskell platform in your machine; -(If not, follow this link: https://www.haskell.org/platform/windows.html) - -1. Clone the Git repository using 'git clone https://github.com/Dananji/MailchimpSimple.git' -2. Open the terminal, and browse into the cloned project folder -4. Run 'cabal update' +# MailchimpSimple +A library to handle mailing lists in Mailchimp (http://mailchimp.com/) + +# Features +This library is written in Haskell, to interact with Mailchimp's JSON API. The initial commit supported only the Mailchimp 2.0 version. Now the library is available for version 3.0 using Basic HTTP Authentication. +This implements the following functionalities; + +- Adding individual subscribers and in batches +- List the mailing lists for given 'apikey' +- List out the subscribers in a mailing list +- List the templates and campaigns in an account +- Create a new campaign +- Send a campaign (for this the campaign should be properly formatted using the web interface) +- Add subscribers in batches and individually and remove individual subscribers from a given list + +Here are the links for the blog posts written on this [http://dananjiliyanage.blogspot.com/2015/07/develop-mailchimp-library-with-haskell.html, http://dananjiliyanage.blogspot.com/2016/03/using-basic-http-authentication-in.html] + +# How to use + +Given that you have installed Haskell platform in your machine; +(If not, follow this link: https://www.haskell.org/platform/windows.html) + +1. Clone the Git repository using 'git clone https://github.com/Dananji/MailchimpSimple.git' +2. Open the terminal, and browse into the cloned project folder +4. Run 'cabal update' 3. Then type 'cabal install' in the terminal diff --git a/cabal.sandbox.config b/cabal.sandbox.config new file mode 100644 --- /dev/null +++ b/cabal.sandbox.config @@ -0,0 +1,25 @@ +-- This is a Cabal package environment file. +-- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY. +-- Please create a 'cabal.config' file in the same directory +-- if you want to change the default settings for this sandbox. + + +local-repo: D:\Haskell\MailchimpSimple\.cabal-sandbox\packages +logs-dir: D:\Haskell\MailchimpSimple\.cabal-sandbox\logs +world-file: D:\Haskell\MailchimpSimple\.cabal-sandbox\world +user-install: False +package-db: D:\Haskell\MailchimpSimple\.cabal-sandbox\x86_64-windows-ghc-7.10.3-packages.conf.d +build-summary: D:\Haskell\MailchimpSimple\.cabal-sandbox\logs\build.log + +install-dirs + prefix: D:\Haskell\MailchimpSimple\.cabal-sandbox + bindir: $prefix\bin + libdir: $prefix + libsubdir: $abi\$libname + libexecdir: $prefix\$libname + datadir: $prefix + datasubdir: $abi\$pkgid + docdir: $datadir\doc\$abi\$pkgid + htmldir: $docdir\html + haddockdir: $htmldir + sysconfdir: $prefix\etc diff --git a/src/MailchimpSimple.hs b/src/MailchimpSimple.hs new file mode 100644 --- /dev/null +++ b/src/MailchimpSimple.hs @@ -0,0 +1,359 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: MailchimpSimple +-- License: BSD3 +-- Maintainer: Dananji Liyanage +-- Stability: experimental +-- +-- Types and functions for working with Mailchimp JSON API Version 3.0 + +module MailchimpSimple +( + -- ** Working with Lists + -- $lists + listMailingLists + , listSubscribers + , addSubscriber + , removeSubscriber + -- ** Retrieve Template related data + -- $templates + , getTemplates + -- ** Working with Campaigns + -- $campaigns + , getCampaigns + , createCampaign + , sendEmail + -- ** Batch Requests + -- $batches + , batchSubscribe ) where + +import Network.HTTP.Conduit +import Network.HTTP.Types ( methodPost, methodGet, methodDelete, Status(..), http11, ResponseHeaders, hContentType ) +import Control.Monad.IO.Class ( liftIO ) + +import Safe +import Control.Exception ( catch, IOException, Exception ) +import Control.Lens.Getter ( (^.)) +import System.Exit ( exitWith, ExitCode(..) ) +import System.FilePath.Posix ( pathSeparator ) + +import qualified Data.ByteString.Lazy as BL +import Data.ByteString.Lazy ( ByteString ) +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Base16 as B16 +import qualified Data.Text as T + +import Data.Aeson ( encode, decode, eitherDecode, Value, Array, ToJSON ) +import Data.List ( transpose, intercalate ) +import Data.Aeson.Lens ( key ) + +import Data.Maybe ( Maybe(..), fromJust ) +import qualified Data.Vector as V +import Crypto.Hash.MD5 as MD5 + + +-- App modules +import Utils.Types + + +-- | Takes an @apiKey@ of a Mailchimp account, and gives all the mailing-lists in the account. +-- +-- This function lists the mailing lists in a particular account +listMailingLists + :: String + -> IO [MailListResponse] +listMailingLists apiKey = do + let url = endPointUrl apiKey + let lUrl = url ++ "/lists?fields=lists.id,lists.name" + response <- processGET lUrl apiKey + let resBody = decode (responseBody response) :: Maybe Value + let vArray = resBody ^. key "lists" :: Maybe Array + let listResponse = getValues vArray + return listResponse + where getValues ls + | ls /= (Just V.empty) = constructMLRes (fmap V.head ls) : getValues (fmap V.tail ls) + | otherwise = [] + constructMLRes elem = do let lName = elem ^. key "name" :: Maybe String + let lID = elem ^. key "id" :: Maybe String + MailListResponse lName lID + +-- | Takes an @apiKey@ of the Mailchimp account, and a @listName@. +-- Retrieves all the members in the given list. +-- +-- Request URL specifies which data to be returned from the response. They are, +-- @email_address, unique_email_id, email_type, list_id@, and @status@ for each +-- member in the reponse. +-- +-- This function lists subscribers in a mailing list +listSubscribers + :: String + -> String + -> IO [ListSubscribersResponse] +listSubscribers apiKey listName = do + let url = endPointUrl apiKey + listid <- getListID apiKey listName + let lUrl = url ++ "/lists/" ++ listid ++ "/members?fields=members.email_address,members.unique_email_id,members.email_type,members.list_id,members.status" + response <- processGET lUrl apiKey + let resBody = decode (responseBody response) :: Maybe Value + let vArray = resBody ^. key "members" :: Maybe Array + let listSubResponse = getValues vArray + return listSubResponse + where getValues ls + | ls /= (Just V.empty) = constructMLRes (fmap V.head ls) : getValues (fmap V.tail ls) + | otherwise = [] + constructMLRes elem = ListSubscribersResponse sName sEuid (Just listName) sEmailType sStatus + where sName = elem ^. key "email_address" :: Maybe String + sEuid = elem ^. key "unique_email_id" :: Maybe String + sEmailType = elem ^. key "email_type" :: Maybe String + sStatus = elem ^. key "status" :: Maybe String + +-- | Taking @apiKey,@ @listName,@ @emailAddress,@ @emailType,@ and @memberStatus@ as input +-- parameters in the given order, this function creates and add the member to the given list. +-- +-- This function adds a new member to a given list +addSubscriber + :: String + -> String + -> String + -> String + -> String + -> IO SubscriptionResponse +addSubscriber apiKey listName email emailType status = do + let url = endPointUrl apiKey + let subscription = Subscription { s_email = email + , s_email_type = emailType + , s_status = status } + listid <- getListID apiKey listName + let sUrl = url ++ "/lists/" ++ listid ++ "/members" + response <- processPOST sUrl subscription apiKey + let resBody = decode (responseBody response) :: Maybe Value + let subscribers = constructSRes resBody + return subscribers + where constructSRes elem = do let email = elem ^. key "email_address" :: Maybe String + let euid = elem ^. key "unique_email_id" :: Maybe String + let status = elem ^. key "status" :: Maybe String + SubscriptionResponse email euid status (Just listName) + filterListID list = filter ((==(Just listName)) . l_name) list + +-- | Giving an @apiKey,@ @emailAddress,@ and @listName@ which the member belongs to, this +-- function unsubscribe the member from the list. This function does not deletes the particular +-- user profile from the mailing-list. +-- +-- This function removes a member from a given list +removeSubscriber + :: String + -> String + -> String + -> IO Bool +removeSubscriber apiKey email listName = do + let url = endPointUrl apiKey + listid <- getListID apiKey listName + let subhash = createHash email + let rUrl = url ++ "/lists/" ++ listid ++ "/members/" ++ subhash + response <- processDELETE rUrl apiKey + let resBody = statusCode $ responseStatus response + case resBody of + 204 -> return True + _ -> return False + where createHash str = (B8.unpack (calculateHash (strToBS str))) + calculateHash str = (B16.encode (hash str)) + strToBS str = B8.pack str + + +-- | Input parameters for this function is the @apiKey@ of the Mailchimp account. +-- +-- This function retrieves all the templates in the account. +getTemplates + :: String + -> IO [TemplateResponse] +getTemplates apiKey = do + let url = endPointUrl apiKey + let tUrl = url ++ "/templates?fields=templates.id,templates.name" + response <- processGET tUrl apiKey + let resBody = decode (responseBody response) :: Maybe Value + let galleryT = resBody ^. key "templates" :: Maybe Array + let templateList = getValues galleryT + return templateList + where getValues ls + | ls /= (Just V.empty) = constructTRes (fmap V.head ls) : getValues (fmap V.tail ls) + | otherwise = [] + constructTRes elem = do let tName = elem ^. key "name" :: Maybe String + let tID = elem ^. key "id" :: Maybe Int + TemplateResponse tName tID + +-- | Taking the @apiKey@ of a Mailchimp account, this function returns all the +-- stored unsent Campaigns. +-- +-- This function returns all the Campaigns in the account. +getCampaigns :: String -> IO [(Maybe String, Maybe String)] +getCampaigns apiKey = do + let url = endPointUrl apiKey + let cUrl = url ++ "/campaigns?fields=campaigns.id,campaigns.settings" + response <- processGET cUrl apiKey + let resBody = decode (responseBody response) :: Maybe Value + let rawcids = resBody ^. key "campaigns" :: Maybe Array + let cids = getValues rawcids + return cids + where getValues ls + | ls /= (Just V.empty) = constructCRes (fmap V.head ls) : getValues (fmap V.tail ls) + | otherwise = [] + constructCRes elem = do let cid = elem ^. key "id" :: Maybe String + let settings = elem ^. key "settings" :: Maybe Value + let name = settings ^. key "subject_line" :: Maybe String + (cid, name) + +-- | Usage of this function to create a new Campaign and save is as follows; +-- +-- @createCampaign@ @apiKey listName replyTo fromName cType title subject -> campaignID@ +-- +-- This function creates a new campaign and save it +createCampaign + :: String + -> String + -> String + -> String + -> String + -> String + -> String + -> IO (Maybe String) +createCampaign apiKey + listName + replyTo + fromName + cType + title + subject = do + let url = endPointUrl apiKey + listid <- getListID apiKey listName + let campaign = Campaign { c_type = cType + , c_settings = Settings { s_subject = subject + , s_title = title + , s_from_name = fromName + , s_reply_to = replyTo } + , c_receipients = (ListID listid) } + let eUrl = url ++ "/campaigns" + response <- processPOST eUrl campaign apiKey + let resBody = decode (responseBody response) :: Maybe Value + let campaignid = resBody ^. key "id" :: Maybe String + return campaignid + +-- | Input parameters for this function are @apiKey@ and the @campaignID@ of the +-- particular Campaign to be sent. +-- +-- This function sends an email campaign +sendEmail + :: String + -> String + -> IO (Either String SendMailResponse) +sendEmail apiKey cid = do + let url = endPointUrl apiKey + let sUrl = url ++ "/campaigns/" ++ cid ++ "/actions/send" + response <- processEmptyPOST sUrl apiKey + let sendRes = eitherDecode (responseBody response) :: Either String SendMailResponse + return sendRes + +-- | Efficiently processes a batch subscription requests for a given list +-- of @emailAddress@ and @subscriptionStatus@ combinations. +-- +-- This function can be re-implemented to perform other batch requests by changing the +-- @body@ and @path@ properties of @Operation@ data structure. +-- +-- This function adds a batch of subscribers +batchSubscribe + :: String + -> String + -> [(String, String)] + -> IO BatchSubscriptionResponse +batchSubscribe apiKey listName subs = do + let url = endPointUrl apiKey + listid <- getListID apiKey listName + let batchSubs = map constructSubs subs + let batchOps = map (constructOps listid) batchSubs + let batchSubscription = Batch { operations = batchOps } + let bUrl = url ++ "/batches" + response <- processPOST bUrl batchSubscription apiKey + let resBody = decode (responseBody response) :: Maybe Value + let batchResponse = BatchSubscriptionResponse (resBody ^. key "id" :: Maybe String) (resBody ^. key "status" :: Maybe String) + return batchResponse + where constructSubs (email, status) = Subscription { s_email = email + , s_email_type = "html" + , s_status = status } + constructOps listid sub = Operation { o_method = "POST" + , o_path = "/lists/" ++ listid ++ "/members" + , o_params = Params { params = [] } + , o_body = B8.unpack $ BL.toStrict $ encode sub } + +------------------------------------------------------------------------------------------------------------------------------------- +-- Get the list_id when the listname is given +getListID :: String -> String -> IO String +getListID apiKey listName = do + mailinglists <- listMailingLists apiKey + let rawlistid = headMay $ filterListID mailinglists + case rawlistid of + Just mlist -> return $ fromJust $ l_id mlist + Nothing -> do putStrLn $ "Error: Invalid list name, " ++ listName + return "" + where filterListID list = filter ((==(Just listName)) . l_name) list + +-- | Build the response from URL and JSON data +processGET :: String -> String -> IO (Response ByteString) +processGET url apiKey = do + let initReq = applyBasicAuth (B8.pack "anystring") (B8.pack apiKey) $ fromJust $ parseUrl url + let req = initReq { method = methodGet } + catch (newManager tlsManagerSettings >>= (httpLbs req)) + (\(StatusCodeException s h c) -> do let ex = (show s ++ "," ++ show h ++ "," ++ show c) + getResponse s h c apiKey + exitWith (ExitFailure 0)) + +processPOST :: ToJSON a => String -> a -> String -> IO (Response ByteString) +processPOST url json apiKey = do + let initReq = applyBasicAuth (B8.pack "anystring") (B8.pack apiKey) $ fromJust $ parseUrl url + let req = initReq { requestBody = RequestBodyLBS $ encode json + , method = methodPost } + manager <- newManager tlsManagerSettings + catch (httpLbs req manager) + (\(StatusCodeException s h c) -> do let ex = (show s ++ "," ++ show h ++ "," ++ show c) + getResponse s h c apiKey) + +processEmptyPOST :: String -> String -> IO (Response ByteString) +processEmptyPOST url apiKey = do + let initReq = applyBasicAuth (B8.pack "anystring") (B8.pack apiKey) $ fromJust $ parseUrl url + let req = initReq { method = methodPost } + manager <- newManager tlsManagerSettings + catch (httpLbs req manager) + (\(StatusCodeException s h c) -> do let ex = (show s ++ "," ++ show h ++ "," ++ show c) + getResponse s h c apiKey) + +processDELETE :: String -> String -> IO (Response ByteString) +processDELETE url apiKey = do + let initReq = applyBasicAuth (B8.pack "anystring") (B8.pack apiKey) $ fromJust $ parseUrl url + let req = initReq { method = methodDelete } + manager <- newManager tlsManagerSettings + catch (httpLbs req manager) + (\(StatusCodeException s h c) -> do let ex = (show s ++ "," ++ show h ++ "," ++ show c) + getResponse s h c apiKey) + +-- | Construct the erroneous HTTP responses when an exception occurs +getResponse :: Status -> ResponseHeaders -> CookieJar -> String -> IO (Response ByteString) +getResponse s h c apiKey = do + let url = endPointUrl apiKey + let initReq = applyBasicAuth (B8.pack "anystring") (B8.pack apiKey) $ fromJust $ parseUrl url + let req = initReq { method = methodGet } + manager <- newManager tlsManagerSettings + response <- httpLbs req manager + let errorRes = response { responseStatus = s + , responseVersion = http11 + , responseBody = "" + , responseHeaders = h + , responseCookieJar = c } + return errorRes + +-- | Construct the end-point URL +endPointUrl :: String -> String +endPointUrl apiKey = "https://" ++ (last (splitString '-' apiKey)) ++ ".api.mailchimp.com/3.0" + +-- | Utility function to split strings +splitString :: Char -> String -> [String] +splitString d [] = [] +splitString d s = x : splitString d (drop 1 y) where (x,y) = span (/= d) s diff --git a/src/Utils/Logger.hs b/src/Utils/Logger.hs new file mode 100644 --- /dev/null +++ b/src/Utils/Logger.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Utils.Logger +-- License: BSD3 +-- Maintainer: Dananji Liyanage +-- Stability: experimental +-- +-- Types and functions for Logging the activities + +module Utils.Logger ( LogLevels(..) + , writeLog ) where + +import Data.Time +import System.FilePath.Posix +import System.Directory ( doesDirectoryExist , createDirectory ) + +-- | Constructor for the Log levels. +data LogLevels = ERROR | DEBUG | INFO deriving (Show, Eq) + +-- | Constructor for the Log entry = (LogEntry LogLevels logging logInputData logMessage) +-- +-- logLevel -> Logging purpose (ERROR/INFO/DEBUG) +-- loggingMethod-> Module of the program which writes the log +-- logInputData -> Input data at the point of logging +-- logMessage -> Output message of the method +data Logger = LogEntry LogLevels String String String deriving (Show, Eq) + +toString :: Logger -> IO String +toString (LogEntry lLevel lMethod lInputData lMessage) = do + utcTime <- getCurrentTime + let myTime = addUTCTime 19800 utcTime + return $ show myTime ++ ", [" ++ show lLevel ++ "], [" ++ lMethod ++ "], Input: " ++ lInputData ++ ", " ++ lMessage + +-- | This function appends a log entry to an external log file. +-- +-- Error logs to 'error.log' file. +-- Other logs to 'access.log' file. +writeLog :: LogLevels -> String -> String -> String -> IO () +writeLog lLevel lMethod lInputData lMessage = do + logEntry <- toString (LogEntry lLevel lMethod lInputData lMessage) + let logEntryProcessed = logEntry ++ "\n" + exists <- doesDirectoryExist "log" + if (exists == True) then return () else (createDirectory "log") + if lLevel == ERROR + then appendFile ("log" ++ [pathSeparator] ++ "error.log") logEntryProcessed + else appendFile ("log" ++ [pathSeparator] ++ "access.log") logEntryProcessed diff --git a/src/Utils/Types.hs b/src/Utils/Types.hs new file mode 100644 --- /dev/null +++ b/src/Utils/Types.hs @@ -0,0 +1,194 @@ +{-# LANGUAGE DeriveGeneric, OverloadedStrings #-} + +-- | +-- Module: Utils.Types +-- License: BSD3 +-- Maintainer: Dananji Liyanage +-- Stability: experimental +-- +-- JSON data structures to work with Mailchimp JSON API Version 3.0 + +module Utils.Types +( + -- ** JSON Requests + -- $requests + Subscription(..) + , EmailId(..) + , Batch(..) + , Operation(..) + , Params(..) + , Campaign(..) + , Settings(..) + , Receipient(..) + -- ** JSON Responses + -- $responses + , ListSubscribersResponse(..) + , MailListResponse(..) + , TemplateResponse(..) + , SendMailResponse(..) + , SubscriptionResponse(..) + , BatchSubscriptionResponse(..) ) where + +import Data.Aeson +import GHC.Generics hiding ( head ) +import Control.Monad ( mzero ) +import Data.Maybe ( catMaybes ) + +-- | JSON structure containing a single subscription. +-- +-- This structure includes the @email_address, email_type,@ and @status@ to be shown in +-- the member's profile. +-- @email_type@ accepts the two values; html / text +data Subscription = + Subscription { s_email :: String + , s_email_type :: String + , s_status :: String + } deriving (Show, Generic) + +instance FromJSON Subscription where +instance ToJSON Subscription where + toJSON (Subscription s_email s_email_type s_status) = object [ "email_address" .= s_email + , "email_type" .= s_email_type + , "status" .= s_status ] + +-- | Constructor to build the EmailId. +data EmailId = Email String -- ^ from email address of the member + | EmailUniqueId String -- ^ from unique ID provided by Mailchimp + | ListEmailId String -- ^ from emailID of the member in the particular list + deriving (Show, Generic) + +instance ToJSON EmailId where + toJSON (Email t) = object ["email" .= t] + toJSON (EmailUniqueId t) = object ["euid" .= t] + toJSON (ListEmailId t) = object ["leid" .= t] + +instance FromJSON EmailId where + parseJSON (Object v) = do + email <- fmap (fmap Email) $ v .:? "email" + euid <- fmap (fmap EmailUniqueId) $ v .:? "euid" + leid <- fmap (fmap ListEmailId) $ v .:? "leid" + case catMaybes [email, euid, leid] of + (x:_) -> return x + _ -> mzero + parseJSON _ = mzero + +-- | JSON structure for Batch oprations. +data Batch = Batch { operations :: [Operation] } deriving (Show) + +instance ToJSON Batch where + toJSON (Batch operations) = object [ "operations" .= operations ] + +-- | JSON structure to contain the Batch operation information. +-- +-- For GET requests, @o_param@ should be given the list of values. +-- For POST requests, @o_body@ should be given the String representation of the +-- encoded JSON data. +data Operation = Operation { o_method :: String + , o_path :: String + , o_params :: Params + , o_body :: String } deriving (Show) + +instance ToJSON Operation where + toJSON (Operation method path params body) = object [ "method" .= method + , "path" .= path + , "params" .= params + , "body" .= body ] + +-- | List of parameters to the URL in HTTP request +data Params = Params { params :: [String] } deriving (Show) + +instance ToJSON Params where + toJSON (Params params) = object [ "params" .= params ] + +-- | JSON structure to construct a Campaign +-- +-- This takes a @campaign_type@, which accepts these possible values; +-- @regular, plaintext, absplit, rss,@ and @variate@. +data Campaign = + Campaign { c_type :: String + , c_settings :: Settings + , c_receipients :: Receipient + } deriving (Show) + +instance ToJSON Campaign where + toJSON (Campaign c_type c_settings c_receipients) = object [ "type" .= c_type + , "settings" .= c_settings + , "recipients" .= c_receipients ] + +-- | Settings for the Campaign creation +-- +-- This includes the basic properties of the Campaign, like +-- subject_line, title, from_name, and reply_to address. +data Settings = + Settings { s_subject :: String + , s_title :: String + , s_from_name :: String + , s_reply_to :: String + } deriving (Show) + +instance ToJSON Settings where + toJSON (Settings s_subject s_title s_from_name s_reply_to) = object [ "subject_line" .= s_subject + , "title" .= s_title + , "from_name" .= s_from_name + , "reply_to" .= s_reply_to ] + +-- | Structure to hold the list of recipients of a Campaign +data Receipient = ListID String deriving (Show) + +instance ToJSON Receipient where + toJSON (ListID r) = object ["list_id" .= r] + +-- | Data structure to hold the HTTP response of the request +-- to list the subscribers in a mailing-list. +data ListSubscribersResponse = + ListSubscribersResponse { ls_name :: Maybe String + , ls_euid :: Maybe String + , ls_list_name :: Maybe String + , ls_emailType :: Maybe String + , ls_status :: Maybe String + } deriving (Show, Generic) + +instance FromJSON ListSubscribersResponse where + +-- | Data structure to hold the HTTP response of the request to +-- list the mailing-lists in the account. +data MailListResponse = + MailListResponse { l_name :: Maybe String + , l_id :: Maybe String + } deriving (Show, Generic) + +instance FromJSON MailListResponse where + +-- | Data structure to hold the Template information. +-- +-- This contains the template name and ID. +data TemplateResponse = + TemplateResponse { t_name :: Maybe String + , t_id :: Maybe Int + } deriving (Show, Generic) + +instance FromJSON TemplateResponse where + +data SendMailResponse = + SendMailResponse { complete :: Bool } deriving (Show, Generic) + +instance FromJSON SendMailResponse where + +-- | Data structure to hold the HTTP response of the +-- subscription request. +data SubscriptionResponse = + SubscriptionResponse { email :: Maybe String + , euid :: Maybe String + , status :: Maybe String + , lname :: Maybe String + } deriving (Show, Generic) + +instance FromJSON SubscriptionResponse where + +-- | Data structure to hold the response of the Batch request +data BatchSubscriptionResponse = + BatchSubscriptionResponse { b_id :: Maybe String + , b_status :: Maybe String + } deriving (Show, Generic) + +instance FromJSON BatchSubscriptionResponse where