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

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

-- |
-- Module      : Amazonka.SESV2.CreateDeliverabilityTestReport
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create a new predictive inbox placement test. Predictive inbox placement
-- tests can help you predict how your messages will be handled by various
-- email providers around the world. When you perform a predictive inbox
-- placement test, you provide a sample message that contains the content
-- that you plan to send to your customers. Amazon SES then sends that
-- message to special email addresses spread across several major email
-- providers. After about 24 hours, the test is complete, and you can use
-- the @GetDeliverabilityTestReport@ operation to view the results of the
-- test.
module Amazonka.SESV2.CreateDeliverabilityTestReport
  ( -- * Creating a Request
    CreateDeliverabilityTestReport (..),
    newCreateDeliverabilityTestReport,

    -- * Request Lenses
    createDeliverabilityTestReport_reportName,
    createDeliverabilityTestReport_tags,
    createDeliverabilityTestReport_fromEmailAddress,
    createDeliverabilityTestReport_content,

    -- * Destructuring the Response
    CreateDeliverabilityTestReportResponse (..),
    newCreateDeliverabilityTestReportResponse,

    -- * Response Lenses
    createDeliverabilityTestReportResponse_httpStatus,
    createDeliverabilityTestReportResponse_reportId,
    createDeliverabilityTestReportResponse_deliverabilityTestStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SESV2.Types

-- | A request to perform a predictive inbox placement test. Predictive inbox
-- placement tests can help you predict how your messages will be handled
-- by various email providers around the world. When you perform a
-- predictive inbox placement test, you provide a sample message that
-- contains the content that you plan to send to your customers. We send
-- that message to special email addresses spread across several major
-- email providers around the world. The test takes about 24 hours to
-- complete. When the test is complete, you can use the
-- @GetDeliverabilityTestReport@ operation to view the results of the test.
--
-- /See:/ 'newCreateDeliverabilityTestReport' smart constructor.
data CreateDeliverabilityTestReport = CreateDeliverabilityTestReport'
  { -- | A unique name that helps you to identify the predictive inbox placement
    -- test when you retrieve the results.
    CreateDeliverabilityTestReport -> Maybe Text
reportName :: Prelude.Maybe Prelude.Text,
    -- | An array of objects that define the tags (keys and values) that you want
    -- to associate with the predictive inbox placement test.
    CreateDeliverabilityTestReport -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The email address that the predictive inbox placement test email was
    -- sent from.
    CreateDeliverabilityTestReport -> Text
fromEmailAddress :: Prelude.Text,
    -- | The HTML body of the message that you sent when you performed the
    -- predictive inbox placement test.
    CreateDeliverabilityTestReport -> EmailContent
content :: EmailContent
  }
  deriving (CreateDeliverabilityTestReport
-> CreateDeliverabilityTestReport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDeliverabilityTestReport
-> CreateDeliverabilityTestReport -> Bool
$c/= :: CreateDeliverabilityTestReport
-> CreateDeliverabilityTestReport -> Bool
== :: CreateDeliverabilityTestReport
-> CreateDeliverabilityTestReport -> Bool
$c== :: CreateDeliverabilityTestReport
-> CreateDeliverabilityTestReport -> Bool
Prelude.Eq, ReadPrec [CreateDeliverabilityTestReport]
ReadPrec CreateDeliverabilityTestReport
Int -> ReadS CreateDeliverabilityTestReport
ReadS [CreateDeliverabilityTestReport]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDeliverabilityTestReport]
$creadListPrec :: ReadPrec [CreateDeliverabilityTestReport]
readPrec :: ReadPrec CreateDeliverabilityTestReport
$creadPrec :: ReadPrec CreateDeliverabilityTestReport
readList :: ReadS [CreateDeliverabilityTestReport]
$creadList :: ReadS [CreateDeliverabilityTestReport]
readsPrec :: Int -> ReadS CreateDeliverabilityTestReport
$creadsPrec :: Int -> ReadS CreateDeliverabilityTestReport
Prelude.Read, Int -> CreateDeliverabilityTestReport -> ShowS
[CreateDeliverabilityTestReport] -> ShowS
CreateDeliverabilityTestReport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDeliverabilityTestReport] -> ShowS
$cshowList :: [CreateDeliverabilityTestReport] -> ShowS
show :: CreateDeliverabilityTestReport -> String
$cshow :: CreateDeliverabilityTestReport -> String
showsPrec :: Int -> CreateDeliverabilityTestReport -> ShowS
$cshowsPrec :: Int -> CreateDeliverabilityTestReport -> ShowS
Prelude.Show, forall x.
Rep CreateDeliverabilityTestReport x
-> CreateDeliverabilityTestReport
forall x.
CreateDeliverabilityTestReport
-> Rep CreateDeliverabilityTestReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDeliverabilityTestReport x
-> CreateDeliverabilityTestReport
$cfrom :: forall x.
CreateDeliverabilityTestReport
-> Rep CreateDeliverabilityTestReport x
Prelude.Generic)

-- |
-- Create a value of 'CreateDeliverabilityTestReport' 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:
--
-- 'reportName', 'createDeliverabilityTestReport_reportName' - A unique name that helps you to identify the predictive inbox placement
-- test when you retrieve the results.
--
-- 'tags', 'createDeliverabilityTestReport_tags' - An array of objects that define the tags (keys and values) that you want
-- to associate with the predictive inbox placement test.
--
-- 'fromEmailAddress', 'createDeliverabilityTestReport_fromEmailAddress' - The email address that the predictive inbox placement test email was
-- sent from.
--
-- 'content', 'createDeliverabilityTestReport_content' - The HTML body of the message that you sent when you performed the
-- predictive inbox placement test.
newCreateDeliverabilityTestReport ::
  -- | 'fromEmailAddress'
  Prelude.Text ->
  -- | 'content'
  EmailContent ->
  CreateDeliverabilityTestReport
newCreateDeliverabilityTestReport :: Text -> EmailContent -> CreateDeliverabilityTestReport
newCreateDeliverabilityTestReport
  Text
pFromEmailAddress_
  EmailContent
pContent_ =
    CreateDeliverabilityTestReport'
      { $sel:reportName:CreateDeliverabilityTestReport' :: Maybe Text
reportName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateDeliverabilityTestReport' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:fromEmailAddress:CreateDeliverabilityTestReport' :: Text
fromEmailAddress = Text
pFromEmailAddress_,
        $sel:content:CreateDeliverabilityTestReport' :: EmailContent
content = EmailContent
pContent_
      }

-- | A unique name that helps you to identify the predictive inbox placement
-- test when you retrieve the results.
createDeliverabilityTestReport_reportName :: Lens.Lens' CreateDeliverabilityTestReport (Prelude.Maybe Prelude.Text)
createDeliverabilityTestReport_reportName :: Lens' CreateDeliverabilityTestReport (Maybe Text)
createDeliverabilityTestReport_reportName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeliverabilityTestReport' {Maybe Text
reportName :: Maybe Text
$sel:reportName:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> Maybe Text
reportName} -> Maybe Text
reportName) (\s :: CreateDeliverabilityTestReport
s@CreateDeliverabilityTestReport' {} Maybe Text
a -> CreateDeliverabilityTestReport
s {$sel:reportName:CreateDeliverabilityTestReport' :: Maybe Text
reportName = Maybe Text
a} :: CreateDeliverabilityTestReport)

-- | An array of objects that define the tags (keys and values) that you want
-- to associate with the predictive inbox placement test.
createDeliverabilityTestReport_tags :: Lens.Lens' CreateDeliverabilityTestReport (Prelude.Maybe [Tag])
createDeliverabilityTestReport_tags :: Lens' CreateDeliverabilityTestReport (Maybe [Tag])
createDeliverabilityTestReport_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeliverabilityTestReport' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateDeliverabilityTestReport
s@CreateDeliverabilityTestReport' {} Maybe [Tag]
a -> CreateDeliverabilityTestReport
s {$sel:tags:CreateDeliverabilityTestReport' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateDeliverabilityTestReport) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The email address that the predictive inbox placement test email was
-- sent from.
createDeliverabilityTestReport_fromEmailAddress :: Lens.Lens' CreateDeliverabilityTestReport Prelude.Text
createDeliverabilityTestReport_fromEmailAddress :: Lens' CreateDeliverabilityTestReport Text
createDeliverabilityTestReport_fromEmailAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeliverabilityTestReport' {Text
fromEmailAddress :: Text
$sel:fromEmailAddress:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> Text
fromEmailAddress} -> Text
fromEmailAddress) (\s :: CreateDeliverabilityTestReport
s@CreateDeliverabilityTestReport' {} Text
a -> CreateDeliverabilityTestReport
s {$sel:fromEmailAddress:CreateDeliverabilityTestReport' :: Text
fromEmailAddress = Text
a} :: CreateDeliverabilityTestReport)

-- | The HTML body of the message that you sent when you performed the
-- predictive inbox placement test.
createDeliverabilityTestReport_content :: Lens.Lens' CreateDeliverabilityTestReport EmailContent
createDeliverabilityTestReport_content :: Lens' CreateDeliverabilityTestReport EmailContent
createDeliverabilityTestReport_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeliverabilityTestReport' {EmailContent
content :: EmailContent
$sel:content:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> EmailContent
content} -> EmailContent
content) (\s :: CreateDeliverabilityTestReport
s@CreateDeliverabilityTestReport' {} EmailContent
a -> CreateDeliverabilityTestReport
s {$sel:content:CreateDeliverabilityTestReport' :: EmailContent
content = EmailContent
a} :: CreateDeliverabilityTestReport)

instance
  Core.AWSRequest
    CreateDeliverabilityTestReport
  where
  type
    AWSResponse CreateDeliverabilityTestReport =
      CreateDeliverabilityTestReportResponse
  request :: (Service -> Service)
-> CreateDeliverabilityTestReport
-> Request CreateDeliverabilityTestReport
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateDeliverabilityTestReport
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateDeliverabilityTestReport)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int
-> Text
-> DeliverabilityTestStatus
-> CreateDeliverabilityTestReportResponse
CreateDeliverabilityTestReportResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ReportId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"DeliverabilityTestStatus")
      )

instance
  Prelude.Hashable
    CreateDeliverabilityTestReport
  where
  hashWithSalt :: Int -> CreateDeliverabilityTestReport -> Int
hashWithSalt
    Int
_salt
    CreateDeliverabilityTestReport' {Maybe [Tag]
Maybe Text
Text
EmailContent
content :: EmailContent
fromEmailAddress :: Text
tags :: Maybe [Tag]
reportName :: Maybe Text
$sel:content:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> EmailContent
$sel:fromEmailAddress:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> Text
$sel:tags:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> Maybe [Tag]
$sel:reportName:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reportName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fromEmailAddress
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` EmailContent
content

instance
  Prelude.NFData
    CreateDeliverabilityTestReport
  where
  rnf :: CreateDeliverabilityTestReport -> ()
rnf CreateDeliverabilityTestReport' {Maybe [Tag]
Maybe Text
Text
EmailContent
content :: EmailContent
fromEmailAddress :: Text
tags :: Maybe [Tag]
reportName :: Maybe Text
$sel:content:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> EmailContent
$sel:fromEmailAddress:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> Text
$sel:tags:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> Maybe [Tag]
$sel:reportName:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
reportName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fromEmailAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf EmailContent
content

instance
  Data.ToHeaders
    CreateDeliverabilityTestReport
  where
  toHeaders :: CreateDeliverabilityTestReport -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateDeliverabilityTestReport where
  toJSON :: CreateDeliverabilityTestReport -> Value
toJSON CreateDeliverabilityTestReport' {Maybe [Tag]
Maybe Text
Text
EmailContent
content :: EmailContent
fromEmailAddress :: Text
tags :: Maybe [Tag]
reportName :: Maybe Text
$sel:content:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> EmailContent
$sel:fromEmailAddress:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> Text
$sel:tags:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> Maybe [Tag]
$sel:reportName:CreateDeliverabilityTestReport' :: CreateDeliverabilityTestReport -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ReportName" 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 Text
reportName,
            (Key
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"FromEmailAddress" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
fromEmailAddress),
            forall a. a -> Maybe a
Prelude.Just (Key
"Content" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= EmailContent
content)
          ]
      )

instance Data.ToPath CreateDeliverabilityTestReport where
  toPath :: CreateDeliverabilityTestReport -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/v2/email/deliverability-dashboard/test"

instance Data.ToQuery CreateDeliverabilityTestReport where
  toQuery :: CreateDeliverabilityTestReport -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | Information about the predictive inbox placement test that you created.
--
-- /See:/ 'newCreateDeliverabilityTestReportResponse' smart constructor.
data CreateDeliverabilityTestReportResponse = CreateDeliverabilityTestReportResponse'
  { -- | The response's http status code.
    CreateDeliverabilityTestReportResponse -> Int
httpStatus :: Prelude.Int,
    -- | A unique string that identifies the predictive inbox placement test.
    CreateDeliverabilityTestReportResponse -> Text
reportId :: Prelude.Text,
    -- | The status of the predictive inbox placement test. If the status is
    -- @IN_PROGRESS@, then the predictive inbox placement test is currently
    -- running. Predictive inbox placement tests are usually complete within 24
    -- hours of creating the test. If the status is @COMPLETE@, then the test
    -- is finished, and you can use the @GetDeliverabilityTestReport@ to view
    -- the results of the test.
    CreateDeliverabilityTestReportResponse -> DeliverabilityTestStatus
deliverabilityTestStatus :: DeliverabilityTestStatus
  }
  deriving (CreateDeliverabilityTestReportResponse
-> CreateDeliverabilityTestReportResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDeliverabilityTestReportResponse
-> CreateDeliverabilityTestReportResponse -> Bool
$c/= :: CreateDeliverabilityTestReportResponse
-> CreateDeliverabilityTestReportResponse -> Bool
== :: CreateDeliverabilityTestReportResponse
-> CreateDeliverabilityTestReportResponse -> Bool
$c== :: CreateDeliverabilityTestReportResponse
-> CreateDeliverabilityTestReportResponse -> Bool
Prelude.Eq, ReadPrec [CreateDeliverabilityTestReportResponse]
ReadPrec CreateDeliverabilityTestReportResponse
Int -> ReadS CreateDeliverabilityTestReportResponse
ReadS [CreateDeliverabilityTestReportResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDeliverabilityTestReportResponse]
$creadListPrec :: ReadPrec [CreateDeliverabilityTestReportResponse]
readPrec :: ReadPrec CreateDeliverabilityTestReportResponse
$creadPrec :: ReadPrec CreateDeliverabilityTestReportResponse
readList :: ReadS [CreateDeliverabilityTestReportResponse]
$creadList :: ReadS [CreateDeliverabilityTestReportResponse]
readsPrec :: Int -> ReadS CreateDeliverabilityTestReportResponse
$creadsPrec :: Int -> ReadS CreateDeliverabilityTestReportResponse
Prelude.Read, Int -> CreateDeliverabilityTestReportResponse -> ShowS
[CreateDeliverabilityTestReportResponse] -> ShowS
CreateDeliverabilityTestReportResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDeliverabilityTestReportResponse] -> ShowS
$cshowList :: [CreateDeliverabilityTestReportResponse] -> ShowS
show :: CreateDeliverabilityTestReportResponse -> String
$cshow :: CreateDeliverabilityTestReportResponse -> String
showsPrec :: Int -> CreateDeliverabilityTestReportResponse -> ShowS
$cshowsPrec :: Int -> CreateDeliverabilityTestReportResponse -> ShowS
Prelude.Show, forall x.
Rep CreateDeliverabilityTestReportResponse x
-> CreateDeliverabilityTestReportResponse
forall x.
CreateDeliverabilityTestReportResponse
-> Rep CreateDeliverabilityTestReportResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDeliverabilityTestReportResponse x
-> CreateDeliverabilityTestReportResponse
$cfrom :: forall x.
CreateDeliverabilityTestReportResponse
-> Rep CreateDeliverabilityTestReportResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDeliverabilityTestReportResponse' 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:
--
-- 'httpStatus', 'createDeliverabilityTestReportResponse_httpStatus' - The response's http status code.
--
-- 'reportId', 'createDeliverabilityTestReportResponse_reportId' - A unique string that identifies the predictive inbox placement test.
--
-- 'deliverabilityTestStatus', 'createDeliverabilityTestReportResponse_deliverabilityTestStatus' - The status of the predictive inbox placement test. If the status is
-- @IN_PROGRESS@, then the predictive inbox placement test is currently
-- running. Predictive inbox placement tests are usually complete within 24
-- hours of creating the test. If the status is @COMPLETE@, then the test
-- is finished, and you can use the @GetDeliverabilityTestReport@ to view
-- the results of the test.
newCreateDeliverabilityTestReportResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'reportId'
  Prelude.Text ->
  -- | 'deliverabilityTestStatus'
  DeliverabilityTestStatus ->
  CreateDeliverabilityTestReportResponse
newCreateDeliverabilityTestReportResponse :: Int
-> Text
-> DeliverabilityTestStatus
-> CreateDeliverabilityTestReportResponse
newCreateDeliverabilityTestReportResponse
  Int
pHttpStatus_
  Text
pReportId_
  DeliverabilityTestStatus
pDeliverabilityTestStatus_ =
    CreateDeliverabilityTestReportResponse'
      { $sel:httpStatus:CreateDeliverabilityTestReportResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:reportId:CreateDeliverabilityTestReportResponse' :: Text
reportId = Text
pReportId_,
        $sel:deliverabilityTestStatus:CreateDeliverabilityTestReportResponse' :: DeliverabilityTestStatus
deliverabilityTestStatus =
          DeliverabilityTestStatus
pDeliverabilityTestStatus_
      }

-- | The response's http status code.
createDeliverabilityTestReportResponse_httpStatus :: Lens.Lens' CreateDeliverabilityTestReportResponse Prelude.Int
createDeliverabilityTestReportResponse_httpStatus :: Lens' CreateDeliverabilityTestReportResponse Int
createDeliverabilityTestReportResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeliverabilityTestReportResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateDeliverabilityTestReportResponse' :: CreateDeliverabilityTestReportResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateDeliverabilityTestReportResponse
s@CreateDeliverabilityTestReportResponse' {} Int
a -> CreateDeliverabilityTestReportResponse
s {$sel:httpStatus:CreateDeliverabilityTestReportResponse' :: Int
httpStatus = Int
a} :: CreateDeliverabilityTestReportResponse)

-- | A unique string that identifies the predictive inbox placement test.
createDeliverabilityTestReportResponse_reportId :: Lens.Lens' CreateDeliverabilityTestReportResponse Prelude.Text
createDeliverabilityTestReportResponse_reportId :: Lens' CreateDeliverabilityTestReportResponse Text
createDeliverabilityTestReportResponse_reportId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeliverabilityTestReportResponse' {Text
reportId :: Text
$sel:reportId:CreateDeliverabilityTestReportResponse' :: CreateDeliverabilityTestReportResponse -> Text
reportId} -> Text
reportId) (\s :: CreateDeliverabilityTestReportResponse
s@CreateDeliverabilityTestReportResponse' {} Text
a -> CreateDeliverabilityTestReportResponse
s {$sel:reportId:CreateDeliverabilityTestReportResponse' :: Text
reportId = Text
a} :: CreateDeliverabilityTestReportResponse)

-- | The status of the predictive inbox placement test. If the status is
-- @IN_PROGRESS@, then the predictive inbox placement test is currently
-- running. Predictive inbox placement tests are usually complete within 24
-- hours of creating the test. If the status is @COMPLETE@, then the test
-- is finished, and you can use the @GetDeliverabilityTestReport@ to view
-- the results of the test.
createDeliverabilityTestReportResponse_deliverabilityTestStatus :: Lens.Lens' CreateDeliverabilityTestReportResponse DeliverabilityTestStatus
createDeliverabilityTestReportResponse_deliverabilityTestStatus :: Lens'
  CreateDeliverabilityTestReportResponse DeliverabilityTestStatus
createDeliverabilityTestReportResponse_deliverabilityTestStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeliverabilityTestReportResponse' {DeliverabilityTestStatus
deliverabilityTestStatus :: DeliverabilityTestStatus
$sel:deliverabilityTestStatus:CreateDeliverabilityTestReportResponse' :: CreateDeliverabilityTestReportResponse -> DeliverabilityTestStatus
deliverabilityTestStatus} -> DeliverabilityTestStatus
deliverabilityTestStatus) (\s :: CreateDeliverabilityTestReportResponse
s@CreateDeliverabilityTestReportResponse' {} DeliverabilityTestStatus
a -> CreateDeliverabilityTestReportResponse
s {$sel:deliverabilityTestStatus:CreateDeliverabilityTestReportResponse' :: DeliverabilityTestStatus
deliverabilityTestStatus = DeliverabilityTestStatus
a} :: CreateDeliverabilityTestReportResponse)

instance
  Prelude.NFData
    CreateDeliverabilityTestReportResponse
  where
  rnf :: CreateDeliverabilityTestReportResponse -> ()
rnf CreateDeliverabilityTestReportResponse' {Int
Text
DeliverabilityTestStatus
deliverabilityTestStatus :: DeliverabilityTestStatus
reportId :: Text
httpStatus :: Int
$sel:deliverabilityTestStatus:CreateDeliverabilityTestReportResponse' :: CreateDeliverabilityTestReportResponse -> DeliverabilityTestStatus
$sel:reportId:CreateDeliverabilityTestReportResponse' :: CreateDeliverabilityTestReportResponse -> Text
$sel:httpStatus:CreateDeliverabilityTestReportResponse' :: CreateDeliverabilityTestReportResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
reportId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DeliverabilityTestStatus
deliverabilityTestStatus