{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.OperationSummary
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Route53Domains.Types.OperationSummary 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 Amazonka.Route53Domains.Types.OperationStatus
import Amazonka.Route53Domains.Types.OperationType
import Amazonka.Route53Domains.Types.StatusFlag

-- | OperationSummary includes the following elements.
--
-- /See:/ 'newOperationSummary' smart constructor.
data OperationSummary = OperationSummary'
  { -- | Name of the domain.
    OperationSummary -> Maybe Text
domainName :: Prelude.Maybe Prelude.Text,
    -- | The date when the last change was made in Unix time format and
    -- Coordinated Universal Time (UTC).
    OperationSummary -> Maybe POSIX
lastUpdatedDate :: Prelude.Maybe Data.POSIX,
    -- | Message about the operation.
    OperationSummary -> Maybe Text
message :: Prelude.Maybe Prelude.Text,
    -- | Identifier returned to track the requested action.
    OperationSummary -> Maybe Text
operationId :: Prelude.Maybe Prelude.Text,
    -- | The current status of the requested operation in the system.
    OperationSummary -> Maybe OperationStatus
status :: Prelude.Maybe OperationStatus,
    -- | Automatically checks whether there are no outstanding operations on
    -- domains that need customer attention.
    --
    -- 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.
    OperationSummary -> Maybe StatusFlag
statusFlag :: Prelude.Maybe StatusFlag,
    -- | The date when the request was submitted.
    OperationSummary -> Maybe POSIX
submittedDate :: Prelude.Maybe Data.POSIX,
    -- | Type of the action requested.
    OperationSummary -> Maybe OperationType
type' :: Prelude.Maybe OperationType
  }
  deriving (OperationSummary -> OperationSummary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperationSummary -> OperationSummary -> Bool
$c/= :: OperationSummary -> OperationSummary -> Bool
== :: OperationSummary -> OperationSummary -> Bool
$c== :: OperationSummary -> OperationSummary -> Bool
Prelude.Eq, ReadPrec [OperationSummary]
ReadPrec OperationSummary
Int -> ReadS OperationSummary
ReadS [OperationSummary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OperationSummary]
$creadListPrec :: ReadPrec [OperationSummary]
readPrec :: ReadPrec OperationSummary
$creadPrec :: ReadPrec OperationSummary
readList :: ReadS [OperationSummary]
$creadList :: ReadS [OperationSummary]
readsPrec :: Int -> ReadS OperationSummary
$creadsPrec :: Int -> ReadS OperationSummary
Prelude.Read, Int -> OperationSummary -> ShowS
[OperationSummary] -> ShowS
OperationSummary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OperationSummary] -> ShowS
$cshowList :: [OperationSummary] -> ShowS
show :: OperationSummary -> String
$cshow :: OperationSummary -> String
showsPrec :: Int -> OperationSummary -> ShowS
$cshowsPrec :: Int -> OperationSummary -> ShowS
Prelude.Show, forall x. Rep OperationSummary x -> OperationSummary
forall x. OperationSummary -> Rep OperationSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OperationSummary x -> OperationSummary
$cfrom :: forall x. OperationSummary -> Rep OperationSummary x
Prelude.Generic)

-- |
-- Create a value of 'OperationSummary' 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', 'operationSummary_domainName' - Name of the domain.
--
-- 'lastUpdatedDate', 'operationSummary_lastUpdatedDate' - The date when the last change was made in Unix time format and
-- Coordinated Universal Time (UTC).
--
-- 'message', 'operationSummary_message' - Message about the operation.
--
-- 'operationId', 'operationSummary_operationId' - Identifier returned to track the requested action.
--
-- 'status', 'operationSummary_status' - The current status of the requested operation in the system.
--
-- 'statusFlag', 'operationSummary_statusFlag' - Automatically checks whether there are no outstanding operations on
-- domains that need customer attention.
--
-- 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', 'operationSummary_submittedDate' - The date when the request was submitted.
--
-- 'type'', 'operationSummary_type' - Type of the action requested.
newOperationSummary ::
  OperationSummary
newOperationSummary :: OperationSummary
newOperationSummary =
  OperationSummary'
    { $sel:domainName:OperationSummary' :: Maybe Text
domainName = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedDate:OperationSummary' :: Maybe POSIX
lastUpdatedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:message:OperationSummary' :: Maybe Text
message = forall a. Maybe a
Prelude.Nothing,
      $sel:operationId:OperationSummary' :: Maybe Text
operationId = forall a. Maybe a
Prelude.Nothing,
      $sel:status:OperationSummary' :: Maybe OperationStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusFlag:OperationSummary' :: Maybe StatusFlag
statusFlag = forall a. Maybe a
Prelude.Nothing,
      $sel:submittedDate:OperationSummary' :: Maybe POSIX
submittedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:type':OperationSummary' :: Maybe OperationType
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | Name of the domain.
operationSummary_domainName :: Lens.Lens' OperationSummary (Prelude.Maybe Prelude.Text)
operationSummary_domainName :: Lens' OperationSummary (Maybe Text)
operationSummary_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OperationSummary' {Maybe Text
domainName :: Maybe Text
$sel:domainName:OperationSummary' :: OperationSummary -> Maybe Text
domainName} -> Maybe Text
domainName) (\s :: OperationSummary
s@OperationSummary' {} Maybe Text
a -> OperationSummary
s {$sel:domainName:OperationSummary' :: Maybe Text
domainName = Maybe Text
a} :: OperationSummary)

-- | The date when the last change was made in Unix time format and
-- Coordinated Universal Time (UTC).
operationSummary_lastUpdatedDate :: Lens.Lens' OperationSummary (Prelude.Maybe Prelude.UTCTime)
operationSummary_lastUpdatedDate :: Lens' OperationSummary (Maybe UTCTime)
operationSummary_lastUpdatedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OperationSummary' {Maybe POSIX
lastUpdatedDate :: Maybe POSIX
$sel:lastUpdatedDate:OperationSummary' :: OperationSummary -> Maybe POSIX
lastUpdatedDate} -> Maybe POSIX
lastUpdatedDate) (\s :: OperationSummary
s@OperationSummary' {} Maybe POSIX
a -> OperationSummary
s {$sel:lastUpdatedDate:OperationSummary' :: Maybe POSIX
lastUpdatedDate = Maybe POSIX
a} :: OperationSummary) 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

-- | Message about the operation.
operationSummary_message :: Lens.Lens' OperationSummary (Prelude.Maybe Prelude.Text)
operationSummary_message :: Lens' OperationSummary (Maybe Text)
operationSummary_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OperationSummary' {Maybe Text
message :: Maybe Text
$sel:message:OperationSummary' :: OperationSummary -> Maybe Text
message} -> Maybe Text
message) (\s :: OperationSummary
s@OperationSummary' {} Maybe Text
a -> OperationSummary
s {$sel:message:OperationSummary' :: Maybe Text
message = Maybe Text
a} :: OperationSummary)

-- | Identifier returned to track the requested action.
operationSummary_operationId :: Lens.Lens' OperationSummary (Prelude.Maybe Prelude.Text)
operationSummary_operationId :: Lens' OperationSummary (Maybe Text)
operationSummary_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OperationSummary' {Maybe Text
operationId :: Maybe Text
$sel:operationId:OperationSummary' :: OperationSummary -> Maybe Text
operationId} -> Maybe Text
operationId) (\s :: OperationSummary
s@OperationSummary' {} Maybe Text
a -> OperationSummary
s {$sel:operationId:OperationSummary' :: Maybe Text
operationId = Maybe Text
a} :: OperationSummary)

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

-- | Automatically checks whether there are no outstanding operations on
-- domains that need customer attention.
--
-- 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.
operationSummary_statusFlag :: Lens.Lens' OperationSummary (Prelude.Maybe StatusFlag)
operationSummary_statusFlag :: Lens' OperationSummary (Maybe StatusFlag)
operationSummary_statusFlag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OperationSummary' {Maybe StatusFlag
statusFlag :: Maybe StatusFlag
$sel:statusFlag:OperationSummary' :: OperationSummary -> Maybe StatusFlag
statusFlag} -> Maybe StatusFlag
statusFlag) (\s :: OperationSummary
s@OperationSummary' {} Maybe StatusFlag
a -> OperationSummary
s {$sel:statusFlag:OperationSummary' :: Maybe StatusFlag
statusFlag = Maybe StatusFlag
a} :: OperationSummary)

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

-- | Type of the action requested.
operationSummary_type :: Lens.Lens' OperationSummary (Prelude.Maybe OperationType)
operationSummary_type :: Lens' OperationSummary (Maybe OperationType)
operationSummary_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OperationSummary' {Maybe OperationType
type' :: Maybe OperationType
$sel:type':OperationSummary' :: OperationSummary -> Maybe OperationType
type'} -> Maybe OperationType
type') (\s :: OperationSummary
s@OperationSummary' {} Maybe OperationType
a -> OperationSummary
s {$sel:type':OperationSummary' :: Maybe OperationType
type' = Maybe OperationType
a} :: OperationSummary)

instance Data.FromJSON OperationSummary where
  parseJSON :: Value -> Parser OperationSummary
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"OperationSummary"
      ( \Object
x ->
          Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe OperationStatus
-> Maybe StatusFlag
-> Maybe POSIX
-> Maybe OperationType
-> OperationSummary
OperationSummary'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (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 -> Parser (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 -> Parser (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 -> Parser (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 -> Parser (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 -> Parser (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 -> Parser (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 -> Parser (Maybe a)
Data..:? Key
"Type")
      )

instance Prelude.Hashable OperationSummary where
  hashWithSalt :: Int -> OperationSummary -> Int
hashWithSalt Int
_salt OperationSummary' {Maybe Text
Maybe POSIX
Maybe OperationStatus
Maybe OperationType
Maybe StatusFlag
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:type':OperationSummary' :: OperationSummary -> Maybe OperationType
$sel:submittedDate:OperationSummary' :: OperationSummary -> Maybe POSIX
$sel:statusFlag:OperationSummary' :: OperationSummary -> Maybe StatusFlag
$sel:status:OperationSummary' :: OperationSummary -> Maybe OperationStatus
$sel:operationId:OperationSummary' :: OperationSummary -> Maybe Text
$sel:message:OperationSummary' :: OperationSummary -> Maybe Text
$sel:lastUpdatedDate:OperationSummary' :: OperationSummary -> Maybe POSIX
$sel:domainName:OperationSummary' :: OperationSummary -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastUpdatedDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
message
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
operationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OperationStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StatusFlag
statusFlag
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
submittedDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OperationType
type'

instance Prelude.NFData OperationSummary where
  rnf :: OperationSummary -> ()
rnf OperationSummary' {Maybe Text
Maybe POSIX
Maybe OperationStatus
Maybe OperationType
Maybe StatusFlag
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:type':OperationSummary' :: OperationSummary -> Maybe OperationType
$sel:submittedDate:OperationSummary' :: OperationSummary -> Maybe POSIX
$sel:statusFlag:OperationSummary' :: OperationSummary -> Maybe StatusFlag
$sel:status:OperationSummary' :: OperationSummary -> Maybe OperationStatus
$sel:operationId:OperationSummary' :: OperationSummary -> Maybe Text
$sel:message:OperationSummary' :: OperationSummary -> Maybe Text
$sel:lastUpdatedDate:OperationSummary' :: OperationSummary -> Maybe POSIX
$sel:domainName:OperationSummary' :: OperationSummary -> 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'