{-# 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.UpdateReplicationSet
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Add or delete Regions from your replication set.
module Amazonka.SSMIncidents.UpdateReplicationSet
  ( -- * Creating a Request
    UpdateReplicationSet (..),
    newUpdateReplicationSet,

    -- * Request Lenses
    updateReplicationSet_clientToken,
    updateReplicationSet_actions,
    updateReplicationSet_arn,

    -- * Destructuring the Response
    UpdateReplicationSetResponse (..),
    newUpdateReplicationSetResponse,

    -- * Response Lenses
    updateReplicationSetResponse_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.SSMIncidents.Types

-- | /See:/ 'newUpdateReplicationSet' smart constructor.
data UpdateReplicationSet = UpdateReplicationSet'
  { -- | A token that ensures that the operation is called only once with the
    -- specified details.
    UpdateReplicationSet -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | An action to add or delete a Region.
    UpdateReplicationSet -> NonEmpty UpdateReplicationSetAction
actions :: Prelude.NonEmpty UpdateReplicationSetAction,
    -- | The Amazon Resource Name (ARN) of the replication set you\'re updating.
    UpdateReplicationSet -> Text
arn :: Prelude.Text
  }
  deriving (UpdateReplicationSet -> UpdateReplicationSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateReplicationSet -> UpdateReplicationSet -> Bool
$c/= :: UpdateReplicationSet -> UpdateReplicationSet -> Bool
== :: UpdateReplicationSet -> UpdateReplicationSet -> Bool
$c== :: UpdateReplicationSet -> UpdateReplicationSet -> Bool
Prelude.Eq, ReadPrec [UpdateReplicationSet]
ReadPrec UpdateReplicationSet
Int -> ReadS UpdateReplicationSet
ReadS [UpdateReplicationSet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateReplicationSet]
$creadListPrec :: ReadPrec [UpdateReplicationSet]
readPrec :: ReadPrec UpdateReplicationSet
$creadPrec :: ReadPrec UpdateReplicationSet
readList :: ReadS [UpdateReplicationSet]
$creadList :: ReadS [UpdateReplicationSet]
readsPrec :: Int -> ReadS UpdateReplicationSet
$creadsPrec :: Int -> ReadS UpdateReplicationSet
Prelude.Read, Int -> UpdateReplicationSet -> ShowS
[UpdateReplicationSet] -> ShowS
UpdateReplicationSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateReplicationSet] -> ShowS
$cshowList :: [UpdateReplicationSet] -> ShowS
show :: UpdateReplicationSet -> String
$cshow :: UpdateReplicationSet -> String
showsPrec :: Int -> UpdateReplicationSet -> ShowS
$cshowsPrec :: Int -> UpdateReplicationSet -> ShowS
Prelude.Show, forall x. Rep UpdateReplicationSet x -> UpdateReplicationSet
forall x. UpdateReplicationSet -> Rep UpdateReplicationSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateReplicationSet x -> UpdateReplicationSet
$cfrom :: forall x. UpdateReplicationSet -> Rep UpdateReplicationSet x
Prelude.Generic)

-- |
-- Create a value of 'UpdateReplicationSet' 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', 'updateReplicationSet_clientToken' - A token that ensures that the operation is called only once with the
-- specified details.
--
-- 'actions', 'updateReplicationSet_actions' - An action to add or delete a Region.
--
-- 'arn', 'updateReplicationSet_arn' - The Amazon Resource Name (ARN) of the replication set you\'re updating.
newUpdateReplicationSet ::
  -- | 'actions'
  Prelude.NonEmpty UpdateReplicationSetAction ->
  -- | 'arn'
  Prelude.Text ->
  UpdateReplicationSet
newUpdateReplicationSet :: NonEmpty UpdateReplicationSetAction -> Text -> UpdateReplicationSet
newUpdateReplicationSet NonEmpty UpdateReplicationSetAction
pActions_ Text
pArn_ =
  UpdateReplicationSet'
    { $sel:clientToken:UpdateReplicationSet' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:actions:UpdateReplicationSet' :: NonEmpty UpdateReplicationSetAction
actions = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty UpdateReplicationSetAction
pActions_,
      $sel:arn:UpdateReplicationSet' :: Text
arn = Text
pArn_
    }

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

-- | An action to add or delete a Region.
updateReplicationSet_actions :: Lens.Lens' UpdateReplicationSet (Prelude.NonEmpty UpdateReplicationSetAction)
updateReplicationSet_actions :: Lens' UpdateReplicationSet (NonEmpty UpdateReplicationSetAction)
updateReplicationSet_actions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateReplicationSet' {NonEmpty UpdateReplicationSetAction
actions :: NonEmpty UpdateReplicationSetAction
$sel:actions:UpdateReplicationSet' :: UpdateReplicationSet -> NonEmpty UpdateReplicationSetAction
actions} -> NonEmpty UpdateReplicationSetAction
actions) (\s :: UpdateReplicationSet
s@UpdateReplicationSet' {} NonEmpty UpdateReplicationSetAction
a -> UpdateReplicationSet
s {$sel:actions:UpdateReplicationSet' :: NonEmpty UpdateReplicationSetAction
actions = NonEmpty UpdateReplicationSetAction
a} :: UpdateReplicationSet) 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 Amazon Resource Name (ARN) of the replication set you\'re updating.
updateReplicationSet_arn :: Lens.Lens' UpdateReplicationSet Prelude.Text
updateReplicationSet_arn :: Lens' UpdateReplicationSet Text
updateReplicationSet_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateReplicationSet' {Text
arn :: Text
$sel:arn:UpdateReplicationSet' :: UpdateReplicationSet -> Text
arn} -> Text
arn) (\s :: UpdateReplicationSet
s@UpdateReplicationSet' {} Text
a -> UpdateReplicationSet
s {$sel:arn:UpdateReplicationSet' :: Text
arn = Text
a} :: UpdateReplicationSet)

instance Core.AWSRequest UpdateReplicationSet where
  type
    AWSResponse UpdateReplicationSet =
      UpdateReplicationSetResponse
  request :: (Service -> Service)
-> UpdateReplicationSet -> Request UpdateReplicationSet
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 UpdateReplicationSet
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateReplicationSet)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateReplicationSetResponse
UpdateReplicationSetResponse'
            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))
      )

instance Prelude.Hashable UpdateReplicationSet where
  hashWithSalt :: Int -> UpdateReplicationSet -> Int
hashWithSalt Int
_salt UpdateReplicationSet' {Maybe Text
NonEmpty UpdateReplicationSetAction
Text
arn :: Text
actions :: NonEmpty UpdateReplicationSetAction
clientToken :: Maybe Text
$sel:arn:UpdateReplicationSet' :: UpdateReplicationSet -> Text
$sel:actions:UpdateReplicationSet' :: UpdateReplicationSet -> NonEmpty UpdateReplicationSetAction
$sel:clientToken:UpdateReplicationSet' :: UpdateReplicationSet -> 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` NonEmpty UpdateReplicationSetAction
actions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

instance Prelude.NFData UpdateReplicationSet where
  rnf :: UpdateReplicationSet -> ()
rnf UpdateReplicationSet' {Maybe Text
NonEmpty UpdateReplicationSetAction
Text
arn :: Text
actions :: NonEmpty UpdateReplicationSetAction
clientToken :: Maybe Text
$sel:arn:UpdateReplicationSet' :: UpdateReplicationSet -> Text
$sel:actions:UpdateReplicationSet' :: UpdateReplicationSet -> NonEmpty UpdateReplicationSetAction
$sel:clientToken:UpdateReplicationSet' :: UpdateReplicationSet -> 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 NonEmpty UpdateReplicationSetAction
actions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn

instance Data.ToHeaders UpdateReplicationSet where
  toHeaders :: UpdateReplicationSet -> 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 UpdateReplicationSet where
  toJSON :: UpdateReplicationSet -> Value
toJSON UpdateReplicationSet' {Maybe Text
NonEmpty UpdateReplicationSetAction
Text
arn :: Text
actions :: NonEmpty UpdateReplicationSetAction
clientToken :: Maybe Text
$sel:arn:UpdateReplicationSet' :: UpdateReplicationSet -> Text
$sel:actions:UpdateReplicationSet' :: UpdateReplicationSet -> NonEmpty UpdateReplicationSetAction
$sel:clientToken:UpdateReplicationSet' :: UpdateReplicationSet -> 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,
            forall a. a -> Maybe a
Prelude.Just (Key
"actions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty UpdateReplicationSetAction
actions),
            forall a. a -> Maybe a
Prelude.Just (Key
"arn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
arn)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateReplicationSetResponse' 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', 'updateReplicationSetResponse_httpStatus' - The response's http status code.
newUpdateReplicationSetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateReplicationSetResponse
newUpdateReplicationSetResponse :: Int -> UpdateReplicationSetResponse
newUpdateReplicationSetResponse Int
pHttpStatus_ =
  UpdateReplicationSetResponse'
    { $sel:httpStatus:UpdateReplicationSetResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData UpdateReplicationSetResponse where
  rnf :: UpdateReplicationSetResponse -> ()
rnf UpdateReplicationSetResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateReplicationSetResponse' :: UpdateReplicationSetResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus