{-# 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.SSMIncidents.CreateReplicationSet
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- A replication set replicates and encrypts your data to the provided
-- Regions with the provided KMS key.
module Amazonka.SSMIncidents.CreateReplicationSet
  ( -- * Creating a Request
    CreateReplicationSet (..),
    newCreateReplicationSet,

    -- * Request Lenses
    createReplicationSet_clientToken,
    createReplicationSet_tags,
    createReplicationSet_regions,

    -- * Destructuring the Response
    CreateReplicationSetResponse (..),
    newCreateReplicationSetResponse,

    -- * Response Lenses
    createReplicationSetResponse_httpStatus,
    createReplicationSetResponse_arn,
  )
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.SSMIncidents.Types

-- | /See:/ 'newCreateReplicationSet' smart constructor.
data CreateReplicationSet = CreateReplicationSet'
  { -- | A token that ensures that the operation is called only once with the
    -- specified details.
    CreateReplicationSet -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A list of tags to add to the replication set.
    CreateReplicationSet -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The Regions that Incident Manager replicates your data to. You can have
    -- up to three Regions in your replication set.
    CreateReplicationSet -> HashMap Text RegionMapInputValue
regions :: Prelude.HashMap Prelude.Text RegionMapInputValue
  }
  deriving (CreateReplicationSet -> CreateReplicationSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateReplicationSet -> CreateReplicationSet -> Bool
$c/= :: CreateReplicationSet -> CreateReplicationSet -> Bool
== :: CreateReplicationSet -> CreateReplicationSet -> Bool
$c== :: CreateReplicationSet -> CreateReplicationSet -> Bool
Prelude.Eq, ReadPrec [CreateReplicationSet]
ReadPrec CreateReplicationSet
Int -> ReadS CreateReplicationSet
ReadS [CreateReplicationSet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateReplicationSet]
$creadListPrec :: ReadPrec [CreateReplicationSet]
readPrec :: ReadPrec CreateReplicationSet
$creadPrec :: ReadPrec CreateReplicationSet
readList :: ReadS [CreateReplicationSet]
$creadList :: ReadS [CreateReplicationSet]
readsPrec :: Int -> ReadS CreateReplicationSet
$creadsPrec :: Int -> ReadS CreateReplicationSet
Prelude.Read, Int -> CreateReplicationSet -> ShowS
[CreateReplicationSet] -> ShowS
CreateReplicationSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateReplicationSet] -> ShowS
$cshowList :: [CreateReplicationSet] -> ShowS
show :: CreateReplicationSet -> String
$cshow :: CreateReplicationSet -> String
showsPrec :: Int -> CreateReplicationSet -> ShowS
$cshowsPrec :: Int -> CreateReplicationSet -> ShowS
Prelude.Show, forall x. Rep CreateReplicationSet x -> CreateReplicationSet
forall x. CreateReplicationSet -> Rep CreateReplicationSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateReplicationSet x -> CreateReplicationSet
$cfrom :: forall x. CreateReplicationSet -> Rep CreateReplicationSet x
Prelude.Generic)

-- |
-- Create a value of 'CreateReplicationSet' 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:
--
-- 'clientToken', 'createReplicationSet_clientToken' - A token that ensures that the operation is called only once with the
-- specified details.
--
-- 'tags', 'createReplicationSet_tags' - A list of tags to add to the replication set.
--
-- 'regions', 'createReplicationSet_regions' - The Regions that Incident Manager replicates your data to. You can have
-- up to three Regions in your replication set.
newCreateReplicationSet ::
  CreateReplicationSet
newCreateReplicationSet :: CreateReplicationSet
newCreateReplicationSet =
  CreateReplicationSet'
    { $sel:clientToken:CreateReplicationSet' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateReplicationSet' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:regions:CreateReplicationSet' :: HashMap Text RegionMapInputValue
regions = forall a. Monoid a => a
Prelude.mempty
    }

-- | A token that ensures that the operation is called only once with the
-- specified details.
createReplicationSet_clientToken :: Lens.Lens' CreateReplicationSet (Prelude.Maybe Prelude.Text)
createReplicationSet_clientToken :: Lens' CreateReplicationSet (Maybe Text)
createReplicationSet_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReplicationSet' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateReplicationSet' :: CreateReplicationSet -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateReplicationSet
s@CreateReplicationSet' {} Maybe Text
a -> CreateReplicationSet
s {$sel:clientToken:CreateReplicationSet' :: Maybe Text
clientToken = Maybe Text
a} :: CreateReplicationSet)

-- | A list of tags to add to the replication set.
createReplicationSet_tags :: Lens.Lens' CreateReplicationSet (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createReplicationSet_tags :: Lens' CreateReplicationSet (Maybe (HashMap Text Text))
createReplicationSet_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReplicationSet' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateReplicationSet' :: CreateReplicationSet -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateReplicationSet
s@CreateReplicationSet' {} Maybe (HashMap Text Text)
a -> CreateReplicationSet
s {$sel:tags:CreateReplicationSet' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateReplicationSet) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Regions that Incident Manager replicates your data to. You can have
-- up to three Regions in your replication set.
createReplicationSet_regions :: Lens.Lens' CreateReplicationSet (Prelude.HashMap Prelude.Text RegionMapInputValue)
createReplicationSet_regions :: Lens' CreateReplicationSet (HashMap Text RegionMapInputValue)
createReplicationSet_regions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReplicationSet' {HashMap Text RegionMapInputValue
regions :: HashMap Text RegionMapInputValue
$sel:regions:CreateReplicationSet' :: CreateReplicationSet -> HashMap Text RegionMapInputValue
regions} -> HashMap Text RegionMapInputValue
regions) (\s :: CreateReplicationSet
s@CreateReplicationSet' {} HashMap Text RegionMapInputValue
a -> CreateReplicationSet
s {$sel:regions:CreateReplicationSet' :: HashMap Text RegionMapInputValue
regions = HashMap Text RegionMapInputValue
a} :: CreateReplicationSet) 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

instance Core.AWSRequest CreateReplicationSet where
  type
    AWSResponse CreateReplicationSet =
      CreateReplicationSetResponse
  request :: (Service -> Service)
-> CreateReplicationSet -> Request CreateReplicationSet
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 CreateReplicationSet
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateReplicationSet)))
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 ->
          Int -> Text -> CreateReplicationSetResponse
CreateReplicationSetResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"arn")
      )

instance Prelude.Hashable CreateReplicationSet where
  hashWithSalt :: Int -> CreateReplicationSet -> Int
hashWithSalt Int
_salt CreateReplicationSet' {Maybe Text
Maybe (HashMap Text Text)
HashMap Text RegionMapInputValue
regions :: HashMap Text RegionMapInputValue
tags :: Maybe (HashMap Text Text)
clientToken :: Maybe Text
$sel:regions:CreateReplicationSet' :: CreateReplicationSet -> HashMap Text RegionMapInputValue
$sel:tags:CreateReplicationSet' :: CreateReplicationSet -> Maybe (HashMap Text Text)
$sel:clientToken:CreateReplicationSet' :: CreateReplicationSet -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text RegionMapInputValue
regions

instance Prelude.NFData CreateReplicationSet where
  rnf :: CreateReplicationSet -> ()
rnf CreateReplicationSet' {Maybe Text
Maybe (HashMap Text Text)
HashMap Text RegionMapInputValue
regions :: HashMap Text RegionMapInputValue
tags :: Maybe (HashMap Text Text)
clientToken :: Maybe Text
$sel:regions:CreateReplicationSet' :: CreateReplicationSet -> HashMap Text RegionMapInputValue
$sel:tags:CreateReplicationSet' :: CreateReplicationSet -> Maybe (HashMap Text Text)
$sel:clientToken:CreateReplicationSet' :: CreateReplicationSet -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text RegionMapInputValue
regions

instance Data.ToHeaders CreateReplicationSet where
  toHeaders :: CreateReplicationSet -> 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 CreateReplicationSet where
  toJSON :: CreateReplicationSet -> Value
toJSON CreateReplicationSet' {Maybe Text
Maybe (HashMap Text Text)
HashMap Text RegionMapInputValue
regions :: HashMap Text RegionMapInputValue
tags :: Maybe (HashMap Text Text)
clientToken :: Maybe Text
$sel:regions:CreateReplicationSet' :: CreateReplicationSet -> HashMap Text RegionMapInputValue
$sel:tags:CreateReplicationSet' :: CreateReplicationSet -> Maybe (HashMap Text Text)
$sel:clientToken:CreateReplicationSet' :: CreateReplicationSet -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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 Text
clientToken,
            (Key
"tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"regions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap Text RegionMapInputValue
regions)
          ]
      )

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

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

-- | /See:/ 'newCreateReplicationSetResponse' smart constructor.
data CreateReplicationSetResponse = CreateReplicationSetResponse'
  { -- | The response's http status code.
    CreateReplicationSetResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the replication set.
    CreateReplicationSetResponse -> Text
arn :: Prelude.Text
  }
  deriving (CreateReplicationSetResponse
-> CreateReplicationSetResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateReplicationSetResponse
-> CreateReplicationSetResponse -> Bool
$c/= :: CreateReplicationSetResponse
-> CreateReplicationSetResponse -> Bool
== :: CreateReplicationSetResponse
-> CreateReplicationSetResponse -> Bool
$c== :: CreateReplicationSetResponse
-> CreateReplicationSetResponse -> Bool
Prelude.Eq, ReadPrec [CreateReplicationSetResponse]
ReadPrec CreateReplicationSetResponse
Int -> ReadS CreateReplicationSetResponse
ReadS [CreateReplicationSetResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateReplicationSetResponse]
$creadListPrec :: ReadPrec [CreateReplicationSetResponse]
readPrec :: ReadPrec CreateReplicationSetResponse
$creadPrec :: ReadPrec CreateReplicationSetResponse
readList :: ReadS [CreateReplicationSetResponse]
$creadList :: ReadS [CreateReplicationSetResponse]
readsPrec :: Int -> ReadS CreateReplicationSetResponse
$creadsPrec :: Int -> ReadS CreateReplicationSetResponse
Prelude.Read, Int -> CreateReplicationSetResponse -> ShowS
[CreateReplicationSetResponse] -> ShowS
CreateReplicationSetResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateReplicationSetResponse] -> ShowS
$cshowList :: [CreateReplicationSetResponse] -> ShowS
show :: CreateReplicationSetResponse -> String
$cshow :: CreateReplicationSetResponse -> String
showsPrec :: Int -> CreateReplicationSetResponse -> ShowS
$cshowsPrec :: Int -> CreateReplicationSetResponse -> ShowS
Prelude.Show, forall x.
Rep CreateReplicationSetResponse x -> CreateReplicationSetResponse
forall x.
CreateReplicationSetResponse -> Rep CreateReplicationSetResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateReplicationSetResponse x -> CreateReplicationSetResponse
$cfrom :: forall x.
CreateReplicationSetResponse -> Rep CreateReplicationSetResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateReplicationSetResponse' 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', 'createReplicationSetResponse_httpStatus' - The response's http status code.
--
-- 'arn', 'createReplicationSetResponse_arn' - The Amazon Resource Name (ARN) of the replication set.
newCreateReplicationSetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'arn'
  Prelude.Text ->
  CreateReplicationSetResponse
newCreateReplicationSetResponse :: Int -> Text -> CreateReplicationSetResponse
newCreateReplicationSetResponse Int
pHttpStatus_ Text
pArn_ =
  CreateReplicationSetResponse'
    { $sel:httpStatus:CreateReplicationSetResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:arn:CreateReplicationSetResponse' :: Text
arn = Text
pArn_
    }

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

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

instance Prelude.NFData CreateReplicationSetResponse where
  rnf :: CreateReplicationSetResponse -> ()
rnf CreateReplicationSetResponse' {Int
Text
arn :: Text
httpStatus :: Int
$sel:arn:CreateReplicationSetResponse' :: CreateReplicationSetResponse -> Text
$sel:httpStatus:CreateReplicationSetResponse' :: CreateReplicationSetResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn