{-# 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.SSMIncidents.Types.ReplicationSet
-- 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.SSMIncidents.Types.ReplicationSet 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.SSMIncidents.Types.RegionInfo
import Amazonka.SSMIncidents.Types.ReplicationSetStatus

-- | The set of Amazon Web Services Region that your Incident Manager data
-- will be replicated to and the KMS key used to encrypt the data.
--
-- /See:/ 'newReplicationSet' smart constructor.
data ReplicationSet = ReplicationSet'
  { -- | The Amazon Resource Name (ARN) of the replication set.
    ReplicationSet -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | Details about who created the replication set.
    ReplicationSet -> Text
createdBy :: Prelude.Text,
    -- | When the replication set was created.
    ReplicationSet -> POSIX
createdTime :: Data.POSIX,
    -- | Determines if the replication set deletion protection is enabled or not.
    -- If deletion protection is enabled, you can\'t delete the last Amazon Web
    -- Services Region in the replication set.
    ReplicationSet -> Bool
deletionProtected :: Prelude.Bool,
    -- | Who last modified the replication set.
    ReplicationSet -> Text
lastModifiedBy :: Prelude.Text,
    -- | When the replication set was last updated.
    ReplicationSet -> POSIX
lastModifiedTime :: Data.POSIX,
    -- | The map between each Amazon Web Services Region in your replication set
    -- and the KMS key that\'s used to encrypt the data in that Region.
    ReplicationSet -> HashMap Text RegionInfo
regionMap :: Prelude.HashMap Prelude.Text RegionInfo,
    -- | The status of the replication set. If the replication set is still
    -- pending, you can\'t use Incident Manager functionality.
    ReplicationSet -> ReplicationSetStatus
status :: ReplicationSetStatus
  }
  deriving (ReplicationSet -> ReplicationSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplicationSet -> ReplicationSet -> Bool
$c/= :: ReplicationSet -> ReplicationSet -> Bool
== :: ReplicationSet -> ReplicationSet -> Bool
$c== :: ReplicationSet -> ReplicationSet -> Bool
Prelude.Eq, ReadPrec [ReplicationSet]
ReadPrec ReplicationSet
Int -> ReadS ReplicationSet
ReadS [ReplicationSet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReplicationSet]
$creadListPrec :: ReadPrec [ReplicationSet]
readPrec :: ReadPrec ReplicationSet
$creadPrec :: ReadPrec ReplicationSet
readList :: ReadS [ReplicationSet]
$creadList :: ReadS [ReplicationSet]
readsPrec :: Int -> ReadS ReplicationSet
$creadsPrec :: Int -> ReadS ReplicationSet
Prelude.Read, Int -> ReplicationSet -> ShowS
[ReplicationSet] -> ShowS
ReplicationSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplicationSet] -> ShowS
$cshowList :: [ReplicationSet] -> ShowS
show :: ReplicationSet -> String
$cshow :: ReplicationSet -> String
showsPrec :: Int -> ReplicationSet -> ShowS
$cshowsPrec :: Int -> ReplicationSet -> ShowS
Prelude.Show, forall x. Rep ReplicationSet x -> ReplicationSet
forall x. ReplicationSet -> Rep ReplicationSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReplicationSet x -> ReplicationSet
$cfrom :: forall x. ReplicationSet -> Rep ReplicationSet x
Prelude.Generic)

-- |
-- Create a value of 'ReplicationSet' 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:
--
-- 'arn', 'replicationSet_arn' - The Amazon Resource Name (ARN) of the replication set.
--
-- 'createdBy', 'replicationSet_createdBy' - Details about who created the replication set.
--
-- 'createdTime', 'replicationSet_createdTime' - When the replication set was created.
--
-- 'deletionProtected', 'replicationSet_deletionProtected' - Determines if the replication set deletion protection is enabled or not.
-- If deletion protection is enabled, you can\'t delete the last Amazon Web
-- Services Region in the replication set.
--
-- 'lastModifiedBy', 'replicationSet_lastModifiedBy' - Who last modified the replication set.
--
-- 'lastModifiedTime', 'replicationSet_lastModifiedTime' - When the replication set was last updated.
--
-- 'regionMap', 'replicationSet_regionMap' - The map between each Amazon Web Services Region in your replication set
-- and the KMS key that\'s used to encrypt the data in that Region.
--
-- 'status', 'replicationSet_status' - The status of the replication set. If the replication set is still
-- pending, you can\'t use Incident Manager functionality.
newReplicationSet ::
  -- | 'createdBy'
  Prelude.Text ->
  -- | 'createdTime'
  Prelude.UTCTime ->
  -- | 'deletionProtected'
  Prelude.Bool ->
  -- | 'lastModifiedBy'
  Prelude.Text ->
  -- | 'lastModifiedTime'
  Prelude.UTCTime ->
  -- | 'status'
  ReplicationSetStatus ->
  ReplicationSet
newReplicationSet :: Text
-> UTCTime
-> Bool
-> Text
-> UTCTime
-> ReplicationSetStatus
-> ReplicationSet
newReplicationSet
  Text
pCreatedBy_
  UTCTime
pCreatedTime_
  Bool
pDeletionProtected_
  Text
pLastModifiedBy_
  UTCTime
pLastModifiedTime_
  ReplicationSetStatus
pStatus_ =
    ReplicationSet'
      { $sel:arn:ReplicationSet' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
        $sel:createdBy:ReplicationSet' :: Text
createdBy = Text
pCreatedBy_,
        $sel:createdTime:ReplicationSet' :: POSIX
createdTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedTime_,
        $sel:deletionProtected:ReplicationSet' :: Bool
deletionProtected = Bool
pDeletionProtected_,
        $sel:lastModifiedBy:ReplicationSet' :: Text
lastModifiedBy = Text
pLastModifiedBy_,
        $sel:lastModifiedTime:ReplicationSet' :: POSIX
lastModifiedTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pLastModifiedTime_,
        $sel:regionMap:ReplicationSet' :: HashMap Text RegionInfo
regionMap = forall a. Monoid a => a
Prelude.mempty,
        $sel:status:ReplicationSet' :: ReplicationSetStatus
status = ReplicationSetStatus
pStatus_
      }

-- | The Amazon Resource Name (ARN) of the replication set.
replicationSet_arn :: Lens.Lens' ReplicationSet (Prelude.Maybe Prelude.Text)
replicationSet_arn :: Lens' ReplicationSet (Maybe Text)
replicationSet_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationSet' {Maybe Text
arn :: Maybe Text
$sel:arn:ReplicationSet' :: ReplicationSet -> Maybe Text
arn} -> Maybe Text
arn) (\s :: ReplicationSet
s@ReplicationSet' {} Maybe Text
a -> ReplicationSet
s {$sel:arn:ReplicationSet' :: Maybe Text
arn = Maybe Text
a} :: ReplicationSet)

-- | Details about who created the replication set.
replicationSet_createdBy :: Lens.Lens' ReplicationSet Prelude.Text
replicationSet_createdBy :: Lens' ReplicationSet Text
replicationSet_createdBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationSet' {Text
createdBy :: Text
$sel:createdBy:ReplicationSet' :: ReplicationSet -> Text
createdBy} -> Text
createdBy) (\s :: ReplicationSet
s@ReplicationSet' {} Text
a -> ReplicationSet
s {$sel:createdBy:ReplicationSet' :: Text
createdBy = Text
a} :: ReplicationSet)

-- | When the replication set was created.
replicationSet_createdTime :: Lens.Lens' ReplicationSet Prelude.UTCTime
replicationSet_createdTime :: Lens' ReplicationSet UTCTime
replicationSet_createdTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationSet' {POSIX
createdTime :: POSIX
$sel:createdTime:ReplicationSet' :: ReplicationSet -> POSIX
createdTime} -> POSIX
createdTime) (\s :: ReplicationSet
s@ReplicationSet' {} POSIX
a -> ReplicationSet
s {$sel:createdTime:ReplicationSet' :: POSIX
createdTime = POSIX
a} :: ReplicationSet) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Determines if the replication set deletion protection is enabled or not.
-- If deletion protection is enabled, you can\'t delete the last Amazon Web
-- Services Region in the replication set.
replicationSet_deletionProtected :: Lens.Lens' ReplicationSet Prelude.Bool
replicationSet_deletionProtected :: Lens' ReplicationSet Bool
replicationSet_deletionProtected = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationSet' {Bool
deletionProtected :: Bool
$sel:deletionProtected:ReplicationSet' :: ReplicationSet -> Bool
deletionProtected} -> Bool
deletionProtected) (\s :: ReplicationSet
s@ReplicationSet' {} Bool
a -> ReplicationSet
s {$sel:deletionProtected:ReplicationSet' :: Bool
deletionProtected = Bool
a} :: ReplicationSet)

-- | Who last modified the replication set.
replicationSet_lastModifiedBy :: Lens.Lens' ReplicationSet Prelude.Text
replicationSet_lastModifiedBy :: Lens' ReplicationSet Text
replicationSet_lastModifiedBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationSet' {Text
lastModifiedBy :: Text
$sel:lastModifiedBy:ReplicationSet' :: ReplicationSet -> Text
lastModifiedBy} -> Text
lastModifiedBy) (\s :: ReplicationSet
s@ReplicationSet' {} Text
a -> ReplicationSet
s {$sel:lastModifiedBy:ReplicationSet' :: Text
lastModifiedBy = Text
a} :: ReplicationSet)

-- | When the replication set was last updated.
replicationSet_lastModifiedTime :: Lens.Lens' ReplicationSet Prelude.UTCTime
replicationSet_lastModifiedTime :: Lens' ReplicationSet UTCTime
replicationSet_lastModifiedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationSet' {POSIX
lastModifiedTime :: POSIX
$sel:lastModifiedTime:ReplicationSet' :: ReplicationSet -> POSIX
lastModifiedTime} -> POSIX
lastModifiedTime) (\s :: ReplicationSet
s@ReplicationSet' {} POSIX
a -> ReplicationSet
s {$sel:lastModifiedTime:ReplicationSet' :: POSIX
lastModifiedTime = POSIX
a} :: ReplicationSet) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The map between each Amazon Web Services Region in your replication set
-- and the KMS key that\'s used to encrypt the data in that Region.
replicationSet_regionMap :: Lens.Lens' ReplicationSet (Prelude.HashMap Prelude.Text RegionInfo)
replicationSet_regionMap :: Lens' ReplicationSet (HashMap Text RegionInfo)
replicationSet_regionMap = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationSet' {HashMap Text RegionInfo
regionMap :: HashMap Text RegionInfo
$sel:regionMap:ReplicationSet' :: ReplicationSet -> HashMap Text RegionInfo
regionMap} -> HashMap Text RegionInfo
regionMap) (\s :: ReplicationSet
s@ReplicationSet' {} HashMap Text RegionInfo
a -> ReplicationSet
s {$sel:regionMap:ReplicationSet' :: HashMap Text RegionInfo
regionMap = HashMap Text RegionInfo
a} :: ReplicationSet) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The status of the replication set. If the replication set is still
-- pending, you can\'t use Incident Manager functionality.
replicationSet_status :: Lens.Lens' ReplicationSet ReplicationSetStatus
replicationSet_status :: Lens' ReplicationSet ReplicationSetStatus
replicationSet_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicationSet' {ReplicationSetStatus
status :: ReplicationSetStatus
$sel:status:ReplicationSet' :: ReplicationSet -> ReplicationSetStatus
status} -> ReplicationSetStatus
status) (\s :: ReplicationSet
s@ReplicationSet' {} ReplicationSetStatus
a -> ReplicationSet
s {$sel:status:ReplicationSet' :: ReplicationSetStatus
status = ReplicationSetStatus
a} :: ReplicationSet)

instance Data.FromJSON ReplicationSet where
  parseJSON :: Value -> Parser ReplicationSet
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ReplicationSet"
      ( \Object
x ->
          Maybe Text
-> Text
-> POSIX
-> Bool
-> Text
-> POSIX
-> HashMap Text RegionInfo
-> ReplicationSetStatus
-> ReplicationSet
ReplicationSet'
            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
"arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"createdBy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"createdTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"deletionProtected")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"lastModifiedBy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"lastModifiedTime")
            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
"regionMap" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"status")
      )

instance Prelude.Hashable ReplicationSet where
  hashWithSalt :: Int -> ReplicationSet -> Int
hashWithSalt Int
_salt ReplicationSet' {Bool
Maybe Text
Text
HashMap Text RegionInfo
POSIX
ReplicationSetStatus
status :: ReplicationSetStatus
regionMap :: HashMap Text RegionInfo
lastModifiedTime :: POSIX
lastModifiedBy :: Text
deletionProtected :: Bool
createdTime :: POSIX
createdBy :: Text
arn :: Maybe Text
$sel:status:ReplicationSet' :: ReplicationSet -> ReplicationSetStatus
$sel:regionMap:ReplicationSet' :: ReplicationSet -> HashMap Text RegionInfo
$sel:lastModifiedTime:ReplicationSet' :: ReplicationSet -> POSIX
$sel:lastModifiedBy:ReplicationSet' :: ReplicationSet -> Text
$sel:deletionProtected:ReplicationSet' :: ReplicationSet -> Bool
$sel:createdTime:ReplicationSet' :: ReplicationSet -> POSIX
$sel:createdBy:ReplicationSet' :: ReplicationSet -> Text
$sel:arn:ReplicationSet' :: ReplicationSet -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
createdBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
createdTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
deletionProtected
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
lastModifiedBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
lastModifiedTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text RegionInfo
regionMap
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ReplicationSetStatus
status

instance Prelude.NFData ReplicationSet where
  rnf :: ReplicationSet -> ()
rnf ReplicationSet' {Bool
Maybe Text
Text
HashMap Text RegionInfo
POSIX
ReplicationSetStatus
status :: ReplicationSetStatus
regionMap :: HashMap Text RegionInfo
lastModifiedTime :: POSIX
lastModifiedBy :: Text
deletionProtected :: Bool
createdTime :: POSIX
createdBy :: Text
arn :: Maybe Text
$sel:status:ReplicationSet' :: ReplicationSet -> ReplicationSetStatus
$sel:regionMap:ReplicationSet' :: ReplicationSet -> HashMap Text RegionInfo
$sel:lastModifiedTime:ReplicationSet' :: ReplicationSet -> POSIX
$sel:lastModifiedBy:ReplicationSet' :: ReplicationSet -> Text
$sel:deletionProtected:ReplicationSet' :: ReplicationSet -> Bool
$sel:createdTime:ReplicationSet' :: ReplicationSet -> POSIX
$sel:createdBy:ReplicationSet' :: ReplicationSet -> Text
$sel:arn:ReplicationSet' :: ReplicationSet -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
createdBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
createdTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
deletionProtected
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
lastModifiedBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
lastModifiedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text RegionInfo
regionMap
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ReplicationSetStatus
status