{-# 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.GetOperationDetail
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This operation returns the current status of an operation that is not
-- completed.
module Amazonka.Route53Domains.GetOperationDetail
  ( -- * Creating a Request
    GetOperationDetail (..),
    newGetOperationDetail,

    -- * Request Lenses
    getOperationDetail_operationId,

    -- * Destructuring the Response
    GetOperationDetailResponse (..),
    newGetOperationDetailResponse,

    -- * Response Lenses
    getOperationDetailResponse_domainName,
    getOperationDetailResponse_lastUpdatedDate,
    getOperationDetailResponse_message,
    getOperationDetailResponse_operationId,
    getOperationDetailResponse_status,
    getOperationDetailResponse_statusFlag,
    getOperationDetailResponse_submittedDate,
    getOperationDetailResponse_type,
    getOperationDetailResponse_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.Route53Domains.Types

-- | The
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_GetOperationDetail.html GetOperationDetail>
-- request includes the following element.
--
-- /See:/ 'newGetOperationDetail' smart constructor.
data GetOperationDetail = GetOperationDetail'
  { -- | The identifier for the operation for which you want to get the status.
    -- Route 53 returned the identifier in the response to the original
    -- request.
    GetOperationDetail -> Text
operationId :: Prelude.Text
  }
  deriving (GetOperationDetail -> GetOperationDetail -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetOperationDetail -> GetOperationDetail -> Bool
$c/= :: GetOperationDetail -> GetOperationDetail -> Bool
== :: GetOperationDetail -> GetOperationDetail -> Bool
$c== :: GetOperationDetail -> GetOperationDetail -> Bool
Prelude.Eq, ReadPrec [GetOperationDetail]
ReadPrec GetOperationDetail
Int -> ReadS GetOperationDetail
ReadS [GetOperationDetail]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetOperationDetail]
$creadListPrec :: ReadPrec [GetOperationDetail]
readPrec :: ReadPrec GetOperationDetail
$creadPrec :: ReadPrec GetOperationDetail
readList :: ReadS [GetOperationDetail]
$creadList :: ReadS [GetOperationDetail]
readsPrec :: Int -> ReadS GetOperationDetail
$creadsPrec :: Int -> ReadS GetOperationDetail
Prelude.Read, Int -> GetOperationDetail -> ShowS
[GetOperationDetail] -> ShowS
GetOperationDetail -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetOperationDetail] -> ShowS
$cshowList :: [GetOperationDetail] -> ShowS
show :: GetOperationDetail -> String
$cshow :: GetOperationDetail -> String
showsPrec :: Int -> GetOperationDetail -> ShowS
$cshowsPrec :: Int -> GetOperationDetail -> ShowS
Prelude.Show, forall x. Rep GetOperationDetail x -> GetOperationDetail
forall x. GetOperationDetail -> Rep GetOperationDetail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetOperationDetail x -> GetOperationDetail
$cfrom :: forall x. GetOperationDetail -> Rep GetOperationDetail x
Prelude.Generic)

-- |
-- Create a value of 'GetOperationDetail' 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', 'getOperationDetail_operationId' - The identifier for the operation for which you want to get the status.
-- Route 53 returned the identifier in the response to the original
-- request.
newGetOperationDetail ::
  -- | 'operationId'
  Prelude.Text ->
  GetOperationDetail
newGetOperationDetail :: Text -> GetOperationDetail
newGetOperationDetail Text
pOperationId_ =
  GetOperationDetail' {$sel:operationId:GetOperationDetail' :: Text
operationId = Text
pOperationId_}

-- | The identifier for the operation for which you want to get the status.
-- Route 53 returned the identifier in the response to the original
-- request.
getOperationDetail_operationId :: Lens.Lens' GetOperationDetail Prelude.Text
getOperationDetail_operationId :: Lens' GetOperationDetail Text
getOperationDetail_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOperationDetail' {Text
operationId :: Text
$sel:operationId:GetOperationDetail' :: GetOperationDetail -> Text
operationId} -> Text
operationId) (\s :: GetOperationDetail
s@GetOperationDetail' {} Text
a -> GetOperationDetail
s {$sel:operationId:GetOperationDetail' :: Text
operationId = Text
a} :: GetOperationDetail)

instance Core.AWSRequest GetOperationDetail where
  type
    AWSResponse GetOperationDetail =
      GetOperationDetailResponse
  request :: (Service -> Service)
-> GetOperationDetail -> Request GetOperationDetail
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 GetOperationDetail
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetOperationDetail)))
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 ->
          Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe OperationStatus
-> Maybe StatusFlag
-> Maybe POSIX
-> Maybe OperationType
-> Int
-> GetOperationDetailResponse
GetOperationDetailResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DomainName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LastUpdatedDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Message")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"OperationId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StatusFlag")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SubmittedDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Type")
            forall (f :: * -> *) a b. Applicative f => 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 GetOperationDetail where
  hashWithSalt :: Int -> GetOperationDetail -> Int
hashWithSalt Int
_salt GetOperationDetail' {Text
operationId :: Text
$sel:operationId:GetOperationDetail' :: GetOperationDetail -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
operationId

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

instance Data.ToHeaders GetOperationDetail where
  toHeaders :: GetOperationDetail -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"Route53Domains_v20140515.GetOperationDetail" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON GetOperationDetail where
  toJSON :: GetOperationDetail -> Value
toJSON GetOperationDetail' {Text
operationId :: Text
$sel:operationId:GetOperationDetail' :: GetOperationDetail -> 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 GetOperationDetail where
  toPath :: GetOperationDetail -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | The GetOperationDetail response includes the following elements.
--
-- /See:/ 'newGetOperationDetailResponse' smart constructor.
data GetOperationDetailResponse = GetOperationDetailResponse'
  { -- | The name of a domain.
    GetOperationDetailResponse -> Maybe Text
domainName :: Prelude.Maybe Prelude.Text,
    -- | The date when the operation was last updated.
    GetOperationDetailResponse -> Maybe POSIX
lastUpdatedDate :: Prelude.Maybe Data.POSIX,
    -- | Detailed information on the status including possible errors.
    GetOperationDetailResponse -> Maybe Text
message :: Prelude.Maybe Prelude.Text,
    -- | The identifier for the operation.
    GetOperationDetailResponse -> Maybe Text
operationId :: Prelude.Maybe Prelude.Text,
    -- | The current status of the requested operation in the system.
    GetOperationDetailResponse -> Maybe OperationStatus
status :: Prelude.Maybe OperationStatus,
    -- | Lists any outstanding operations that require customer action. Valid
    -- values are:
    --
    -- -   @PENDING_ACCEPTANCE@: The operation is waiting for acceptance from
    --     the account that is receiving the domain.
    --
    -- -   @PENDING_CUSTOMER_ACTION@: The operation is waiting for customer
    --     action, for example, returning an email.
    --
    -- -   @PENDING_AUTHORIZATION@: The operation is waiting for the form of
    --     authorization. For more information, see
    --     <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_ResendOperationAuthorization.html ResendOperationAuthorization>.
    --
    -- -   @PENDING_PAYMENT_VERIFICATION@: The operation is waiting for the
    --     payment method to validate.
    --
    -- -   @PENDING_SUPPORT_CASE@: The operation includes a support case and is
    --     waiting for its resolution.
    GetOperationDetailResponse -> Maybe StatusFlag
statusFlag :: Prelude.Maybe StatusFlag,
    -- | The date when the request was submitted.
    GetOperationDetailResponse -> Maybe POSIX
submittedDate :: Prelude.Maybe Data.POSIX,
    -- | The type of operation that was requested.
    GetOperationDetailResponse -> Maybe OperationType
type' :: Prelude.Maybe OperationType,
    -- | The response's http status code.
    GetOperationDetailResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetOperationDetailResponse -> GetOperationDetailResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetOperationDetailResponse -> GetOperationDetailResponse -> Bool
$c/= :: GetOperationDetailResponse -> GetOperationDetailResponse -> Bool
== :: GetOperationDetailResponse -> GetOperationDetailResponse -> Bool
$c== :: GetOperationDetailResponse -> GetOperationDetailResponse -> Bool
Prelude.Eq, ReadPrec [GetOperationDetailResponse]
ReadPrec GetOperationDetailResponse
Int -> ReadS GetOperationDetailResponse
ReadS [GetOperationDetailResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetOperationDetailResponse]
$creadListPrec :: ReadPrec [GetOperationDetailResponse]
readPrec :: ReadPrec GetOperationDetailResponse
$creadPrec :: ReadPrec GetOperationDetailResponse
readList :: ReadS [GetOperationDetailResponse]
$creadList :: ReadS [GetOperationDetailResponse]
readsPrec :: Int -> ReadS GetOperationDetailResponse
$creadsPrec :: Int -> ReadS GetOperationDetailResponse
Prelude.Read, Int -> GetOperationDetailResponse -> ShowS
[GetOperationDetailResponse] -> ShowS
GetOperationDetailResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetOperationDetailResponse] -> ShowS
$cshowList :: [GetOperationDetailResponse] -> ShowS
show :: GetOperationDetailResponse -> String
$cshow :: GetOperationDetailResponse -> String
showsPrec :: Int -> GetOperationDetailResponse -> ShowS
$cshowsPrec :: Int -> GetOperationDetailResponse -> ShowS
Prelude.Show, forall x.
Rep GetOperationDetailResponse x -> GetOperationDetailResponse
forall x.
GetOperationDetailResponse -> Rep GetOperationDetailResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetOperationDetailResponse x -> GetOperationDetailResponse
$cfrom :: forall x.
GetOperationDetailResponse -> Rep GetOperationDetailResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetOperationDetailResponse' 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:
--
-- 'domainName', 'getOperationDetailResponse_domainName' - The name of a domain.
--
-- 'lastUpdatedDate', 'getOperationDetailResponse_lastUpdatedDate' - The date when the operation was last updated.
--
-- 'message', 'getOperationDetailResponse_message' - Detailed information on the status including possible errors.
--
-- 'operationId', 'getOperationDetailResponse_operationId' - The identifier for the operation.
--
-- 'status', 'getOperationDetailResponse_status' - The current status of the requested operation in the system.
--
-- 'statusFlag', 'getOperationDetailResponse_statusFlag' - Lists any outstanding operations that require customer action. Valid
-- values are:
--
-- -   @PENDING_ACCEPTANCE@: The operation is waiting for acceptance from
--     the account that is receiving the domain.
--
-- -   @PENDING_CUSTOMER_ACTION@: The operation is waiting for customer
--     action, for example, returning an email.
--
-- -   @PENDING_AUTHORIZATION@: The operation is waiting for the form of
--     authorization. For more information, see
--     <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_ResendOperationAuthorization.html ResendOperationAuthorization>.
--
-- -   @PENDING_PAYMENT_VERIFICATION@: The operation is waiting for the
--     payment method to validate.
--
-- -   @PENDING_SUPPORT_CASE@: The operation includes a support case and is
--     waiting for its resolution.
--
-- 'submittedDate', 'getOperationDetailResponse_submittedDate' - The date when the request was submitted.
--
-- 'type'', 'getOperationDetailResponse_type' - The type of operation that was requested.
--
-- 'httpStatus', 'getOperationDetailResponse_httpStatus' - The response's http status code.
newGetOperationDetailResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetOperationDetailResponse
newGetOperationDetailResponse :: Int -> GetOperationDetailResponse
newGetOperationDetailResponse Int
pHttpStatus_ =
  GetOperationDetailResponse'
    { $sel:domainName:GetOperationDetailResponse' :: Maybe Text
domainName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedDate:GetOperationDetailResponse' :: Maybe POSIX
lastUpdatedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:message:GetOperationDetailResponse' :: Maybe Text
message = forall a. Maybe a
Prelude.Nothing,
      $sel:operationId:GetOperationDetailResponse' :: Maybe Text
operationId = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetOperationDetailResponse' :: Maybe OperationStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusFlag:GetOperationDetailResponse' :: Maybe StatusFlag
statusFlag = forall a. Maybe a
Prelude.Nothing,
      $sel:submittedDate:GetOperationDetailResponse' :: Maybe POSIX
submittedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:type':GetOperationDetailResponse' :: Maybe OperationType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetOperationDetailResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The name of a domain.
getOperationDetailResponse_domainName :: Lens.Lens' GetOperationDetailResponse (Prelude.Maybe Prelude.Text)
getOperationDetailResponse_domainName :: Lens' GetOperationDetailResponse (Maybe Text)
getOperationDetailResponse_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOperationDetailResponse' {Maybe Text
domainName :: Maybe Text
$sel:domainName:GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe Text
domainName} -> Maybe Text
domainName) (\s :: GetOperationDetailResponse
s@GetOperationDetailResponse' {} Maybe Text
a -> GetOperationDetailResponse
s {$sel:domainName:GetOperationDetailResponse' :: Maybe Text
domainName = Maybe Text
a} :: GetOperationDetailResponse)

-- | The date when the operation was last updated.
getOperationDetailResponse_lastUpdatedDate :: Lens.Lens' GetOperationDetailResponse (Prelude.Maybe Prelude.UTCTime)
getOperationDetailResponse_lastUpdatedDate :: Lens' GetOperationDetailResponse (Maybe UTCTime)
getOperationDetailResponse_lastUpdatedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOperationDetailResponse' {Maybe POSIX
lastUpdatedDate :: Maybe POSIX
$sel:lastUpdatedDate:GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe POSIX
lastUpdatedDate} -> Maybe POSIX
lastUpdatedDate) (\s :: GetOperationDetailResponse
s@GetOperationDetailResponse' {} Maybe POSIX
a -> GetOperationDetailResponse
s {$sel:lastUpdatedDate:GetOperationDetailResponse' :: Maybe POSIX
lastUpdatedDate = Maybe POSIX
a} :: GetOperationDetailResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Detailed information on the status including possible errors.
getOperationDetailResponse_message :: Lens.Lens' GetOperationDetailResponse (Prelude.Maybe Prelude.Text)
getOperationDetailResponse_message :: Lens' GetOperationDetailResponse (Maybe Text)
getOperationDetailResponse_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOperationDetailResponse' {Maybe Text
message :: Maybe Text
$sel:message:GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe Text
message} -> Maybe Text
message) (\s :: GetOperationDetailResponse
s@GetOperationDetailResponse' {} Maybe Text
a -> GetOperationDetailResponse
s {$sel:message:GetOperationDetailResponse' :: Maybe Text
message = Maybe Text
a} :: GetOperationDetailResponse)

-- | The identifier for the operation.
getOperationDetailResponse_operationId :: Lens.Lens' GetOperationDetailResponse (Prelude.Maybe Prelude.Text)
getOperationDetailResponse_operationId :: Lens' GetOperationDetailResponse (Maybe Text)
getOperationDetailResponse_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOperationDetailResponse' {Maybe Text
operationId :: Maybe Text
$sel:operationId:GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe Text
operationId} -> Maybe Text
operationId) (\s :: GetOperationDetailResponse
s@GetOperationDetailResponse' {} Maybe Text
a -> GetOperationDetailResponse
s {$sel:operationId:GetOperationDetailResponse' :: Maybe Text
operationId = Maybe Text
a} :: GetOperationDetailResponse)

-- | The current status of the requested operation in the system.
getOperationDetailResponse_status :: Lens.Lens' GetOperationDetailResponse (Prelude.Maybe OperationStatus)
getOperationDetailResponse_status :: Lens' GetOperationDetailResponse (Maybe OperationStatus)
getOperationDetailResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOperationDetailResponse' {Maybe OperationStatus
status :: Maybe OperationStatus
$sel:status:GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe OperationStatus
status} -> Maybe OperationStatus
status) (\s :: GetOperationDetailResponse
s@GetOperationDetailResponse' {} Maybe OperationStatus
a -> GetOperationDetailResponse
s {$sel:status:GetOperationDetailResponse' :: Maybe OperationStatus
status = Maybe OperationStatus
a} :: GetOperationDetailResponse)

-- | Lists any outstanding operations that require customer action. Valid
-- values are:
--
-- -   @PENDING_ACCEPTANCE@: The operation is waiting for acceptance from
--     the account that is receiving the domain.
--
-- -   @PENDING_CUSTOMER_ACTION@: The operation is waiting for customer
--     action, for example, returning an email.
--
-- -   @PENDING_AUTHORIZATION@: The operation is waiting for the form of
--     authorization. For more information, see
--     <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_ResendOperationAuthorization.html ResendOperationAuthorization>.
--
-- -   @PENDING_PAYMENT_VERIFICATION@: The operation is waiting for the
--     payment method to validate.
--
-- -   @PENDING_SUPPORT_CASE@: The operation includes a support case and is
--     waiting for its resolution.
getOperationDetailResponse_statusFlag :: Lens.Lens' GetOperationDetailResponse (Prelude.Maybe StatusFlag)
getOperationDetailResponse_statusFlag :: Lens' GetOperationDetailResponse (Maybe StatusFlag)
getOperationDetailResponse_statusFlag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOperationDetailResponse' {Maybe StatusFlag
statusFlag :: Maybe StatusFlag
$sel:statusFlag:GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe StatusFlag
statusFlag} -> Maybe StatusFlag
statusFlag) (\s :: GetOperationDetailResponse
s@GetOperationDetailResponse' {} Maybe StatusFlag
a -> GetOperationDetailResponse
s {$sel:statusFlag:GetOperationDetailResponse' :: Maybe StatusFlag
statusFlag = Maybe StatusFlag
a} :: GetOperationDetailResponse)

-- | The date when the request was submitted.
getOperationDetailResponse_submittedDate :: Lens.Lens' GetOperationDetailResponse (Prelude.Maybe Prelude.UTCTime)
getOperationDetailResponse_submittedDate :: Lens' GetOperationDetailResponse (Maybe UTCTime)
getOperationDetailResponse_submittedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOperationDetailResponse' {Maybe POSIX
submittedDate :: Maybe POSIX
$sel:submittedDate:GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe POSIX
submittedDate} -> Maybe POSIX
submittedDate) (\s :: GetOperationDetailResponse
s@GetOperationDetailResponse' {} Maybe POSIX
a -> GetOperationDetailResponse
s {$sel:submittedDate:GetOperationDetailResponse' :: Maybe POSIX
submittedDate = Maybe POSIX
a} :: GetOperationDetailResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The type of operation that was requested.
getOperationDetailResponse_type :: Lens.Lens' GetOperationDetailResponse (Prelude.Maybe OperationType)
getOperationDetailResponse_type :: Lens' GetOperationDetailResponse (Maybe OperationType)
getOperationDetailResponse_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOperationDetailResponse' {Maybe OperationType
type' :: Maybe OperationType
$sel:type':GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe OperationType
type'} -> Maybe OperationType
type') (\s :: GetOperationDetailResponse
s@GetOperationDetailResponse' {} Maybe OperationType
a -> GetOperationDetailResponse
s {$sel:type':GetOperationDetailResponse' :: Maybe OperationType
type' = Maybe OperationType
a} :: GetOperationDetailResponse)

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

instance Prelude.NFData GetOperationDetailResponse where
  rnf :: GetOperationDetailResponse -> ()
rnf GetOperationDetailResponse' {Int
Maybe Text
Maybe POSIX
Maybe OperationStatus
Maybe OperationType
Maybe StatusFlag
httpStatus :: Int
type' :: Maybe OperationType
submittedDate :: Maybe POSIX
statusFlag :: Maybe StatusFlag
status :: Maybe OperationStatus
operationId :: Maybe Text
message :: Maybe Text
lastUpdatedDate :: Maybe POSIX
domainName :: Maybe Text
$sel:httpStatus:GetOperationDetailResponse' :: GetOperationDetailResponse -> Int
$sel:type':GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe OperationType
$sel:submittedDate:GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe POSIX
$sel:statusFlag:GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe StatusFlag
$sel:status:GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe OperationStatus
$sel:operationId:GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe Text
$sel:message:GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe Text
$sel:lastUpdatedDate:GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe POSIX
$sel:domainName:GetOperationDetailResponse' :: GetOperationDetailResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
message
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
operationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OperationStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StatusFlag
statusFlag
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
submittedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OperationType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus