{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.PinpointEmail.Types.EmailContent
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.PinpointEmail.Types.EmailContent where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.PinpointEmail.Types.Message
import Amazonka.PinpointEmail.Types.RawMessage
import Amazonka.PinpointEmail.Types.Template
import qualified Amazonka.Prelude as Prelude

-- | An object that defines the entire content of the email, including the
-- message headers and the body content. You can create a simple email
-- message, in which you specify the subject and the text and HTML versions
-- of the message body. You can also create raw messages, in which you
-- specify a complete MIME-formatted message. Raw messages can include
-- attachments and custom headers.
--
-- /See:/ 'newEmailContent' smart constructor.
data EmailContent = EmailContent'
  { -- | The raw email message. The message has to meet the following criteria:
    --
    -- -   The message has to contain a header and a body, separated by one
    --     blank line.
    --
    -- -   All of the required header fields must be present in the message.
    --
    -- -   Each part of a multipart MIME message must be formatted properly.
    --
    -- -   If you include attachments, they must be in a file format that
    --     Amazon Pinpoint supports.
    --
    -- -   The entire message must be Base64 encoded.
    --
    -- -   If any of the MIME parts in your message contain content that is
    --     outside of the 7-bit ASCII character range, you should encode that
    --     content to ensure that recipients\' email clients render the message
    --     properly.
    --
    -- -   The length of any single line of text in the message can\'t exceed
    --     1,000 characters. This restriction is defined in
    --     <https://tools.ietf.org/html/rfc5321 RFC 5321>.
    EmailContent -> Maybe RawMessage
raw :: Prelude.Maybe RawMessage,
    -- | The simple email message. The message consists of a subject and a
    -- message body.
    EmailContent -> Maybe Message
simple :: Prelude.Maybe Message,
    -- | The template to use for the email message.
    EmailContent -> Maybe Template
template :: Prelude.Maybe Template
  }
  deriving (EmailContent -> EmailContent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmailContent -> EmailContent -> Bool
$c/= :: EmailContent -> EmailContent -> Bool
== :: EmailContent -> EmailContent -> Bool
$c== :: EmailContent -> EmailContent -> Bool
Prelude.Eq, ReadPrec [EmailContent]
ReadPrec EmailContent
Int -> ReadS EmailContent
ReadS [EmailContent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EmailContent]
$creadListPrec :: ReadPrec [EmailContent]
readPrec :: ReadPrec EmailContent
$creadPrec :: ReadPrec EmailContent
readList :: ReadS [EmailContent]
$creadList :: ReadS [EmailContent]
readsPrec :: Int -> ReadS EmailContent
$creadsPrec :: Int -> ReadS EmailContent
Prelude.Read, Int -> EmailContent -> ShowS
[EmailContent] -> ShowS
EmailContent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmailContent] -> ShowS
$cshowList :: [EmailContent] -> ShowS
show :: EmailContent -> String
$cshow :: EmailContent -> String
showsPrec :: Int -> EmailContent -> ShowS
$cshowsPrec :: Int -> EmailContent -> ShowS
Prelude.Show, forall x. Rep EmailContent x -> EmailContent
forall x. EmailContent -> Rep EmailContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EmailContent x -> EmailContent
$cfrom :: forall x. EmailContent -> Rep EmailContent x
Prelude.Generic)

-- |
-- Create a value of 'EmailContent' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'raw', 'emailContent_raw' - The raw email message. The message has to meet the following criteria:
--
-- -   The message has to contain a header and a body, separated by one
--     blank line.
--
-- -   All of the required header fields must be present in the message.
--
-- -   Each part of a multipart MIME message must be formatted properly.
--
-- -   If you include attachments, they must be in a file format that
--     Amazon Pinpoint supports.
--
-- -   The entire message must be Base64 encoded.
--
-- -   If any of the MIME parts in your message contain content that is
--     outside of the 7-bit ASCII character range, you should encode that
--     content to ensure that recipients\' email clients render the message
--     properly.
--
-- -   The length of any single line of text in the message can\'t exceed
--     1,000 characters. This restriction is defined in
--     <https://tools.ietf.org/html/rfc5321 RFC 5321>.
--
-- 'simple', 'emailContent_simple' - The simple email message. The message consists of a subject and a
-- message body.
--
-- 'template', 'emailContent_template' - The template to use for the email message.
newEmailContent ::
  EmailContent
newEmailContent :: EmailContent
newEmailContent =
  EmailContent'
    { $sel:raw:EmailContent' :: Maybe RawMessage
raw = forall a. Maybe a
Prelude.Nothing,
      $sel:simple:EmailContent' :: Maybe Message
simple = forall a. Maybe a
Prelude.Nothing,
      $sel:template:EmailContent' :: Maybe Template
template = forall a. Maybe a
Prelude.Nothing
    }

-- | The raw email message. The message has to meet the following criteria:
--
-- -   The message has to contain a header and a body, separated by one
--     blank line.
--
-- -   All of the required header fields must be present in the message.
--
-- -   Each part of a multipart MIME message must be formatted properly.
--
-- -   If you include attachments, they must be in a file format that
--     Amazon Pinpoint supports.
--
-- -   The entire message must be Base64 encoded.
--
-- -   If any of the MIME parts in your message contain content that is
--     outside of the 7-bit ASCII character range, you should encode that
--     content to ensure that recipients\' email clients render the message
--     properly.
--
-- -   The length of any single line of text in the message can\'t exceed
--     1,000 characters. This restriction is defined in
--     <https://tools.ietf.org/html/rfc5321 RFC 5321>.
emailContent_raw :: Lens.Lens' EmailContent (Prelude.Maybe RawMessage)
emailContent_raw :: Lens' EmailContent (Maybe RawMessage)
emailContent_raw = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EmailContent' {Maybe RawMessage
raw :: Maybe RawMessage
$sel:raw:EmailContent' :: EmailContent -> Maybe RawMessage
raw} -> Maybe RawMessage
raw) (\s :: EmailContent
s@EmailContent' {} Maybe RawMessage
a -> EmailContent
s {$sel:raw:EmailContent' :: Maybe RawMessage
raw = Maybe RawMessage
a} :: EmailContent)

-- | The simple email message. The message consists of a subject and a
-- message body.
emailContent_simple :: Lens.Lens' EmailContent (Prelude.Maybe Message)
emailContent_simple :: Lens' EmailContent (Maybe Message)
emailContent_simple = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EmailContent' {Maybe Message
simple :: Maybe Message
$sel:simple:EmailContent' :: EmailContent -> Maybe Message
simple} -> Maybe Message
simple) (\s :: EmailContent
s@EmailContent' {} Maybe Message
a -> EmailContent
s {$sel:simple:EmailContent' :: Maybe Message
simple = Maybe Message
a} :: EmailContent)

-- | The template to use for the email message.
emailContent_template :: Lens.Lens' EmailContent (Prelude.Maybe Template)
emailContent_template :: Lens' EmailContent (Maybe Template)
emailContent_template = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EmailContent' {Maybe Template
template :: Maybe Template
$sel:template:EmailContent' :: EmailContent -> Maybe Template
template} -> Maybe Template
template) (\s :: EmailContent
s@EmailContent' {} Maybe Template
a -> EmailContent
s {$sel:template:EmailContent' :: Maybe Template
template = Maybe Template
a} :: EmailContent)

instance Prelude.Hashable EmailContent where
  hashWithSalt :: Int -> EmailContent -> Int
hashWithSalt Int
_salt EmailContent' {Maybe Message
Maybe RawMessage
Maybe Template
template :: Maybe Template
simple :: Maybe Message
raw :: Maybe RawMessage
$sel:template:EmailContent' :: EmailContent -> Maybe Template
$sel:simple:EmailContent' :: EmailContent -> Maybe Message
$sel:raw:EmailContent' :: EmailContent -> Maybe RawMessage
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RawMessage
raw
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Message
simple
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Template
template

instance Prelude.NFData EmailContent where
  rnf :: EmailContent -> ()
rnf EmailContent' {Maybe Message
Maybe RawMessage
Maybe Template
template :: Maybe Template
simple :: Maybe Message
raw :: Maybe RawMessage
$sel:template:EmailContent' :: EmailContent -> Maybe Template
$sel:simple:EmailContent' :: EmailContent -> Maybe Message
$sel:raw:EmailContent' :: EmailContent -> Maybe RawMessage
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe RawMessage
raw
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Message
simple
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Template
template

instance Data.ToJSON EmailContent where
  toJSON :: EmailContent -> Value
toJSON EmailContent' {Maybe Message
Maybe RawMessage
Maybe Template
template :: Maybe Template
simple :: Maybe Message
raw :: Maybe RawMessage
$sel:template:EmailContent' :: EmailContent -> Maybe Template
$sel:simple:EmailContent' :: EmailContent -> Maybe Message
$sel:raw:EmailContent' :: EmailContent -> Maybe RawMessage
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Raw" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RawMessage
raw,
            (Key
"Simple" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Message
simple,
            (Key
"Template" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Template
template
          ]
      )