{-# 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.PutDeliverabilityDashboardOption
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enable or disable the Deliverability dashboard. When you enable the
-- Deliverability dashboard, you gain access to reputation, deliverability,
-- and other metrics for the domains that you use to send email. You also
-- gain the ability to perform predictive inbox placement tests.
--
-- When you use the Deliverability dashboard, you pay a monthly
-- subscription charge, in addition to any other fees that you accrue by
-- using Amazon SES and other Amazon Web Services services. For more
-- information about the features and cost of a Deliverability dashboard
-- subscription, see
-- <http://aws.amazon.com/ses/pricing/ Amazon SES Pricing>.
module Amazonka.SESV2.PutDeliverabilityDashboardOption
  ( -- * Creating a Request
    PutDeliverabilityDashboardOption (..),
    newPutDeliverabilityDashboardOption,

    -- * Request Lenses
    putDeliverabilityDashboardOption_subscribedDomains,
    putDeliverabilityDashboardOption_dashboardEnabled,

    -- * Destructuring the Response
    PutDeliverabilityDashboardOptionResponse (..),
    newPutDeliverabilityDashboardOptionResponse,

    -- * Response Lenses
    putDeliverabilityDashboardOptionResponse_httpStatus,
  )
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

-- | Enable or disable the Deliverability dashboard. When you enable the
-- Deliverability dashboard, you gain access to reputation, deliverability,
-- and other metrics for the domains that you use to send email using
-- Amazon SES API v2. You also gain the ability to perform predictive inbox
-- placement tests.
--
-- When you use the Deliverability dashboard, you pay a monthly
-- subscription charge, in addition to any other fees that you accrue by
-- using Amazon SES and other Amazon Web Services services. For more
-- information about the features and cost of a Deliverability dashboard
-- subscription, see
-- <http://aws.amazon.com/pinpoint/pricing/ Amazon Pinpoint Pricing>.
--
-- /See:/ 'newPutDeliverabilityDashboardOption' smart constructor.
data PutDeliverabilityDashboardOption = PutDeliverabilityDashboardOption'
  { -- | An array of objects, one for each verified domain that you use to send
    -- email and enabled the Deliverability dashboard for.
    PutDeliverabilityDashboardOption
-> Maybe [DomainDeliverabilityTrackingOption]
subscribedDomains :: Prelude.Maybe [DomainDeliverabilityTrackingOption],
    -- | Specifies whether to enable the Deliverability dashboard. To enable the
    -- dashboard, set this value to @true@.
    PutDeliverabilityDashboardOption -> Bool
dashboardEnabled :: Prelude.Bool
  }
  deriving (PutDeliverabilityDashboardOption
-> PutDeliverabilityDashboardOption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutDeliverabilityDashboardOption
-> PutDeliverabilityDashboardOption -> Bool
$c/= :: PutDeliverabilityDashboardOption
-> PutDeliverabilityDashboardOption -> Bool
== :: PutDeliverabilityDashboardOption
-> PutDeliverabilityDashboardOption -> Bool
$c== :: PutDeliverabilityDashboardOption
-> PutDeliverabilityDashboardOption -> Bool
Prelude.Eq, ReadPrec [PutDeliverabilityDashboardOption]
ReadPrec PutDeliverabilityDashboardOption
Int -> ReadS PutDeliverabilityDashboardOption
ReadS [PutDeliverabilityDashboardOption]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutDeliverabilityDashboardOption]
$creadListPrec :: ReadPrec [PutDeliverabilityDashboardOption]
readPrec :: ReadPrec PutDeliverabilityDashboardOption
$creadPrec :: ReadPrec PutDeliverabilityDashboardOption
readList :: ReadS [PutDeliverabilityDashboardOption]
$creadList :: ReadS [PutDeliverabilityDashboardOption]
readsPrec :: Int -> ReadS PutDeliverabilityDashboardOption
$creadsPrec :: Int -> ReadS PutDeliverabilityDashboardOption
Prelude.Read, Int -> PutDeliverabilityDashboardOption -> ShowS
[PutDeliverabilityDashboardOption] -> ShowS
PutDeliverabilityDashboardOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutDeliverabilityDashboardOption] -> ShowS
$cshowList :: [PutDeliverabilityDashboardOption] -> ShowS
show :: PutDeliverabilityDashboardOption -> String
$cshow :: PutDeliverabilityDashboardOption -> String
showsPrec :: Int -> PutDeliverabilityDashboardOption -> ShowS
$cshowsPrec :: Int -> PutDeliverabilityDashboardOption -> ShowS
Prelude.Show, forall x.
Rep PutDeliverabilityDashboardOption x
-> PutDeliverabilityDashboardOption
forall x.
PutDeliverabilityDashboardOption
-> Rep PutDeliverabilityDashboardOption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutDeliverabilityDashboardOption x
-> PutDeliverabilityDashboardOption
$cfrom :: forall x.
PutDeliverabilityDashboardOption
-> Rep PutDeliverabilityDashboardOption x
Prelude.Generic)

-- |
-- Create a value of 'PutDeliverabilityDashboardOption' 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:
--
-- 'subscribedDomains', 'putDeliverabilityDashboardOption_subscribedDomains' - An array of objects, one for each verified domain that you use to send
-- email and enabled the Deliverability dashboard for.
--
-- 'dashboardEnabled', 'putDeliverabilityDashboardOption_dashboardEnabled' - Specifies whether to enable the Deliverability dashboard. To enable the
-- dashboard, set this value to @true@.
newPutDeliverabilityDashboardOption ::
  -- | 'dashboardEnabled'
  Prelude.Bool ->
  PutDeliverabilityDashboardOption
newPutDeliverabilityDashboardOption :: Bool -> PutDeliverabilityDashboardOption
newPutDeliverabilityDashboardOption
  Bool
pDashboardEnabled_ =
    PutDeliverabilityDashboardOption'
      { $sel:subscribedDomains:PutDeliverabilityDashboardOption' :: Maybe [DomainDeliverabilityTrackingOption]
subscribedDomains =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dashboardEnabled:PutDeliverabilityDashboardOption' :: Bool
dashboardEnabled = Bool
pDashboardEnabled_
      }

-- | An array of objects, one for each verified domain that you use to send
-- email and enabled the Deliverability dashboard for.
putDeliverabilityDashboardOption_subscribedDomains :: Lens.Lens' PutDeliverabilityDashboardOption (Prelude.Maybe [DomainDeliverabilityTrackingOption])
putDeliverabilityDashboardOption_subscribedDomains :: Lens'
  PutDeliverabilityDashboardOption
  (Maybe [DomainDeliverabilityTrackingOption])
putDeliverabilityDashboardOption_subscribedDomains = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutDeliverabilityDashboardOption' {Maybe [DomainDeliverabilityTrackingOption]
subscribedDomains :: Maybe [DomainDeliverabilityTrackingOption]
$sel:subscribedDomains:PutDeliverabilityDashboardOption' :: PutDeliverabilityDashboardOption
-> Maybe [DomainDeliverabilityTrackingOption]
subscribedDomains} -> Maybe [DomainDeliverabilityTrackingOption]
subscribedDomains) (\s :: PutDeliverabilityDashboardOption
s@PutDeliverabilityDashboardOption' {} Maybe [DomainDeliverabilityTrackingOption]
a -> PutDeliverabilityDashboardOption
s {$sel:subscribedDomains:PutDeliverabilityDashboardOption' :: Maybe [DomainDeliverabilityTrackingOption]
subscribedDomains = Maybe [DomainDeliverabilityTrackingOption]
a} :: PutDeliverabilityDashboardOption) 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

-- | Specifies whether to enable the Deliverability dashboard. To enable the
-- dashboard, set this value to @true@.
putDeliverabilityDashboardOption_dashboardEnabled :: Lens.Lens' PutDeliverabilityDashboardOption Prelude.Bool
putDeliverabilityDashboardOption_dashboardEnabled :: Lens' PutDeliverabilityDashboardOption Bool
putDeliverabilityDashboardOption_dashboardEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutDeliverabilityDashboardOption' {Bool
dashboardEnabled :: Bool
$sel:dashboardEnabled:PutDeliverabilityDashboardOption' :: PutDeliverabilityDashboardOption -> Bool
dashboardEnabled} -> Bool
dashboardEnabled) (\s :: PutDeliverabilityDashboardOption
s@PutDeliverabilityDashboardOption' {} Bool
a -> PutDeliverabilityDashboardOption
s {$sel:dashboardEnabled:PutDeliverabilityDashboardOption' :: Bool
dashboardEnabled = Bool
a} :: PutDeliverabilityDashboardOption)

instance
  Core.AWSRequest
    PutDeliverabilityDashboardOption
  where
  type
    AWSResponse PutDeliverabilityDashboardOption =
      PutDeliverabilityDashboardOptionResponse
  request :: (Service -> Service)
-> PutDeliverabilityDashboardOption
-> Request PutDeliverabilityDashboardOption
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutDeliverabilityDashboardOption
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse PutDeliverabilityDashboardOption)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> PutDeliverabilityDashboardOptionResponse
PutDeliverabilityDashboardOptionResponse'
            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))
      )

instance
  Prelude.Hashable
    PutDeliverabilityDashboardOption
  where
  hashWithSalt :: Int -> PutDeliverabilityDashboardOption -> Int
hashWithSalt
    Int
_salt
    PutDeliverabilityDashboardOption' {Bool
Maybe [DomainDeliverabilityTrackingOption]
dashboardEnabled :: Bool
subscribedDomains :: Maybe [DomainDeliverabilityTrackingOption]
$sel:dashboardEnabled:PutDeliverabilityDashboardOption' :: PutDeliverabilityDashboardOption -> Bool
$sel:subscribedDomains:PutDeliverabilityDashboardOption' :: PutDeliverabilityDashboardOption
-> Maybe [DomainDeliverabilityTrackingOption]
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DomainDeliverabilityTrackingOption]
subscribedDomains
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
dashboardEnabled

instance
  Prelude.NFData
    PutDeliverabilityDashboardOption
  where
  rnf :: PutDeliverabilityDashboardOption -> ()
rnf PutDeliverabilityDashboardOption' {Bool
Maybe [DomainDeliverabilityTrackingOption]
dashboardEnabled :: Bool
subscribedDomains :: Maybe [DomainDeliverabilityTrackingOption]
$sel:dashboardEnabled:PutDeliverabilityDashboardOption' :: PutDeliverabilityDashboardOption -> Bool
$sel:subscribedDomains:PutDeliverabilityDashboardOption' :: PutDeliverabilityDashboardOption
-> Maybe [DomainDeliverabilityTrackingOption]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DomainDeliverabilityTrackingOption]
subscribedDomains
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
dashboardEnabled

instance
  Data.ToHeaders
    PutDeliverabilityDashboardOption
  where
  toHeaders :: PutDeliverabilityDashboardOption -> 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 PutDeliverabilityDashboardOption where
  toJSON :: PutDeliverabilityDashboardOption -> Value
toJSON PutDeliverabilityDashboardOption' {Bool
Maybe [DomainDeliverabilityTrackingOption]
dashboardEnabled :: Bool
subscribedDomains :: Maybe [DomainDeliverabilityTrackingOption]
$sel:dashboardEnabled:PutDeliverabilityDashboardOption' :: PutDeliverabilityDashboardOption -> Bool
$sel:subscribedDomains:PutDeliverabilityDashboardOption' :: PutDeliverabilityDashboardOption
-> Maybe [DomainDeliverabilityTrackingOption]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"SubscribedDomains" 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 [DomainDeliverabilityTrackingOption]
subscribedDomains,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DashboardEnabled" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
dashboardEnabled)
          ]
      )

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

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

-- | A response that indicates whether the Deliverability dashboard is
-- enabled.
--
-- /See:/ 'newPutDeliverabilityDashboardOptionResponse' smart constructor.
data PutDeliverabilityDashboardOptionResponse = PutDeliverabilityDashboardOptionResponse'
  { -- | The response's http status code.
    PutDeliverabilityDashboardOptionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutDeliverabilityDashboardOptionResponse
-> PutDeliverabilityDashboardOptionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutDeliverabilityDashboardOptionResponse
-> PutDeliverabilityDashboardOptionResponse -> Bool
$c/= :: PutDeliverabilityDashboardOptionResponse
-> PutDeliverabilityDashboardOptionResponse -> Bool
== :: PutDeliverabilityDashboardOptionResponse
-> PutDeliverabilityDashboardOptionResponse -> Bool
$c== :: PutDeliverabilityDashboardOptionResponse
-> PutDeliverabilityDashboardOptionResponse -> Bool
Prelude.Eq, ReadPrec [PutDeliverabilityDashboardOptionResponse]
ReadPrec PutDeliverabilityDashboardOptionResponse
Int -> ReadS PutDeliverabilityDashboardOptionResponse
ReadS [PutDeliverabilityDashboardOptionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutDeliverabilityDashboardOptionResponse]
$creadListPrec :: ReadPrec [PutDeliverabilityDashboardOptionResponse]
readPrec :: ReadPrec PutDeliverabilityDashboardOptionResponse
$creadPrec :: ReadPrec PutDeliverabilityDashboardOptionResponse
readList :: ReadS [PutDeliverabilityDashboardOptionResponse]
$creadList :: ReadS [PutDeliverabilityDashboardOptionResponse]
readsPrec :: Int -> ReadS PutDeliverabilityDashboardOptionResponse
$creadsPrec :: Int -> ReadS PutDeliverabilityDashboardOptionResponse
Prelude.Read, Int -> PutDeliverabilityDashboardOptionResponse -> ShowS
[PutDeliverabilityDashboardOptionResponse] -> ShowS
PutDeliverabilityDashboardOptionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutDeliverabilityDashboardOptionResponse] -> ShowS
$cshowList :: [PutDeliverabilityDashboardOptionResponse] -> ShowS
show :: PutDeliverabilityDashboardOptionResponse -> String
$cshow :: PutDeliverabilityDashboardOptionResponse -> String
showsPrec :: Int -> PutDeliverabilityDashboardOptionResponse -> ShowS
$cshowsPrec :: Int -> PutDeliverabilityDashboardOptionResponse -> ShowS
Prelude.Show, forall x.
Rep PutDeliverabilityDashboardOptionResponse x
-> PutDeliverabilityDashboardOptionResponse
forall x.
PutDeliverabilityDashboardOptionResponse
-> Rep PutDeliverabilityDashboardOptionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutDeliverabilityDashboardOptionResponse x
-> PutDeliverabilityDashboardOptionResponse
$cfrom :: forall x.
PutDeliverabilityDashboardOptionResponse
-> Rep PutDeliverabilityDashboardOptionResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutDeliverabilityDashboardOptionResponse' 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', 'putDeliverabilityDashboardOptionResponse_httpStatus' - The response's http status code.
newPutDeliverabilityDashboardOptionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutDeliverabilityDashboardOptionResponse
newPutDeliverabilityDashboardOptionResponse :: Int -> PutDeliverabilityDashboardOptionResponse
newPutDeliverabilityDashboardOptionResponse
  Int
pHttpStatus_ =
    PutDeliverabilityDashboardOptionResponse'
      { $sel:httpStatus:PutDeliverabilityDashboardOptionResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

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

instance
  Prelude.NFData
    PutDeliverabilityDashboardOptionResponse
  where
  rnf :: PutDeliverabilityDashboardOptionResponse -> ()
rnf PutDeliverabilityDashboardOptionResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutDeliverabilityDashboardOptionResponse' :: PutDeliverabilityDashboardOptionResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus