{-# 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.PutEmailIdentityDkimAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Used to enable or disable DKIM authentication for an email identity.
module Amazonka.SESV2.PutEmailIdentityDkimAttributes
  ( -- * Creating a Request
    PutEmailIdentityDkimAttributes (..),
    newPutEmailIdentityDkimAttributes,

    -- * Request Lenses
    putEmailIdentityDkimAttributes_signingEnabled,
    putEmailIdentityDkimAttributes_emailIdentity,

    -- * Destructuring the Response
    PutEmailIdentityDkimAttributesResponse (..),
    newPutEmailIdentityDkimAttributesResponse,

    -- * Response Lenses
    putEmailIdentityDkimAttributesResponse_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

-- | A request to enable or disable DKIM signing of email that you send from
-- an email identity.
--
-- /See:/ 'newPutEmailIdentityDkimAttributes' smart constructor.
data PutEmailIdentityDkimAttributes = PutEmailIdentityDkimAttributes'
  { -- | Sets the DKIM signing configuration for the identity.
    --
    -- When you set this value @true@, then the messages that are sent from the
    -- identity are signed using DKIM. If you set this value to @false@, your
    -- messages are sent without DKIM signing.
    PutEmailIdentityDkimAttributes -> Maybe Bool
signingEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The email identity.
    PutEmailIdentityDkimAttributes -> Text
emailIdentity :: Prelude.Text
  }
  deriving (PutEmailIdentityDkimAttributes
-> PutEmailIdentityDkimAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutEmailIdentityDkimAttributes
-> PutEmailIdentityDkimAttributes -> Bool
$c/= :: PutEmailIdentityDkimAttributes
-> PutEmailIdentityDkimAttributes -> Bool
== :: PutEmailIdentityDkimAttributes
-> PutEmailIdentityDkimAttributes -> Bool
$c== :: PutEmailIdentityDkimAttributes
-> PutEmailIdentityDkimAttributes -> Bool
Prelude.Eq, ReadPrec [PutEmailIdentityDkimAttributes]
ReadPrec PutEmailIdentityDkimAttributes
Int -> ReadS PutEmailIdentityDkimAttributes
ReadS [PutEmailIdentityDkimAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutEmailIdentityDkimAttributes]
$creadListPrec :: ReadPrec [PutEmailIdentityDkimAttributes]
readPrec :: ReadPrec PutEmailIdentityDkimAttributes
$creadPrec :: ReadPrec PutEmailIdentityDkimAttributes
readList :: ReadS [PutEmailIdentityDkimAttributes]
$creadList :: ReadS [PutEmailIdentityDkimAttributes]
readsPrec :: Int -> ReadS PutEmailIdentityDkimAttributes
$creadsPrec :: Int -> ReadS PutEmailIdentityDkimAttributes
Prelude.Read, Int -> PutEmailIdentityDkimAttributes -> ShowS
[PutEmailIdentityDkimAttributes] -> ShowS
PutEmailIdentityDkimAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutEmailIdentityDkimAttributes] -> ShowS
$cshowList :: [PutEmailIdentityDkimAttributes] -> ShowS
show :: PutEmailIdentityDkimAttributes -> String
$cshow :: PutEmailIdentityDkimAttributes -> String
showsPrec :: Int -> PutEmailIdentityDkimAttributes -> ShowS
$cshowsPrec :: Int -> PutEmailIdentityDkimAttributes -> ShowS
Prelude.Show, forall x.
Rep PutEmailIdentityDkimAttributes x
-> PutEmailIdentityDkimAttributes
forall x.
PutEmailIdentityDkimAttributes
-> Rep PutEmailIdentityDkimAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutEmailIdentityDkimAttributes x
-> PutEmailIdentityDkimAttributes
$cfrom :: forall x.
PutEmailIdentityDkimAttributes
-> Rep PutEmailIdentityDkimAttributes x
Prelude.Generic)

-- |
-- Create a value of 'PutEmailIdentityDkimAttributes' 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:
--
-- 'signingEnabled', 'putEmailIdentityDkimAttributes_signingEnabled' - Sets the DKIM signing configuration for the identity.
--
-- When you set this value @true@, then the messages that are sent from the
-- identity are signed using DKIM. If you set this value to @false@, your
-- messages are sent without DKIM signing.
--
-- 'emailIdentity', 'putEmailIdentityDkimAttributes_emailIdentity' - The email identity.
newPutEmailIdentityDkimAttributes ::
  -- | 'emailIdentity'
  Prelude.Text ->
  PutEmailIdentityDkimAttributes
newPutEmailIdentityDkimAttributes :: Text -> PutEmailIdentityDkimAttributes
newPutEmailIdentityDkimAttributes Text
pEmailIdentity_ =
  PutEmailIdentityDkimAttributes'
    { $sel:signingEnabled:PutEmailIdentityDkimAttributes' :: Maybe Bool
signingEnabled =
        forall a. Maybe a
Prelude.Nothing,
      $sel:emailIdentity:PutEmailIdentityDkimAttributes' :: Text
emailIdentity = Text
pEmailIdentity_
    }

-- | Sets the DKIM signing configuration for the identity.
--
-- When you set this value @true@, then the messages that are sent from the
-- identity are signed using DKIM. If you set this value to @false@, your
-- messages are sent without DKIM signing.
putEmailIdentityDkimAttributes_signingEnabled :: Lens.Lens' PutEmailIdentityDkimAttributes (Prelude.Maybe Prelude.Bool)
putEmailIdentityDkimAttributes_signingEnabled :: Lens' PutEmailIdentityDkimAttributes (Maybe Bool)
putEmailIdentityDkimAttributes_signingEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEmailIdentityDkimAttributes' {Maybe Bool
signingEnabled :: Maybe Bool
$sel:signingEnabled:PutEmailIdentityDkimAttributes' :: PutEmailIdentityDkimAttributes -> Maybe Bool
signingEnabled} -> Maybe Bool
signingEnabled) (\s :: PutEmailIdentityDkimAttributes
s@PutEmailIdentityDkimAttributes' {} Maybe Bool
a -> PutEmailIdentityDkimAttributes
s {$sel:signingEnabled:PutEmailIdentityDkimAttributes' :: Maybe Bool
signingEnabled = Maybe Bool
a} :: PutEmailIdentityDkimAttributes)

-- | The email identity.
putEmailIdentityDkimAttributes_emailIdentity :: Lens.Lens' PutEmailIdentityDkimAttributes Prelude.Text
putEmailIdentityDkimAttributes_emailIdentity :: Lens' PutEmailIdentityDkimAttributes Text
putEmailIdentityDkimAttributes_emailIdentity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEmailIdentityDkimAttributes' {Text
emailIdentity :: Text
$sel:emailIdentity:PutEmailIdentityDkimAttributes' :: PutEmailIdentityDkimAttributes -> Text
emailIdentity} -> Text
emailIdentity) (\s :: PutEmailIdentityDkimAttributes
s@PutEmailIdentityDkimAttributes' {} Text
a -> PutEmailIdentityDkimAttributes
s {$sel:emailIdentity:PutEmailIdentityDkimAttributes' :: Text
emailIdentity = Text
a} :: PutEmailIdentityDkimAttributes)

instance
  Core.AWSRequest
    PutEmailIdentityDkimAttributes
  where
  type
    AWSResponse PutEmailIdentityDkimAttributes =
      PutEmailIdentityDkimAttributesResponse
  request :: (Service -> Service)
-> PutEmailIdentityDkimAttributes
-> Request PutEmailIdentityDkimAttributes
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 PutEmailIdentityDkimAttributes
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse PutEmailIdentityDkimAttributes)))
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 -> PutEmailIdentityDkimAttributesResponse
PutEmailIdentityDkimAttributesResponse'
            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
    PutEmailIdentityDkimAttributes
  where
  hashWithSalt :: Int -> PutEmailIdentityDkimAttributes -> Int
hashWithSalt
    Int
_salt
    PutEmailIdentityDkimAttributes' {Maybe Bool
Text
emailIdentity :: Text
signingEnabled :: Maybe Bool
$sel:emailIdentity:PutEmailIdentityDkimAttributes' :: PutEmailIdentityDkimAttributes -> Text
$sel:signingEnabled:PutEmailIdentityDkimAttributes' :: PutEmailIdentityDkimAttributes -> Maybe Bool
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
signingEnabled
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
emailIdentity

instance
  Prelude.NFData
    PutEmailIdentityDkimAttributes
  where
  rnf :: PutEmailIdentityDkimAttributes -> ()
rnf PutEmailIdentityDkimAttributes' {Maybe Bool
Text
emailIdentity :: Text
signingEnabled :: Maybe Bool
$sel:emailIdentity:PutEmailIdentityDkimAttributes' :: PutEmailIdentityDkimAttributes -> Text
$sel:signingEnabled:PutEmailIdentityDkimAttributes' :: PutEmailIdentityDkimAttributes -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
signingEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
emailIdentity

instance
  Data.ToHeaders
    PutEmailIdentityDkimAttributes
  where
  toHeaders :: PutEmailIdentityDkimAttributes -> 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 PutEmailIdentityDkimAttributes where
  toJSON :: PutEmailIdentityDkimAttributes -> Value
toJSON PutEmailIdentityDkimAttributes' {Maybe Bool
Text
emailIdentity :: Text
signingEnabled :: Maybe Bool
$sel:emailIdentity:PutEmailIdentityDkimAttributes' :: PutEmailIdentityDkimAttributes -> Text
$sel:signingEnabled:PutEmailIdentityDkimAttributes' :: PutEmailIdentityDkimAttributes -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"SigningEnabled" 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 Bool
signingEnabled
          ]
      )

instance Data.ToPath PutEmailIdentityDkimAttributes where
  toPath :: PutEmailIdentityDkimAttributes -> ByteString
toPath PutEmailIdentityDkimAttributes' {Maybe Bool
Text
emailIdentity :: Text
signingEnabled :: Maybe Bool
$sel:emailIdentity:PutEmailIdentityDkimAttributes' :: PutEmailIdentityDkimAttributes -> Text
$sel:signingEnabled:PutEmailIdentityDkimAttributes' :: PutEmailIdentityDkimAttributes -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v2/email/identities/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
emailIdentity,
        ByteString
"/dkim"
      ]

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

-- | An HTTP 200 response if the request succeeds, or an error message if the
-- request fails.
--
-- /See:/ 'newPutEmailIdentityDkimAttributesResponse' smart constructor.
data PutEmailIdentityDkimAttributesResponse = PutEmailIdentityDkimAttributesResponse'
  { -- | The response's http status code.
    PutEmailIdentityDkimAttributesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutEmailIdentityDkimAttributesResponse
-> PutEmailIdentityDkimAttributesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutEmailIdentityDkimAttributesResponse
-> PutEmailIdentityDkimAttributesResponse -> Bool
$c/= :: PutEmailIdentityDkimAttributesResponse
-> PutEmailIdentityDkimAttributesResponse -> Bool
== :: PutEmailIdentityDkimAttributesResponse
-> PutEmailIdentityDkimAttributesResponse -> Bool
$c== :: PutEmailIdentityDkimAttributesResponse
-> PutEmailIdentityDkimAttributesResponse -> Bool
Prelude.Eq, ReadPrec [PutEmailIdentityDkimAttributesResponse]
ReadPrec PutEmailIdentityDkimAttributesResponse
Int -> ReadS PutEmailIdentityDkimAttributesResponse
ReadS [PutEmailIdentityDkimAttributesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutEmailIdentityDkimAttributesResponse]
$creadListPrec :: ReadPrec [PutEmailIdentityDkimAttributesResponse]
readPrec :: ReadPrec PutEmailIdentityDkimAttributesResponse
$creadPrec :: ReadPrec PutEmailIdentityDkimAttributesResponse
readList :: ReadS [PutEmailIdentityDkimAttributesResponse]
$creadList :: ReadS [PutEmailIdentityDkimAttributesResponse]
readsPrec :: Int -> ReadS PutEmailIdentityDkimAttributesResponse
$creadsPrec :: Int -> ReadS PutEmailIdentityDkimAttributesResponse
Prelude.Read, Int -> PutEmailIdentityDkimAttributesResponse -> ShowS
[PutEmailIdentityDkimAttributesResponse] -> ShowS
PutEmailIdentityDkimAttributesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutEmailIdentityDkimAttributesResponse] -> ShowS
$cshowList :: [PutEmailIdentityDkimAttributesResponse] -> ShowS
show :: PutEmailIdentityDkimAttributesResponse -> String
$cshow :: PutEmailIdentityDkimAttributesResponse -> String
showsPrec :: Int -> PutEmailIdentityDkimAttributesResponse -> ShowS
$cshowsPrec :: Int -> PutEmailIdentityDkimAttributesResponse -> ShowS
Prelude.Show, forall x.
Rep PutEmailIdentityDkimAttributesResponse x
-> PutEmailIdentityDkimAttributesResponse
forall x.
PutEmailIdentityDkimAttributesResponse
-> Rep PutEmailIdentityDkimAttributesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutEmailIdentityDkimAttributesResponse x
-> PutEmailIdentityDkimAttributesResponse
$cfrom :: forall x.
PutEmailIdentityDkimAttributesResponse
-> Rep PutEmailIdentityDkimAttributesResponse x
Prelude.Generic)

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

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

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