{-| This package is an attempt to expose the Mandrill JSON API in pure Haskell.
    To do that, the library API comes in two flavours:

    * An IO-based, low-level 1:1 mapping of the JSON API,
      as described on <https://mandrillapp.com/api/docs/ the website>.
    * A handy monad transformer which can be plugged in your stack of choice.
-}

module Network.API.Mandrill (
    module M
  , sendEmail
  , sendTextEmail
  , emptyMessage
  , newTextMessage
  , newHtmlMessage
  , newTemplateMessage
  , newTemplateMessage'
  , liftIO

  -- * Appendix: Example Usage
  -- $exampleusage
  ) where

import           Control.Monad.Reader
import qualified Data.Aeson                          as JSON
import qualified Data.HashMap.Strict                 as H
import           Data.Monoid
import qualified Data.Text                           as T
import           Data.Time
import           Network.API.Mandrill.Messages       as M
import           Network.API.Mandrill.Messages.Types as M
import           Network.API.Mandrill.Trans          as M
import           Network.API.Mandrill.Types          as M
import           Text.Blaze.Html
import           Text.Email.Validate

{- $exampleusage

The API was designed to allow to get you started as quickly as possible:

> {-# LANGUAGE OverloadedStrings #-}
> import Text.Email.Validate
> import Network.API.Mandrill
>
> main :: IO ()
> main = do
>   case validate "foo@example.com" of
>     Left err   -> print $ "Invalid email!" ++ show err
>     Right addr -> runMandrill "MYTOKENHERE" $ do
>       let msg = "<p>My Html</p>"
>       res <- sendEmail (newTextMessage addr [addr] "Hello" msg)
>       case res of
>         MandrillSuccess k -> liftIO (print k)
>         MandrillFailure f -> liftIO (print f)

-}

--------------------------------------------------------------------------------
-- | Builds an empty message, given only the email of the sender and
-- the emails of the receiver. Please note that the "Subject" will be empty,
-- so you need to use either @newTextMessage@ or @newHtmlMessage@ to populate it.
emptyMessage :: Maybe EmailAddress -> [EmailAddress] -> MandrillMessage
emptyMessage :: Maybe EmailAddress -> [EmailAddress] -> MandrillMessage
emptyMessage Maybe EmailAddress
f [EmailAddress]
t = MandrillMessage :: MandrillHtml
-> Maybe Text
-> Maybe Text
-> Maybe MandrillEmail
-> Maybe Text
-> [MandrillRecipient]
-> MandrillHeaders
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> [MergeVar]
-> [MandrillMergeVars]
-> [Text]
-> Maybe Text
-> [Text]
-> Maybe Text
-> MandrillHeaders
-> [MandrillMetadata]
-> [MandrillWebContent]
-> [MandrillWebContent]
-> MandrillMessage
MandrillMessage {
   _mmsg_html :: MandrillHtml
_mmsg_html = MandrillHtml
forall a. Monoid a => a
mempty
 , _mmsg_text :: Maybe Text
_mmsg_text = Maybe Text
forall a. Maybe a
Nothing
 , _mmsg_subject :: Maybe Text
_mmsg_subject = Maybe Text
forall a. Maybe a
Nothing
 , _mmsg_from_email :: Maybe MandrillEmail
_mmsg_from_email = EmailAddress -> MandrillEmail
MandrillEmail (EmailAddress -> MandrillEmail)
-> Maybe EmailAddress -> Maybe MandrillEmail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe EmailAddress
f
 , _mmsg_from_name :: Maybe Text
_mmsg_from_name = Maybe Text
forall a. Maybe a
Nothing
 , _mmsg_to :: [MandrillRecipient]
_mmsg_to = (EmailAddress -> MandrillRecipient)
-> [EmailAddress] -> [MandrillRecipient]
forall a b. (a -> b) -> [a] -> [b]
map EmailAddress -> MandrillRecipient
newRecipient [EmailAddress]
t
 , _mmsg_headers :: MandrillHeaders
_mmsg_headers = MandrillHeaders
forall k v. HashMap k v
H.empty
 , _mmsg_important :: Maybe Bool
_mmsg_important = Maybe Bool
forall a. Maybe a
Nothing
 , _mmsg_track_opens :: Maybe Bool
_mmsg_track_opens = Maybe Bool
forall a. Maybe a
Nothing
 , _mmsg_track_clicks :: Maybe Bool
_mmsg_track_clicks = Maybe Bool
forall a. Maybe a
Nothing
 , _mmsg_auto_text :: Maybe Bool
_mmsg_auto_text = Maybe Bool
forall a. Maybe a
Nothing
 , _mmsg_auto_html :: Maybe Bool
_mmsg_auto_html = Maybe Bool
forall a. Maybe a
Nothing
 , _mmsg_inline_css :: Maybe Bool
_mmsg_inline_css = Maybe Bool
forall a. Maybe a
Nothing
 , _mmsg_url_strip_qs :: Maybe Bool
_mmsg_url_strip_qs = Maybe Bool
forall a. Maybe a
Nothing
 , _mmsg_preserve_recipients :: Maybe Bool
_mmsg_preserve_recipients = Maybe Bool
forall a. Maybe a
Nothing
 , _mmsg_view_content_link :: Maybe Bool
_mmsg_view_content_link = Maybe Bool
forall a. Maybe a
Nothing
 , _mmsg_bcc_address :: Maybe Text
_mmsg_bcc_address = Maybe Text
forall a. Maybe a
Nothing
 , _mmsg_tracking_domain :: Maybe Text
_mmsg_tracking_domain = Maybe Text
forall a. Maybe a
Nothing
 , _mmsg_signing_domain :: Maybe Bool
_mmsg_signing_domain = Maybe Bool
forall a. Maybe a
Nothing
 , _mmsg_return_path_domain :: Maybe Bool
_mmsg_return_path_domain = Maybe Bool
forall a. Maybe a
Nothing
 , _mmsg_merge :: Maybe Bool
_mmsg_merge = Maybe Bool
forall a. Maybe a
Nothing
 , _mmsg_global_merge_vars :: [MergeVar]
_mmsg_global_merge_vars = []
 , _mmsg_merge_vars :: [MandrillMergeVars]
_mmsg_merge_vars = []
 , _mmsg_tags :: [Text]
_mmsg_tags = []
 , _mmsg_subaccount :: Maybe Text
_mmsg_subaccount = Maybe Text
forall a. Maybe a
Nothing
 , _mmsg_google_analytics_domains :: [Text]
_mmsg_google_analytics_domains = []
 , _mmsg_google_analytics_campaign :: Maybe Text
_mmsg_google_analytics_campaign = Maybe Text
forall a. Maybe a
Nothing
 , _mmsg_metadata :: MandrillHeaders
_mmsg_metadata = MandrillHeaders
forall k v. HashMap k v
H.empty
 , _mmsg_recipient_metadata :: [MandrillMetadata]
_mmsg_recipient_metadata = []
 , _mmsg_attachments :: [MandrillWebContent]
_mmsg_attachments = []
 , _mmsg_images :: [MandrillWebContent]
_mmsg_images = []
  }


--------------------------------------------------------------------------------
-- | Create a new HTML message.
newHtmlMessage :: EmailAddress
               -- ^ Sender email
               -> [EmailAddress]
               -- ^ Receivers email
               -> T.Text
               -- ^ Subject
               -> Html
               -- ^ The HTML body
               -> MandrillMessage
newHtmlMessage :: EmailAddress -> [EmailAddress] -> Text -> Html -> MandrillMessage
newHtmlMessage EmailAddress
f [EmailAddress]
t Text
subj Html
html = let body :: MandrillHtml
body = Html -> MandrillHtml
mkMandrillHtml Html
html in
  (Maybe EmailAddress -> [EmailAddress] -> MandrillMessage
emptyMessage (EmailAddress -> Maybe EmailAddress
forall a. a -> Maybe a
Just EmailAddress
f) [EmailAddress]
t) { _mmsg_html :: MandrillHtml
_mmsg_html = MandrillHtml
body, _mmsg_subject :: Maybe Text
_mmsg_subject = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
subj }

--------------------------------------------------------------------------------
-- | Create a new template message (no HTML).
newTemplateMessage :: EmailAddress
                   -- ^ Sender email
                   -> [EmailAddress]
                   -- ^ Receivers email
                   -> T.Text
                   -- ^ Subject
                   -> MandrillMessage
newTemplateMessage :: EmailAddress -> [EmailAddress] -> Text -> MandrillMessage
newTemplateMessage EmailAddress
f [EmailAddress]
t Text
subj = (Maybe EmailAddress -> [EmailAddress] -> MandrillMessage
emptyMessage (EmailAddress -> Maybe EmailAddress
forall a. a -> Maybe a
Just EmailAddress
f) [EmailAddress]
t) { _mmsg_subject :: Maybe Text
_mmsg_subject = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
subj }

--------------------------------------------------------------------------------
-- | Create a new template message (no HTML) with recipient addresses only.
-- This function is preferred when the template being used has the sender 
-- address and subject already configured in the Mandrill server.
newTemplateMessage' :: [EmailAddress]
                    -- ^ Receivers email
                    -> MandrillMessage
newTemplateMessage' :: [EmailAddress] -> MandrillMessage
newTemplateMessage' = Maybe EmailAddress -> [EmailAddress] -> MandrillMessage
emptyMessage Maybe EmailAddress
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- | Create a new textual message. By default Mandrill doesn't require you
-- to specify the @mmsg_text@ when sending out the JSON Payload, and this
-- function ensure it will be present.
newTextMessage :: EmailAddress
               -- ^ Sender email
               -> [EmailAddress]
               -- ^ Receivers email
               -> T.Text
               -- ^ Subject
               -> T.Text
               -- ^ The body, as normal text.
               -> MandrillMessage
newTextMessage :: EmailAddress -> [EmailAddress] -> Text -> Text -> MandrillMessage
newTextMessage EmailAddress
f [EmailAddress]
t Text
subj Text
txt = let body :: MandrillHtml
body = Text -> MandrillHtml
unsafeMkMandrillHtml Text
txt in
  (Maybe EmailAddress -> [EmailAddress] -> MandrillMessage
emptyMessage (EmailAddress -> Maybe EmailAddress
forall a. a -> Maybe a
Just EmailAddress
f) [EmailAddress]
t) {
       _mmsg_html :: MandrillHtml
_mmsg_html = MandrillHtml
body
     , _mmsg_text :: Maybe Text
_mmsg_text = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
txt
     , _mmsg_subject :: Maybe Text
_mmsg_subject = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
subj
     }


--------------------------------------------------------------------------------
-- | The simplest way to use the API. All you need to provide is a valid
-- 'MandrillMessage' and this function will send an email inside a
-- 'MandrillT' transformer. You are not forced to use the 'MandrillT' context
-- though. Have a look at "Network.API.Mandrill.Messages" for an IO-based,
-- low level function for sending email.
sendEmail :: MonadIO m
          => MandrillMessage
          -> MandrillT m (MandrillResponse [MessagesResponse])
sendEmail :: MandrillMessage
-> MandrillT m (MandrillResponse [MessagesResponse])
sendEmail MandrillMessage
msg = do
  (Text
key, Manager
mgr) <- MandrillT m (Text, Manager)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO (MandrillResponse [MessagesResponse])
-> MandrillT m (MandrillResponse [MessagesResponse])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MandrillResponse [MessagesResponse])
 -> MandrillT m (MandrillResponse [MessagesResponse]))
-> IO (MandrillResponse [MessagesResponse])
-> MandrillT m (MandrillResponse [MessagesResponse])
forall a b. (a -> b) -> a -> b
$ Text
-> MandrillMessage
-> Maybe Bool
-> Maybe Text
-> Maybe UTCTime
-> Maybe Manager
-> IO (MandrillResponse [MessagesResponse])
send Text
key MandrillMessage
msg (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) Maybe Text
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing (Manager -> Maybe Manager
forall a. a -> Maybe a
Just Manager
mgr)


--------------------------------------------------------------------------------
sendTextEmail :: MonadIO m
              => MandrillMessage
              -> MandrillT m (MandrillResponse [MessagesResponse])
sendTextEmail :: MandrillMessage
-> MandrillT m (MandrillResponse [MessagesResponse])
sendTextEmail MandrillMessage
msg = do
  (Text
key, Manager
mgr) <- MandrillT m (Text, Manager)
forall r (m :: * -> *). MonadReader r m => m r
ask
  UTCTime
now <- IO UTCTime -> MandrillT m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  IO (MandrillResponse [MessagesResponse])
-> MandrillT m (MandrillResponse [MessagesResponse])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MandrillResponse [MessagesResponse])
 -> MandrillT m (MandrillResponse [MessagesResponse]))
-> IO (MandrillResponse [MessagesResponse])
-> MandrillT m (MandrillResponse [MessagesResponse])
forall a b. (a -> b) -> a -> b
$ Text
-> MandrillMessage
-> Maybe Bool
-> Maybe Text
-> Maybe UTCTime
-> Maybe Manager
-> IO (MandrillResponse [MessagesResponse])
send Text
key MandrillMessage
msg (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) Maybe Text
forall a. Maybe a
Nothing (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
now) (Manager -> Maybe Manager
forall a. a -> Maybe a
Just Manager
mgr)