{-# 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.Route53Domains.ResendOperationAuthorization
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Resend the form of authorization email for this operation.
module Amazonka.Route53Domains.ResendOperationAuthorization
  ( -- * Creating a Request
    ResendOperationAuthorization (..),
    newResendOperationAuthorization,

    -- * Request Lenses
    resendOperationAuthorization_operationId,

    -- * Destructuring the Response
    ResendOperationAuthorizationResponse (..),
    newResendOperationAuthorizationResponse,
  )
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.Route53Domains.Types

-- | /See:/ 'newResendOperationAuthorization' smart constructor.
data ResendOperationAuthorization = ResendOperationAuthorization'
  { -- | Operation ID.
    ResendOperationAuthorization -> Text
operationId :: Prelude.Text
  }
  deriving (ResendOperationAuthorization
-> ResendOperationAuthorization -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResendOperationAuthorization
-> ResendOperationAuthorization -> Bool
$c/= :: ResendOperationAuthorization
-> ResendOperationAuthorization -> Bool
== :: ResendOperationAuthorization
-> ResendOperationAuthorization -> Bool
$c== :: ResendOperationAuthorization
-> ResendOperationAuthorization -> Bool
Prelude.Eq, ReadPrec [ResendOperationAuthorization]
ReadPrec ResendOperationAuthorization
Int -> ReadS ResendOperationAuthorization
ReadS [ResendOperationAuthorization]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResendOperationAuthorization]
$creadListPrec :: ReadPrec [ResendOperationAuthorization]
readPrec :: ReadPrec ResendOperationAuthorization
$creadPrec :: ReadPrec ResendOperationAuthorization
readList :: ReadS [ResendOperationAuthorization]
$creadList :: ReadS [ResendOperationAuthorization]
readsPrec :: Int -> ReadS ResendOperationAuthorization
$creadsPrec :: Int -> ReadS ResendOperationAuthorization
Prelude.Read, Int -> ResendOperationAuthorization -> ShowS
[ResendOperationAuthorization] -> ShowS
ResendOperationAuthorization -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResendOperationAuthorization] -> ShowS
$cshowList :: [ResendOperationAuthorization] -> ShowS
show :: ResendOperationAuthorization -> String
$cshow :: ResendOperationAuthorization -> String
showsPrec :: Int -> ResendOperationAuthorization -> ShowS
$cshowsPrec :: Int -> ResendOperationAuthorization -> ShowS
Prelude.Show, forall x.
Rep ResendOperationAuthorization x -> ResendOperationAuthorization
forall x.
ResendOperationAuthorization -> Rep ResendOperationAuthorization x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ResendOperationAuthorization x -> ResendOperationAuthorization
$cfrom :: forall x.
ResendOperationAuthorization -> Rep ResendOperationAuthorization x
Prelude.Generic)

-- |
-- Create a value of 'ResendOperationAuthorization' 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:
--
-- 'operationId', 'resendOperationAuthorization_operationId' - Operation ID.
newResendOperationAuthorization ::
  -- | 'operationId'
  Prelude.Text ->
  ResendOperationAuthorization
newResendOperationAuthorization :: Text -> ResendOperationAuthorization
newResendOperationAuthorization Text
pOperationId_ =
  ResendOperationAuthorization'
    { $sel:operationId:ResendOperationAuthorization' :: Text
operationId =
        Text
pOperationId_
    }

-- | Operation ID.
resendOperationAuthorization_operationId :: Lens.Lens' ResendOperationAuthorization Prelude.Text
resendOperationAuthorization_operationId :: Lens' ResendOperationAuthorization Text
resendOperationAuthorization_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResendOperationAuthorization' {Text
operationId :: Text
$sel:operationId:ResendOperationAuthorization' :: ResendOperationAuthorization -> Text
operationId} -> Text
operationId) (\s :: ResendOperationAuthorization
s@ResendOperationAuthorization' {} Text
a -> ResendOperationAuthorization
s {$sel:operationId:ResendOperationAuthorization' :: Text
operationId = Text
a} :: ResendOperationAuthorization)

instance Core.AWSRequest ResendOperationAuthorization where
  type
    AWSResponse ResendOperationAuthorization =
      ResendOperationAuthorizationResponse
  request :: (Service -> Service)
-> ResendOperationAuthorization
-> Request ResendOperationAuthorization
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 ResendOperationAuthorization
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ResendOperationAuthorization)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      ResendOperationAuthorizationResponse
ResendOperationAuthorizationResponse'

instance
  Prelude.Hashable
    ResendOperationAuthorization
  where
  hashWithSalt :: Int -> ResendOperationAuthorization -> Int
hashWithSalt Int
_salt ResendOperationAuthorization' {Text
operationId :: Text
$sel:operationId:ResendOperationAuthorization' :: ResendOperationAuthorization -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
operationId

instance Prelude.NFData ResendOperationAuthorization where
  rnf :: ResendOperationAuthorization -> ()
rnf ResendOperationAuthorization' {Text
operationId :: Text
$sel:operationId:ResendOperationAuthorization' :: ResendOperationAuthorization -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
operationId

instance Data.ToHeaders ResendOperationAuthorization where
  toHeaders :: ResendOperationAuthorization -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"Route53Domains_v20140515.ResendOperationAuthorization" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ResendOperationAuthorization where
  toJSON :: ResendOperationAuthorization -> Value
toJSON ResendOperationAuthorization' {Text
operationId :: Text
$sel:operationId:ResendOperationAuthorization' :: ResendOperationAuthorization -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"OperationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
operationId)]
      )

instance Data.ToPath ResendOperationAuthorization where
  toPath :: ResendOperationAuthorization -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newResendOperationAuthorizationResponse' smart constructor.
data ResendOperationAuthorizationResponse = ResendOperationAuthorizationResponse'
  {
  }
  deriving (ResendOperationAuthorizationResponse
-> ResendOperationAuthorizationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResendOperationAuthorizationResponse
-> ResendOperationAuthorizationResponse -> Bool
$c/= :: ResendOperationAuthorizationResponse
-> ResendOperationAuthorizationResponse -> Bool
== :: ResendOperationAuthorizationResponse
-> ResendOperationAuthorizationResponse -> Bool
$c== :: ResendOperationAuthorizationResponse
-> ResendOperationAuthorizationResponse -> Bool
Prelude.Eq, ReadPrec [ResendOperationAuthorizationResponse]
ReadPrec ResendOperationAuthorizationResponse
Int -> ReadS ResendOperationAuthorizationResponse
ReadS [ResendOperationAuthorizationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResendOperationAuthorizationResponse]
$creadListPrec :: ReadPrec [ResendOperationAuthorizationResponse]
readPrec :: ReadPrec ResendOperationAuthorizationResponse
$creadPrec :: ReadPrec ResendOperationAuthorizationResponse
readList :: ReadS [ResendOperationAuthorizationResponse]
$creadList :: ReadS [ResendOperationAuthorizationResponse]
readsPrec :: Int -> ReadS ResendOperationAuthorizationResponse
$creadsPrec :: Int -> ReadS ResendOperationAuthorizationResponse
Prelude.Read, Int -> ResendOperationAuthorizationResponse -> ShowS
[ResendOperationAuthorizationResponse] -> ShowS
ResendOperationAuthorizationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResendOperationAuthorizationResponse] -> ShowS
$cshowList :: [ResendOperationAuthorizationResponse] -> ShowS
show :: ResendOperationAuthorizationResponse -> String
$cshow :: ResendOperationAuthorizationResponse -> String
showsPrec :: Int -> ResendOperationAuthorizationResponse -> ShowS
$cshowsPrec :: Int -> ResendOperationAuthorizationResponse -> ShowS
Prelude.Show, forall x.
Rep ResendOperationAuthorizationResponse x
-> ResendOperationAuthorizationResponse
forall x.
ResendOperationAuthorizationResponse
-> Rep ResendOperationAuthorizationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ResendOperationAuthorizationResponse x
-> ResendOperationAuthorizationResponse
$cfrom :: forall x.
ResendOperationAuthorizationResponse
-> Rep ResendOperationAuthorizationResponse x
Prelude.Generic)

-- |
-- Create a value of 'ResendOperationAuthorizationResponse' 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.
newResendOperationAuthorizationResponse ::
  ResendOperationAuthorizationResponse
newResendOperationAuthorizationResponse :: ResendOperationAuthorizationResponse
newResendOperationAuthorizationResponse =
  ResendOperationAuthorizationResponse
ResendOperationAuthorizationResponse'

instance
  Prelude.NFData
    ResendOperationAuthorizationResponse
  where
  rnf :: ResendOperationAuthorizationResponse -> ()
rnf ResendOperationAuthorizationResponse
_ = ()