{-# 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.ElastiCache.BatchStopUpdateAction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stop the service update. For more information on service updates and
-- stopping them, see
-- <https://docs.aws.amazon.com/AmazonElastiCache/latest/red-ug/stopping-self-service-updates.html Stopping Service Updates>.
module Amazonka.ElastiCache.BatchStopUpdateAction
  ( -- * Creating a Request
    BatchStopUpdateAction (..),
    newBatchStopUpdateAction,

    -- * Request Lenses
    batchStopUpdateAction_cacheClusterIds,
    batchStopUpdateAction_replicationGroupIds,
    batchStopUpdateAction_serviceUpdateName,

    -- * Destructuring the Response
    UpdateActionResultsMessage (..),
    newUpdateActionResultsMessage,

    -- * Response Lenses
    updateActionResultsMessage_processedUpdateActions,
    updateActionResultsMessage_unprocessedUpdateActions,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.ElastiCache.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newBatchStopUpdateAction' smart constructor.
data BatchStopUpdateAction = BatchStopUpdateAction'
  { -- | The cache cluster IDs
    BatchStopUpdateAction -> Maybe [Text]
cacheClusterIds :: Prelude.Maybe [Prelude.Text],
    -- | The replication group IDs
    BatchStopUpdateAction -> Maybe [Text]
replicationGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The unique ID of the service update
    BatchStopUpdateAction -> Text
serviceUpdateName :: Prelude.Text
  }
  deriving (BatchStopUpdateAction -> BatchStopUpdateAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchStopUpdateAction -> BatchStopUpdateAction -> Bool
$c/= :: BatchStopUpdateAction -> BatchStopUpdateAction -> Bool
== :: BatchStopUpdateAction -> BatchStopUpdateAction -> Bool
$c== :: BatchStopUpdateAction -> BatchStopUpdateAction -> Bool
Prelude.Eq, ReadPrec [BatchStopUpdateAction]
ReadPrec BatchStopUpdateAction
Int -> ReadS BatchStopUpdateAction
ReadS [BatchStopUpdateAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchStopUpdateAction]
$creadListPrec :: ReadPrec [BatchStopUpdateAction]
readPrec :: ReadPrec BatchStopUpdateAction
$creadPrec :: ReadPrec BatchStopUpdateAction
readList :: ReadS [BatchStopUpdateAction]
$creadList :: ReadS [BatchStopUpdateAction]
readsPrec :: Int -> ReadS BatchStopUpdateAction
$creadsPrec :: Int -> ReadS BatchStopUpdateAction
Prelude.Read, Int -> BatchStopUpdateAction -> ShowS
[BatchStopUpdateAction] -> ShowS
BatchStopUpdateAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchStopUpdateAction] -> ShowS
$cshowList :: [BatchStopUpdateAction] -> ShowS
show :: BatchStopUpdateAction -> String
$cshow :: BatchStopUpdateAction -> String
showsPrec :: Int -> BatchStopUpdateAction -> ShowS
$cshowsPrec :: Int -> BatchStopUpdateAction -> ShowS
Prelude.Show, forall x. Rep BatchStopUpdateAction x -> BatchStopUpdateAction
forall x. BatchStopUpdateAction -> Rep BatchStopUpdateAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchStopUpdateAction x -> BatchStopUpdateAction
$cfrom :: forall x. BatchStopUpdateAction -> Rep BatchStopUpdateAction x
Prelude.Generic)

-- |
-- Create a value of 'BatchStopUpdateAction' 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:
--
-- 'cacheClusterIds', 'batchStopUpdateAction_cacheClusterIds' - The cache cluster IDs
--
-- 'replicationGroupIds', 'batchStopUpdateAction_replicationGroupIds' - The replication group IDs
--
-- 'serviceUpdateName', 'batchStopUpdateAction_serviceUpdateName' - The unique ID of the service update
newBatchStopUpdateAction ::
  -- | 'serviceUpdateName'
  Prelude.Text ->
  BatchStopUpdateAction
newBatchStopUpdateAction :: Text -> BatchStopUpdateAction
newBatchStopUpdateAction Text
pServiceUpdateName_ =
  BatchStopUpdateAction'
    { $sel:cacheClusterIds:BatchStopUpdateAction' :: Maybe [Text]
cacheClusterIds =
        forall a. Maybe a
Prelude.Nothing,
      $sel:replicationGroupIds:BatchStopUpdateAction' :: Maybe [Text]
replicationGroupIds = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceUpdateName:BatchStopUpdateAction' :: Text
serviceUpdateName = Text
pServiceUpdateName_
    }

-- | The cache cluster IDs
batchStopUpdateAction_cacheClusterIds :: Lens.Lens' BatchStopUpdateAction (Prelude.Maybe [Prelude.Text])
batchStopUpdateAction_cacheClusterIds :: Lens' BatchStopUpdateAction (Maybe [Text])
batchStopUpdateAction_cacheClusterIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchStopUpdateAction' {Maybe [Text]
cacheClusterIds :: Maybe [Text]
$sel:cacheClusterIds:BatchStopUpdateAction' :: BatchStopUpdateAction -> Maybe [Text]
cacheClusterIds} -> Maybe [Text]
cacheClusterIds) (\s :: BatchStopUpdateAction
s@BatchStopUpdateAction' {} Maybe [Text]
a -> BatchStopUpdateAction
s {$sel:cacheClusterIds:BatchStopUpdateAction' :: Maybe [Text]
cacheClusterIds = Maybe [Text]
a} :: BatchStopUpdateAction) 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 replication group IDs
batchStopUpdateAction_replicationGroupIds :: Lens.Lens' BatchStopUpdateAction (Prelude.Maybe [Prelude.Text])
batchStopUpdateAction_replicationGroupIds :: Lens' BatchStopUpdateAction (Maybe [Text])
batchStopUpdateAction_replicationGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchStopUpdateAction' {Maybe [Text]
replicationGroupIds :: Maybe [Text]
$sel:replicationGroupIds:BatchStopUpdateAction' :: BatchStopUpdateAction -> Maybe [Text]
replicationGroupIds} -> Maybe [Text]
replicationGroupIds) (\s :: BatchStopUpdateAction
s@BatchStopUpdateAction' {} Maybe [Text]
a -> BatchStopUpdateAction
s {$sel:replicationGroupIds:BatchStopUpdateAction' :: Maybe [Text]
replicationGroupIds = Maybe [Text]
a} :: BatchStopUpdateAction) 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 unique ID of the service update
batchStopUpdateAction_serviceUpdateName :: Lens.Lens' BatchStopUpdateAction Prelude.Text
batchStopUpdateAction_serviceUpdateName :: Lens' BatchStopUpdateAction Text
batchStopUpdateAction_serviceUpdateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchStopUpdateAction' {Text
serviceUpdateName :: Text
$sel:serviceUpdateName:BatchStopUpdateAction' :: BatchStopUpdateAction -> Text
serviceUpdateName} -> Text
serviceUpdateName) (\s :: BatchStopUpdateAction
s@BatchStopUpdateAction' {} Text
a -> BatchStopUpdateAction
s {$sel:serviceUpdateName:BatchStopUpdateAction' :: Text
serviceUpdateName = Text
a} :: BatchStopUpdateAction)

instance Core.AWSRequest BatchStopUpdateAction where
  type
    AWSResponse BatchStopUpdateAction =
      UpdateActionResultsMessage
  request :: (Service -> Service)
-> BatchStopUpdateAction -> Request BatchStopUpdateAction
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy BatchStopUpdateAction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchStopUpdateAction)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"BatchStopUpdateActionResult"
      (\Int
s ResponseHeaders
h [Node]
x -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance Prelude.Hashable BatchStopUpdateAction where
  hashWithSalt :: Int -> BatchStopUpdateAction -> Int
hashWithSalt Int
_salt BatchStopUpdateAction' {Maybe [Text]
Text
serviceUpdateName :: Text
replicationGroupIds :: Maybe [Text]
cacheClusterIds :: Maybe [Text]
$sel:serviceUpdateName:BatchStopUpdateAction' :: BatchStopUpdateAction -> Text
$sel:replicationGroupIds:BatchStopUpdateAction' :: BatchStopUpdateAction -> Maybe [Text]
$sel:cacheClusterIds:BatchStopUpdateAction' :: BatchStopUpdateAction -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
cacheClusterIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
replicationGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceUpdateName

instance Prelude.NFData BatchStopUpdateAction where
  rnf :: BatchStopUpdateAction -> ()
rnf BatchStopUpdateAction' {Maybe [Text]
Text
serviceUpdateName :: Text
replicationGroupIds :: Maybe [Text]
cacheClusterIds :: Maybe [Text]
$sel:serviceUpdateName:BatchStopUpdateAction' :: BatchStopUpdateAction -> Text
$sel:replicationGroupIds:BatchStopUpdateAction' :: BatchStopUpdateAction -> Maybe [Text]
$sel:cacheClusterIds:BatchStopUpdateAction' :: BatchStopUpdateAction -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
cacheClusterIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
replicationGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serviceUpdateName

instance Data.ToHeaders BatchStopUpdateAction where
  toHeaders :: BatchStopUpdateAction -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery BatchStopUpdateAction where
  toQuery :: BatchStopUpdateAction -> QueryString
toQuery BatchStopUpdateAction' {Maybe [Text]
Text
serviceUpdateName :: Text
replicationGroupIds :: Maybe [Text]
cacheClusterIds :: Maybe [Text]
$sel:serviceUpdateName:BatchStopUpdateAction' :: BatchStopUpdateAction -> Text
$sel:replicationGroupIds:BatchStopUpdateAction' :: BatchStopUpdateAction -> Maybe [Text]
$sel:cacheClusterIds:BatchStopUpdateAction' :: BatchStopUpdateAction -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"BatchStopUpdateAction" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2015-02-02" :: Prelude.ByteString),
        ByteString
"CacheClusterIds"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
cacheClusterIds
            ),
        ByteString
"ReplicationGroupIds"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
replicationGroupIds
            ),
        ByteString
"ServiceUpdateName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
serviceUpdateName
      ]