{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

-- | Module that implements the Mail API of SendGrid v3.
--   https://sendgrid.com/docs/API_Reference/api_v3.html
--
-- >
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > import Data.List.NonEmpty (fromList)
-- > import Network.SendGridV3.Api
-- > import Control.Lens ((^.))
-- > import Network.Wreq (responseStatus, statusCode)
-- >
-- > sendGridApiKey :: ApiKey
-- > sendGridApiKey = ApiKey "SG..."
-- >
-- > testMail :: Mail () ()
-- > testMail =
-- >   let to = personalization $ fromList [MailAddress "john@example.com" "John Doe"]
-- >       from = MailAddress "jane@example.com" "Jane Smith"
-- >       subject = "Email Subject"
-- >       content = fromList [mailContentText "Example Content"]
-- >   in mail [to] from subject content
-- >
-- > main :: IO ()
-- > main = do
-- >   -- Send an email, overriding options as needed
-- >   eResponse <- sendMail sendGridApiKey (testMail { _mailSendAt = Just 1516468000 })
-- >   case eResponse of
-- >     Left httpException -> error $ show httpException
-- >     Right response -> print (response ^. responseStatus . statusCode)
--
module Network.SendGridV3.Api where

import           Control.Exception                        ( try )
import           Control.Lens                      hiding ( from
                                                          , to
                                                          , (.=)
                                                          )
import           Data.Aeson
import           Data.Aeson.TH
import           Data.ByteString.Lazy                     ( ByteString )
import           Data.Char                                ( toLower )
import           Data.List.NonEmpty                       ( NonEmpty )
import           Data.Semigroup                           ( (<>) )
import qualified Data.Text                     as T
import           Data.Text.Encoding
import           Network.HTTP.Client                      ( HttpException )
import           Network.SendGridV3.JSON                  ( unPrefix )
import           Network.Wreq                      hiding ( Options )

-- | URL to SendGrid Mail API
sendGridAPI :: T.Text
sendGridAPI :: Text
sendGridAPI = Text
"https://api.sendgrid.com/v3/mail/send"

-- | Bearer Token for the API
data ApiKey = ApiKey { ApiKey -> Text
_apiKey :: T.Text } deriving (Int -> ApiKey -> ShowS
[ApiKey] -> ShowS
ApiKey -> String
(Int -> ApiKey -> ShowS)
-> (ApiKey -> String) -> ([ApiKey] -> ShowS) -> Show ApiKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiKey] -> ShowS
$cshowList :: [ApiKey] -> ShowS
show :: ApiKey -> String
$cshow :: ApiKey -> String
showsPrec :: Int -> ApiKey -> ShowS
$cshowsPrec :: Int -> ApiKey -> ShowS
Show, ApiKey -> ApiKey -> Bool
(ApiKey -> ApiKey -> Bool)
-> (ApiKey -> ApiKey -> Bool) -> Eq ApiKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiKey -> ApiKey -> Bool
$c/= :: ApiKey -> ApiKey -> Bool
== :: ApiKey -> ApiKey -> Bool
$c== :: ApiKey -> ApiKey -> Bool
Eq)

data MailAddress = MailAddress
  { -- | EmailAddress e.g. john@doe.com
    MailAddress -> Text
_mailAddressEmail :: T.Text
    -- | The name of the person to whom you are sending an email. E.g. "John Doe"
  , MailAddress -> Text
_mailAddressName  :: T.Text
  } deriving (Int -> MailAddress -> ShowS
[MailAddress] -> ShowS
MailAddress -> String
(Int -> MailAddress -> ShowS)
-> (MailAddress -> String)
-> ([MailAddress] -> ShowS)
-> Show MailAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MailAddress] -> ShowS
$cshowList :: [MailAddress] -> ShowS
show :: MailAddress -> String
$cshow :: MailAddress -> String
showsPrec :: Int -> MailAddress -> ShowS
$cshowsPrec :: Int -> MailAddress -> ShowS
Show, MailAddress -> MailAddress -> Bool
(MailAddress -> MailAddress -> Bool)
-> (MailAddress -> MailAddress -> Bool) -> Eq MailAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MailAddress -> MailAddress -> Bool
$c/= :: MailAddress -> MailAddress -> Bool
== :: MailAddress -> MailAddress -> Bool
$c== :: MailAddress -> MailAddress -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_mailAddress"
              , constructorTagModifier = map toLower }) ''MailAddress)

data MailContent = MailContent
  { -- | The mime type of the content you are including in your email. For example, “text/plain” or “text/html”.
    MailContent -> Text
_mailContentType  :: T.Text
    -- | The actual content of the specified mime type that you are including in your email.
  , MailContent -> Text
_mailContentValue :: T.Text
  } deriving (Int -> MailContent -> ShowS
[MailContent] -> ShowS
MailContent -> String
(Int -> MailContent -> ShowS)
-> (MailContent -> String)
-> ([MailContent] -> ShowS)
-> Show MailContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MailContent] -> ShowS
$cshowList :: [MailContent] -> ShowS
show :: MailContent -> String
$cshow :: MailContent -> String
showsPrec :: Int -> MailContent -> ShowS
$cshowsPrec :: Int -> MailContent -> ShowS
Show, MailContent -> MailContent -> Bool
(MailContent -> MailContent -> Bool)
-> (MailContent -> MailContent -> Bool) -> Eq MailContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MailContent -> MailContent -> Bool
$c/= :: MailContent -> MailContent -> Bool
== :: MailContent -> MailContent -> Bool
$c== :: MailContent -> MailContent -> Bool
Eq)

-- | M̀ailContent constructor for text/plain
mailContentText :: T.Text -> MailContent
mailContentText :: Text -> MailContent
mailContentText Text
txt = Text -> Text -> MailContent
MailContent Text
"text/plain" Text
txt

-- | M̀ailContent constructor for text/html
mailContentHtml :: T.Text -> MailContent
mailContentHtml :: Text -> MailContent
mailContentHtml Text
html = Text -> Text -> MailContent
MailContent Text
"text/html" Text
html

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_mailContent"
              , omitNothingFields = True
              , constructorTagModifier = map toLower }) ''MailContent)

-- | An array of messages and their metadata. Each object within personalizations can be thought of as an envelope
--   - it defines who should receive an individual message and how that message should be handled.
data Personalization = Personalization
  { -- | An array of recipients. Each object within this array may contain the name, but must
    --   always contain the email, of a recipient. Each object within personalizations can be thought of as an envelope
    --   - it defines who should receive an individual message and how that message should be handled.
    Personalization -> NonEmpty MailAddress
_personalizationTo                  :: NonEmpty MailAddress
    -- | An array of recipients who will receive a copy of your email.
  , Personalization -> Maybe [MailAddress]
_personalizationCc                  :: Maybe [MailAddress]
  -- | An array of recipients who will receive a blind carbon copy of your email. Each object within this array may
  --   contain the name, but must always contain the email, of a recipient.
  , Personalization -> Maybe [MailAddress]
_personalizationBcc                 :: Maybe [MailAddress]
  -- | The subject of your email.
  , Personalization -> Maybe Text
_personalizationSubject             :: Maybe T.Text
  -- | A collection of JSON key/value pairs allowing you to specify specific handling instructions for your email.
  , Personalization -> Maybe [(Text, Text)]
_personalizationHeaders             :: Maybe [(T.Text, T.Text)]
  -- | A collection of key/value pairs following the pattern "substitution_tag":"value to substitute".
  , Personalization -> Maybe Object
_personalizationSubstitutions       :: Maybe Object
  -- | A unix timestamp allowing you to specify when you want your email to be delivered.
  --   Scheduling more than 72 hours in advance is forbidden.
  , Personalization -> Maybe Int
_personalizationSendAt              :: Maybe Int
  -- | A JSON object to include as dynamic template data.
  , Personalization -> Maybe Value
_personalizationDynamicTemplateData :: Maybe Value
  } deriving (Int -> Personalization -> ShowS
[Personalization] -> ShowS
Personalization -> String
(Int -> Personalization -> ShowS)
-> (Personalization -> String)
-> ([Personalization] -> ShowS)
-> Show Personalization
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Personalization] -> ShowS
$cshowList :: [Personalization] -> ShowS
show :: Personalization -> String
$cshow :: Personalization -> String
showsPrec :: Int -> Personalization -> ShowS
$cshowsPrec :: Int -> Personalization -> ShowS
Show, Personalization -> Personalization -> Bool
(Personalization -> Personalization -> Bool)
-> (Personalization -> Personalization -> Bool)
-> Eq Personalization
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Personalization -> Personalization -> Bool
$c/= :: Personalization -> Personalization -> Bool
== :: Personalization -> Personalization -> Bool
$c== :: Personalization -> Personalization -> Bool
Eq)

-- | Personalization smart constructor only asking for the mandatory fields
personalization :: NonEmpty MailAddress -> Personalization
personalization :: NonEmpty MailAddress -> Personalization
personalization NonEmpty MailAddress
to = Personalization :: NonEmpty MailAddress
-> Maybe [MailAddress]
-> Maybe [MailAddress]
-> Maybe Text
-> Maybe [(Text, Text)]
-> Maybe Object
-> Maybe Int
-> Maybe Value
-> Personalization
Personalization
  { _personalizationTo :: NonEmpty MailAddress
_personalizationTo                  = NonEmpty MailAddress
to
  , _personalizationCc :: Maybe [MailAddress]
_personalizationCc                  = Maybe [MailAddress]
forall a. Maybe a
Nothing
  , _personalizationBcc :: Maybe [MailAddress]
_personalizationBcc                 = Maybe [MailAddress]
forall a. Maybe a
Nothing
  , _personalizationSubject :: Maybe Text
_personalizationSubject             = Maybe Text
forall a. Maybe a
Nothing
  , _personalizationHeaders :: Maybe [(Text, Text)]
_personalizationHeaders             = Maybe [(Text, Text)]
forall a. Maybe a
Nothing
  , _personalizationSubstitutions :: Maybe Object
_personalizationSubstitutions       = Maybe Object
forall a. Maybe a
Nothing
  , _personalizationSendAt :: Maybe Int
_personalizationSendAt              = Maybe Int
forall a. Maybe a
Nothing
  , _personalizationDynamicTemplateData :: Maybe Value
_personalizationDynamicTemplateData = Maybe Value
forall a. Maybe a
Nothing
  }

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_personalization"
              , omitNothingFields = True
              , constructorTagModifier = map toLower }) ''Personalization)

-- | The content-disposition of the attachment specifying how you would like the attachment to be displayed.
data Disposition =
  -- | Results in the attached file being displayed automatically within the message.
    Inline
  -- | Results in the attached file requiring some action to be taken before it is
  --   displayed (e.g. opening or downloading the file).
  | Attachment
  deriving (Int -> Disposition -> ShowS
[Disposition] -> ShowS
Disposition -> String
(Int -> Disposition -> ShowS)
-> (Disposition -> String)
-> ([Disposition] -> ShowS)
-> Show Disposition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Disposition] -> ShowS
$cshowList :: [Disposition] -> ShowS
show :: Disposition -> String
$cshow :: Disposition -> String
showsPrec :: Int -> Disposition -> ShowS
$cshowsPrec :: Int -> Disposition -> ShowS
Show, Disposition -> Disposition -> Bool
(Disposition -> Disposition -> Bool)
-> (Disposition -> Disposition -> Bool) -> Eq Disposition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Disposition -> Disposition -> Bool
$c/= :: Disposition -> Disposition -> Bool
== :: Disposition -> Disposition -> Bool
$c== :: Disposition -> Disposition -> Bool
Eq)

instance ToJSON Disposition where
  toJSON :: Disposition -> Value
toJSON Disposition
Inline     = Value
"inline"
  toJSON Disposition
Attachment = Value
"attachment"

data MailAttachment = MailAttachment
  { -- | The Base64 encoded content of the attachment.
    MailAttachment -> Text
_mailAttachmentContent     :: T.Text
    -- | The mime type of the content you are attaching. For example, “text/plain” or “text/html”.
  , MailAttachment -> Maybe Text
_mailAttachmentType        :: Maybe T.Text
    -- | The filename of the attachment.
  , MailAttachment -> Text
_mailAttachmentFilename    :: T.Text
  -- | The content-disposition of the attachment specifying how you would like the attachment to be displayed.
  , MailAttachment -> Maybe Disposition
_mailAttachmentDisposition :: Maybe Disposition
  -- | The content id for the attachment. This is used when the disposition is set to “inline”
  --   and the attachment is an image, allowing the file to be displayed within the body of your email.
  , MailAttachment -> Text
_mailAttachmentContentId   :: T.Text
  } deriving (Int -> MailAttachment -> ShowS
[MailAttachment] -> ShowS
MailAttachment -> String
(Int -> MailAttachment -> ShowS)
-> (MailAttachment -> String)
-> ([MailAttachment] -> ShowS)
-> Show MailAttachment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MailAttachment] -> ShowS
$cshowList :: [MailAttachment] -> ShowS
show :: MailAttachment -> String
$cshow :: MailAttachment -> String
showsPrec :: Int -> MailAttachment -> ShowS
$cshowsPrec :: Int -> MailAttachment -> ShowS
Show, MailAttachment -> MailAttachment -> Bool
(MailAttachment -> MailAttachment -> Bool)
-> (MailAttachment -> MailAttachment -> Bool) -> Eq MailAttachment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MailAttachment -> MailAttachment -> Bool
$c/= :: MailAttachment -> MailAttachment -> Bool
== :: MailAttachment -> MailAttachment -> Bool
$c== :: MailAttachment -> MailAttachment -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_mailAttachment"
              , omitNothingFields = True
              , constructorTagModifier = map toLower }) ''MailAttachment)

-- | An object allowing you to specify how to handle unsubscribes.
data Asm = Asm
  { -- | The unsubscribe group to associate with this email.
    Asm -> Int
_asmGroupId         :: Int
    -- | An array containing the unsubscribe groups that you would like to
    --   be displayed on the unsubscribe preferences page.
  , Asm -> Maybe [Int]
_asmGroupsToDisplay :: Maybe [Int]
  } deriving (Int -> Asm -> ShowS
[Asm] -> ShowS
Asm -> String
(Int -> Asm -> ShowS)
-> (Asm -> String) -> ([Asm] -> ShowS) -> Show Asm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Asm] -> ShowS
$cshowList :: [Asm] -> ShowS
show :: Asm -> String
$cshow :: Asm -> String
showsPrec :: Int -> Asm -> ShowS
$cshowsPrec :: Int -> Asm -> ShowS
Show, Asm -> Asm -> Bool
(Asm -> Asm -> Bool) -> (Asm -> Asm -> Bool) -> Eq Asm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Asm -> Asm -> Bool
$c/= :: Asm -> Asm -> Bool
== :: Asm -> Asm -> Bool
$c== :: Asm -> Asm -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_asm"
              , omitNothingFields = True
              , constructorTagModifier = map toLower }) ''Asm)

-- | This allows you to have a blind carbon copy automatically sent to the specified
--   email address for every email that is sent.
data Bcc = Bcc
  { -- | Indicates if this setting is enabled.
    Bcc -> Maybe Bool
_bccEnable :: Maybe Bool
    -- | The email address that you would like to receive the BCC.
  , Bcc -> Maybe Text
_bccEmail  :: Maybe T.Text
  } deriving (Int -> Bcc -> ShowS
[Bcc] -> ShowS
Bcc -> String
(Int -> Bcc -> ShowS)
-> (Bcc -> String) -> ([Bcc] -> ShowS) -> Show Bcc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bcc] -> ShowS
$cshowList :: [Bcc] -> ShowS
show :: Bcc -> String
$cshow :: Bcc -> String
showsPrec :: Int -> Bcc -> ShowS
$cshowsPrec :: Int -> Bcc -> ShowS
Show, Bcc -> Bcc -> Bool
(Bcc -> Bcc -> Bool) -> (Bcc -> Bcc -> Bool) -> Eq Bcc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bcc -> Bcc -> Bool
$c/= :: Bcc -> Bcc -> Bool
== :: Bcc -> Bcc -> Bool
$c== :: Bcc -> Bcc -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_bcc"
              , omitNothingFields = True
              , constructorTagModifier = map toLower }) ''Bcc)

-- | Allows you to bypass all unsubscribe groups and suppressions to ensure that the
--   email is delivered to every single recipient. This should only be used in emergencies
--   when it is absolutely necessary that every recipient receives your email.
data BypassListManagement = BypassListManagement
  { -- | Indicates if this setting is enabled.
    BypassListManagement -> Bool
_bypassListManagementEnable :: Bool
  } deriving (Int -> BypassListManagement -> ShowS
[BypassListManagement] -> ShowS
BypassListManagement -> String
(Int -> BypassListManagement -> ShowS)
-> (BypassListManagement -> String)
-> ([BypassListManagement] -> ShowS)
-> Show BypassListManagement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BypassListManagement] -> ShowS
$cshowList :: [BypassListManagement] -> ShowS
show :: BypassListManagement -> String
$cshow :: BypassListManagement -> String
showsPrec :: Int -> BypassListManagement -> ShowS
$cshowsPrec :: Int -> BypassListManagement -> ShowS
Show, BypassListManagement -> BypassListManagement -> Bool
(BypassListManagement -> BypassListManagement -> Bool)
-> (BypassListManagement -> BypassListManagement -> Bool)
-> Eq BypassListManagement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BypassListManagement -> BypassListManagement -> Bool
$c/= :: BypassListManagement -> BypassListManagement -> Bool
== :: BypassListManagement -> BypassListManagement -> Bool
$c== :: BypassListManagement -> BypassListManagement -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_bypassListManagement"
              , constructorTagModifier = map toLower }) ''BypassListManagement)

-- | The default footer that you would like included on every email.
data Footer = Footer
  { -- | Indicates if this setting is enabled.
    Footer -> Maybe Bool
_footerEnable :: Maybe Bool
  -- | The plain text content of your footer.
  , Footer -> Maybe Text
_footerText   :: Maybe T.Text
  -- | The HTML content of your footer.
  , Footer -> Maybe Text
_footerHtml   :: Maybe T.Text
  } deriving (Int -> Footer -> ShowS
[Footer] -> ShowS
Footer -> String
(Int -> Footer -> ShowS)
-> (Footer -> String) -> ([Footer] -> ShowS) -> Show Footer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Footer] -> ShowS
$cshowList :: [Footer] -> ShowS
show :: Footer -> String
$cshow :: Footer -> String
showsPrec :: Int -> Footer -> ShowS
$cshowsPrec :: Int -> Footer -> ShowS
Show, Footer -> Footer -> Bool
(Footer -> Footer -> Bool)
-> (Footer -> Footer -> Bool) -> Eq Footer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Footer -> Footer -> Bool
$c/= :: Footer -> Footer -> Bool
== :: Footer -> Footer -> Bool
$c== :: Footer -> Footer -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_footer"
              , omitNothingFields = True
              , constructorTagModifier = map toLower }) ''Footer)

-- | This allows you to send a test email to ensure that your request body is valid and formatted correctly.
data SandboxMode = SandboxMode
  { -- | Indicates if this setting is enabled.
    SandboxMode -> Bool
_sandboxModeEnable :: Bool
  } deriving (Int -> SandboxMode -> ShowS
[SandboxMode] -> ShowS
SandboxMode -> String
(Int -> SandboxMode -> ShowS)
-> (SandboxMode -> String)
-> ([SandboxMode] -> ShowS)
-> Show SandboxMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SandboxMode] -> ShowS
$cshowList :: [SandboxMode] -> ShowS
show :: SandboxMode -> String
$cshow :: SandboxMode -> String
showsPrec :: Int -> SandboxMode -> ShowS
$cshowsPrec :: Int -> SandboxMode -> ShowS
Show, SandboxMode -> SandboxMode -> Bool
(SandboxMode -> SandboxMode -> Bool)
-> (SandboxMode -> SandboxMode -> Bool) -> Eq SandboxMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SandboxMode -> SandboxMode -> Bool
$c/= :: SandboxMode -> SandboxMode -> Bool
== :: SandboxMode -> SandboxMode -> Bool
$c== :: SandboxMode -> SandboxMode -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_sandboxMode"
              , constructorTagModifier = map toLower }) ''SandboxMode)

-- | This allows you to test the content of your email for spam.
data SpamCheck = SpamCheck
  { -- | Indicates if this setting is enabled.
    SpamCheck -> Maybe Bool
_spamCheckEnable    :: Maybe Bool
  -- | The threshold used to determine if your content qualifies as spam on a scale from 1 to 10,
  --   with 10 being most strict, or most likely to be considered as spam.
  , SpamCheck -> Maybe Int
_spamCheckThreshold :: Maybe Int
  -- | An Inbound Parse URL that you would like a copy of your email along with the spam report to be sent to.
  , SpamCheck -> Maybe Text
_spamCheckPostToUrl :: Maybe T.Text
  } deriving (Int -> SpamCheck -> ShowS
[SpamCheck] -> ShowS
SpamCheck -> String
(Int -> SpamCheck -> ShowS)
-> (SpamCheck -> String)
-> ([SpamCheck] -> ShowS)
-> Show SpamCheck
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpamCheck] -> ShowS
$cshowList :: [SpamCheck] -> ShowS
show :: SpamCheck -> String
$cshow :: SpamCheck -> String
showsPrec :: Int -> SpamCheck -> ShowS
$cshowsPrec :: Int -> SpamCheck -> ShowS
Show, SpamCheck -> SpamCheck -> Bool
(SpamCheck -> SpamCheck -> Bool)
-> (SpamCheck -> SpamCheck -> Bool) -> Eq SpamCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpamCheck -> SpamCheck -> Bool
$c/= :: SpamCheck -> SpamCheck -> Bool
== :: SpamCheck -> SpamCheck -> Bool
$c== :: SpamCheck -> SpamCheck -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_spamCheck"
              , omitNothingFields = True
              , constructorTagModifier = map toLower }) ''SpamCheck)

-- | Allows you to track whether a recipient clicked a link in your email.
data ClickTracking = ClickTracking
  { -- | Indicates if this setting is enabled.
    ClickTracking -> Maybe Bool
_clickTrackingEnable     :: Maybe Bool
    -- | Indicates if this setting should be included in the text/plain portion of your email.
  , ClickTracking -> Maybe Bool
_clickTrackingEnableText :: Maybe Bool
  } deriving (Int -> ClickTracking -> ShowS
[ClickTracking] -> ShowS
ClickTracking -> String
(Int -> ClickTracking -> ShowS)
-> (ClickTracking -> String)
-> ([ClickTracking] -> ShowS)
-> Show ClickTracking
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClickTracking] -> ShowS
$cshowList :: [ClickTracking] -> ShowS
show :: ClickTracking -> String
$cshow :: ClickTracking -> String
showsPrec :: Int -> ClickTracking -> ShowS
$cshowsPrec :: Int -> ClickTracking -> ShowS
Show, ClickTracking -> ClickTracking -> Bool
(ClickTracking -> ClickTracking -> Bool)
-> (ClickTracking -> ClickTracking -> Bool) -> Eq ClickTracking
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClickTracking -> ClickTracking -> Bool
$c/= :: ClickTracking -> ClickTracking -> Bool
== :: ClickTracking -> ClickTracking -> Bool
$c== :: ClickTracking -> ClickTracking -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_clickTracking"
              , omitNothingFields = True
              , constructorTagModifier = map toLower }) ''ClickTracking)


-- | Allows you to track whether the email was opened or not.
data OpenTracking = OpenTracking
  { -- | Indicates if this setting is enabled.
    OpenTracking -> Maybe Bool
_openTrackingEnable          :: Maybe Bool
    -- | Allows you to specify a substitution tag that you can insert in the body of your email.
  , OpenTracking -> Maybe Text
_openTrackingSubstitutionTag :: Maybe T.Text
  } deriving (Int -> OpenTracking -> ShowS
[OpenTracking] -> ShowS
OpenTracking -> String
(Int -> OpenTracking -> ShowS)
-> (OpenTracking -> String)
-> ([OpenTracking] -> ShowS)
-> Show OpenTracking
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenTracking] -> ShowS
$cshowList :: [OpenTracking] -> ShowS
show :: OpenTracking -> String
$cshow :: OpenTracking -> String
showsPrec :: Int -> OpenTracking -> ShowS
$cshowsPrec :: Int -> OpenTracking -> ShowS
Show, OpenTracking -> OpenTracking -> Bool
(OpenTracking -> OpenTracking -> Bool)
-> (OpenTracking -> OpenTracking -> Bool) -> Eq OpenTracking
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenTracking -> OpenTracking -> Bool
$c/= :: OpenTracking -> OpenTracking -> Bool
== :: OpenTracking -> OpenTracking -> Bool
$c== :: OpenTracking -> OpenTracking -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_openTracking"
              , omitNothingFields = True
              , constructorTagModifier = map toLower }) ''OpenTracking)

-- | Allows you to insert a subscription management link.
data SubscriptionTracking = SubscriptionTracking
  { -- | Indicates if this setting is enabled.
    SubscriptionTracking -> Maybe Bool
_subscriptionTrackingEnable          :: Maybe Bool
  -- | Text to be appended to the email, with the subscription tracking link.
  , SubscriptionTracking -> Maybe Text
_subscriptionTrackingText            :: Maybe T.Text
  -- | HTML to be appended to the email, with the subscription tracking link.
  , SubscriptionTracking -> Maybe Text
_subscriptionTrackingHTML            :: Maybe T.Text
  -- | A tag that will be replaced with the unsubscribe URL.
  , SubscriptionTracking -> Maybe Text
_subscriptionTrackingSubstitutionTag :: Maybe T.Text
  } deriving (Int -> SubscriptionTracking -> ShowS
[SubscriptionTracking] -> ShowS
SubscriptionTracking -> String
(Int -> SubscriptionTracking -> ShowS)
-> (SubscriptionTracking -> String)
-> ([SubscriptionTracking] -> ShowS)
-> Show SubscriptionTracking
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubscriptionTracking] -> ShowS
$cshowList :: [SubscriptionTracking] -> ShowS
show :: SubscriptionTracking -> String
$cshow :: SubscriptionTracking -> String
showsPrec :: Int -> SubscriptionTracking -> ShowS
$cshowsPrec :: Int -> SubscriptionTracking -> ShowS
Show, SubscriptionTracking -> SubscriptionTracking -> Bool
(SubscriptionTracking -> SubscriptionTracking -> Bool)
-> (SubscriptionTracking -> SubscriptionTracking -> Bool)
-> Eq SubscriptionTracking
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubscriptionTracking -> SubscriptionTracking -> Bool
$c/= :: SubscriptionTracking -> SubscriptionTracking -> Bool
== :: SubscriptionTracking -> SubscriptionTracking -> Bool
$c== :: SubscriptionTracking -> SubscriptionTracking -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_subscriptionTracking"
              , omitNothingFields = True
              , constructorTagModifier = map toLower }) ''SubscriptionTracking)

-- | Allows you to enable tracking provided by Google Analytics
data Ganalytics = Ganalytics
  {  -- | Indicates if this setting is enabled.
    Ganalytics -> Maybe Bool
_ganalyticsEnable      :: Maybe Bool
  -- | Name of the referrer source. (e.g. Google, SomeDomain.com, or Marketing Email)
  , Ganalytics -> Maybe Text
_ganalyticsUTMSource   :: Maybe T.Text
  -- | Name of the marketing medium. (e.g. Email)
  , Ganalytics -> Maybe Text
_ganalyticsUTMMedium   :: Maybe T.Text
  -- | Used to identify any paid keywords.
  , Ganalytics -> Maybe Text
_ganalyticsUTMTerm     :: Maybe T.Text
  -- | Used to differentiate your campaign from advertisements.
  , Ganalytics -> Maybe Text
_ganalyticsUTMContent  :: Maybe T.Text
  -- | The name of the campaign.
  , Ganalytics -> Maybe Text
_ganalyticsUTMCampaign :: Maybe T.Text
  } deriving (Int -> Ganalytics -> ShowS
[Ganalytics] -> ShowS
Ganalytics -> String
(Int -> Ganalytics -> ShowS)
-> (Ganalytics -> String)
-> ([Ganalytics] -> ShowS)
-> Show Ganalytics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ganalytics] -> ShowS
$cshowList :: [Ganalytics] -> ShowS
show :: Ganalytics -> String
$cshow :: Ganalytics -> String
showsPrec :: Int -> Ganalytics -> ShowS
$cshowsPrec :: Int -> Ganalytics -> ShowS
Show, Ganalytics -> Ganalytics -> Bool
(Ganalytics -> Ganalytics -> Bool)
-> (Ganalytics -> Ganalytics -> Bool) -> Eq Ganalytics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ganalytics -> Ganalytics -> Bool
$c/= :: Ganalytics -> Ganalytics -> Bool
== :: Ganalytics -> Ganalytics -> Bool
$c== :: Ganalytics -> Ganalytics -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_ganalytics"
              , omitNothingFields = True
              , constructorTagModifier = map toLower }) ''Ganalytics)

data TrackingSettings = TrackingSettings
  { -- | Allows you to track whether a recipient clicked a link in your email.
    TrackingSettings -> ClickTracking
_trackingSettingsClickTracking        :: ClickTracking
  -- | Allows you to track whether the email was opened or not.
  , TrackingSettings -> OpenTracking
_trackingSettingsOpenTracking         :: OpenTracking
  -- | Allows you to insert a subscription management link
  , TrackingSettings -> SubscriptionTracking
_trackingSettingsSubscriptionTracking :: SubscriptionTracking
  -- | Allows you to enable tracking provided by Google Analytics.
  , TrackingSettings -> Ganalytics
_trackingSettingsGanalytics           :: Ganalytics
  } deriving (Int -> TrackingSettings -> ShowS
[TrackingSettings] -> ShowS
TrackingSettings -> String
(Int -> TrackingSettings -> ShowS)
-> (TrackingSettings -> String)
-> ([TrackingSettings] -> ShowS)
-> Show TrackingSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrackingSettings] -> ShowS
$cshowList :: [TrackingSettings] -> ShowS
show :: TrackingSettings -> String
$cshow :: TrackingSettings -> String
showsPrec :: Int -> TrackingSettings -> ShowS
$cshowsPrec :: Int -> TrackingSettings -> ShowS
Show, TrackingSettings -> TrackingSettings -> Bool
(TrackingSettings -> TrackingSettings -> Bool)
-> (TrackingSettings -> TrackingSettings -> Bool)
-> Eq TrackingSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrackingSettings -> TrackingSettings -> Bool
$c/= :: TrackingSettings -> TrackingSettings -> Bool
== :: TrackingSettings -> TrackingSettings -> Bool
$c== :: TrackingSettings -> TrackingSettings -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_trackingSettings"
              , omitNothingFields = True
              , constructorTagModifier = map toLower }) ''TrackingSettings)

-- | A collection of different mail settings that you can use to specify how you would like this email to be handled.
data MailSettings = MailSettings
 {
-- | This allows you to have a blind carbon copy automatically sent to the specified
--   email address for every email that is sent.
   MailSettings -> Maybe Bcc
_mailSettingsBcc                  :: Maybe Bcc
 -- |  Allows you to bypass all unsubscribe groups and suppressions.
 , MailSettings -> Maybe BypassListManagement
_mailSettingsBypassListManagement :: Maybe BypassListManagement
 -- | The default footer that you would like included on every email.
 , MailSettings -> Maybe Footer
_mailSettingsFooter               :: Maybe Footer
 -- | This allows you to send a test email to ensure that your request body is valid and formatted correctly.
 , MailSettings -> Maybe SandboxMode
_mailSettingsSandboxMode          :: Maybe SandboxMode
 -- | This allows you to test the content of your email for spam.
 , MailSettings -> Maybe SpamCheck
_mailSettingsSpamCheck            :: Maybe SpamCheck
 } deriving (Int -> MailSettings -> ShowS
[MailSettings] -> ShowS
MailSettings -> String
(Int -> MailSettings -> ShowS)
-> (MailSettings -> String)
-> ([MailSettings] -> ShowS)
-> Show MailSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MailSettings] -> ShowS
$cshowList :: [MailSettings] -> ShowS
show :: MailSettings -> String
$cshow :: MailSettings -> String
showsPrec :: Int -> MailSettings -> ShowS
$cshowsPrec :: Int -> MailSettings -> ShowS
Show, MailSettings -> MailSettings -> Bool
(MailSettings -> MailSettings -> Bool)
-> (MailSettings -> MailSettings -> Bool) -> Eq MailSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MailSettings -> MailSettings -> Bool
$c/= :: MailSettings -> MailSettings -> Bool
== :: MailSettings -> MailSettings -> Bool
$c== :: MailSettings -> MailSettings -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_mailSettings"
              , omitNothingFields = True
              , constructorTagModifier = map toLower }) ''MailSettings)

data Mail a b = Mail
  { -- | An array of messages and their metadata.
    --   Each object within personalizations can be thought of as an envelope
    --   - it defines who should receive an individual message and how that message should be handled.
    Mail a b -> [Personalization]
_mailPersonalizations :: [Personalization]
  -- | Address details of the person to whom you are sending an email.
  , Mail a b -> MailAddress
_mailFrom             :: MailAddress
  -- | Address details of the person to whom you are sending an email.
  , Mail a b -> Maybe MailAddress
_mailReplyTo          :: Maybe MailAddress
  -- | The subject of your email.
  , Mail a b -> Text
_mailSubject          :: T.Text
  -- | An array in which you may specify the content of your email.
  --   You can include multiple mime types of content, but you must specify at least one mime type.
  , Mail a b -> Maybe (NonEmpty MailContent)
_mailContent          :: Maybe (NonEmpty MailContent)
  -- | An array of objects in which you can specify any attachments you want to include.
  , Mail a b -> Maybe [MailAttachment]
_mailAttachments      :: Maybe [MailAttachment]
  -- | The id of a template that you would like to use.
  --   If you use a template that contains a subject and content (either text or html),
  --   you do not need to specify those at the personalizations nor message level.
  , Mail a b -> Maybe Text
_mailTemplateId       :: Maybe T.Text
  -- | An object of key/value pairs that define block sections of code to be used as substitutions.
  , Mail a b -> Maybe a
_mailSections         :: Maybe a
  -- | An object containing key/value pairs of header names and the value to substitute for them.
  --   You must ensure these are properly encoded if they contain unicode characters.
  --   Must not be one of the reserved headers.
  , Mail a b -> Maybe [(Text, Text)]
_mailHeaders          :: Maybe [(T.Text, T.Text)]
  -- | An array of category names for this message. Each category name may not exceed 255 characters.
  , Mail a b -> Maybe [Text]
_mailCategories       :: Maybe [T.Text]
  -- | Values that are specific to the entire send that will be carried along with
  -- | the email and its activity data.
  , Mail a b -> Maybe b
_mailCustomArgs       :: Maybe b
  -- | A unix timestamp allowing you to specify when you want your email to be delivered.
  , Mail a b -> Maybe Int
_mailSendAt           :: Maybe Int
  -- | This ID represents a batch of emails to be sent at the same time. Including a batch_id
  --   in your request allows you include this email in that batch, and also enables you to
  --  cancel or pause the delivery of that batch. For more information,
  --   see https://sendgrid.com/docs/API_Reference/Web_API_v3/cancel_schedule_send.html
  , Mail a b -> Maybe Text
_mailBatchId          :: Maybe T.Text
  -- | An object allowing you to specify how to handle unsubscribes.
  , Mail a b -> Maybe Asm
_mailAsm              :: Maybe Asm
  -- | The IP Pool that you would like to send this email from.
  , Mail a b -> Maybe Text
_mailIpPoolName       :: Maybe T.Text
  -- | A collection of different mail settings that you can use to specify how you would
  --   like this email to be handled.
  , Mail a b -> Maybe MailSettings
_mailMailSettings     :: Maybe MailSettings
  -- | Settings to determine how you would like to track the metrics of how your recipients
  --   interact with your email.
  , Mail a b -> Maybe TrackingSettings
_mailTrackingSettings :: Maybe TrackingSettings
  } deriving (Int -> Mail a b -> ShowS
[Mail a b] -> ShowS
Mail a b -> String
(Int -> Mail a b -> ShowS)
-> (Mail a b -> String) -> ([Mail a b] -> ShowS) -> Show (Mail a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Mail a b -> ShowS
forall a b. (Show a, Show b) => [Mail a b] -> ShowS
forall a b. (Show a, Show b) => Mail a b -> String
showList :: [Mail a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Mail a b] -> ShowS
show :: Mail a b -> String
$cshow :: forall a b. (Show a, Show b) => Mail a b -> String
showsPrec :: Int -> Mail a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Mail a b -> ShowS
Show, Mail a b -> Mail a b -> Bool
(Mail a b -> Mail a b -> Bool)
-> (Mail a b -> Mail a b -> Bool) -> Eq (Mail a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Mail a b -> Mail a b -> Bool
/= :: Mail a b -> Mail a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Mail a b -> Mail a b -> Bool
== :: Mail a b -> Mail a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Mail a b -> Mail a b -> Bool
Eq)

$(deriveToJSON (defaultOptions
              { fieldLabelModifier = unPrefix "_mail"
              , omitNothingFields = True
              , constructorTagModifier = map toLower }) ''Mail)

-- | Smart constructor for `Mail`, asking only for the mandatory `Mail` parameters.
mail
  :: (ToJSON a, ToJSON b)
  => [Personalization]
  -> MailAddress
  -> T.Text
  -> Maybe (NonEmpty MailContent)
  -> Mail a b
mail :: [Personalization]
-> MailAddress -> Text -> Maybe (NonEmpty MailContent) -> Mail a b
mail [Personalization]
personalizations MailAddress
from Text
subject Maybe (NonEmpty MailContent)
mContent = Mail :: forall a b.
[Personalization]
-> MailAddress
-> Maybe MailAddress
-> Text
-> Maybe (NonEmpty MailContent)
-> Maybe [MailAttachment]
-> Maybe Text
-> Maybe a
-> Maybe [(Text, Text)]
-> Maybe [Text]
-> Maybe b
-> Maybe Int
-> Maybe Text
-> Maybe Asm
-> Maybe Text
-> Maybe MailSettings
-> Maybe TrackingSettings
-> Mail a b
Mail
  { _mailPersonalizations :: [Personalization]
_mailPersonalizations = [Personalization]
personalizations
  , _mailFrom :: MailAddress
_mailFrom             = MailAddress
from
  , _mailReplyTo :: Maybe MailAddress
_mailReplyTo          = Maybe MailAddress
forall a. Maybe a
Nothing
  , _mailSubject :: Text
_mailSubject          = Text
subject
  , _mailContent :: Maybe (NonEmpty MailContent)
_mailContent          = Maybe (NonEmpty MailContent)
mContent
  , _mailAttachments :: Maybe [MailAttachment]
_mailAttachments      = Maybe [MailAttachment]
forall a. Maybe a
Nothing
  , _mailTemplateId :: Maybe Text
_mailTemplateId       = Maybe Text
forall a. Maybe a
Nothing
  , _mailSections :: Maybe a
_mailSections         = forall a. Maybe a
Nothing :: Maybe a
  , _mailHeaders :: Maybe [(Text, Text)]
_mailHeaders          = Maybe [(Text, Text)]
forall a. Maybe a
Nothing
  , _mailCategories :: Maybe [Text]
_mailCategories       = Maybe [Text]
forall a. Maybe a
Nothing
  , _mailCustomArgs :: Maybe b
_mailCustomArgs       = forall a. Maybe a
Nothing :: Maybe b
  , _mailSendAt :: Maybe Int
_mailSendAt           = Maybe Int
forall a. Maybe a
Nothing
  , _mailBatchId :: Maybe Text
_mailBatchId          = Maybe Text
forall a. Maybe a
Nothing
  , _mailAsm :: Maybe Asm
_mailAsm              = Maybe Asm
forall a. Maybe a
Nothing
  , _mailIpPoolName :: Maybe Text
_mailIpPoolName       = Maybe Text
forall a. Maybe a
Nothing
  , _mailMailSettings :: Maybe MailSettings
_mailMailSettings     = Maybe MailSettings
forall a. Maybe a
Nothing
  , _mailTrackingSettings :: Maybe TrackingSettings
_mailTrackingSettings = Maybe TrackingSettings
forall a. Maybe a
Nothing
  }

-- | Send an email via the @SendGrid@ API.
--
--  [@a@] Type of Mail Section, see `_mailSections` for details.
--
--  [@b@] Type of Custom Arg, see `_mailCustomArgs` for details.
--
--  Returns either:
--  - A successful @'Response'@ from the SendGrid API
--  - An @'HttpException'@, thrown from @'Network.Wreq.postWith'@
--
sendMail
  :: (ToJSON a, ToJSON b)
  => ApiKey
  -> Mail a b
  -> IO (Either HttpException (Response ByteString))
sendMail :: ApiKey
-> Mail a b -> IO (Either HttpException (Response ByteString))
sendMail (ApiKey Text
key) Mail a b
mail' = do
  let tkn :: ByteString
tkn = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
"Bearer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key
      opts :: Options
opts =
        Options
defaults
          Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& (HeaderName -> Lens' Options [ByteString]
header HeaderName
"Authorization" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
tkn])
          (Options -> Options) -> (Options -> Options) -> Options -> Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderName -> Lens' Options [ByteString]
header HeaderName
"Content-Type" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"application/json"])

  IO (Response ByteString)
-> IO (Either HttpException (Response ByteString))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Response ByteString)
 -> IO (Either HttpException (Response ByteString)))
-> (ByteString -> IO (Response ByteString))
-> ByteString
-> IO (Either HttpException (Response ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> String -> ByteString -> IO (Response ByteString)
forall a.
Postable a =>
Options -> String -> a -> IO (Response ByteString)
postWith Options
opts (Text -> String
T.unpack Text
sendGridAPI) (ByteString -> IO (Either HttpException (Response ByteString)))
-> ByteString -> IO (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Mail a b -> Value
forall a. ToJSON a => a -> Value
toJSON Mail a b
mail')