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

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

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

-- | The cache cluster IDs
batchApplyUpdateAction_cacheClusterIds :: Lens.Lens' BatchApplyUpdateAction (Prelude.Maybe [Prelude.Text])
batchApplyUpdateAction_cacheClusterIds :: Lens' BatchApplyUpdateAction (Maybe [Text])
batchApplyUpdateAction_cacheClusterIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchApplyUpdateAction' {Maybe [Text]
cacheClusterIds :: Maybe [Text]
$sel:cacheClusterIds:BatchApplyUpdateAction' :: BatchApplyUpdateAction -> Maybe [Text]
cacheClusterIds} -> Maybe [Text]
cacheClusterIds) (\s :: BatchApplyUpdateAction
s@BatchApplyUpdateAction' {} Maybe [Text]
a -> BatchApplyUpdateAction
s {$sel:cacheClusterIds:BatchApplyUpdateAction' :: Maybe [Text]
cacheClusterIds = Maybe [Text]
a} :: BatchApplyUpdateAction) 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
batchApplyUpdateAction_replicationGroupIds :: Lens.Lens' BatchApplyUpdateAction (Prelude.Maybe [Prelude.Text])
batchApplyUpdateAction_replicationGroupIds :: Lens' BatchApplyUpdateAction (Maybe [Text])
batchApplyUpdateAction_replicationGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchApplyUpdateAction' {Maybe [Text]
replicationGroupIds :: Maybe [Text]
$sel:replicationGroupIds:BatchApplyUpdateAction' :: BatchApplyUpdateAction -> Maybe [Text]
replicationGroupIds} -> Maybe [Text]
replicationGroupIds) (\s :: BatchApplyUpdateAction
s@BatchApplyUpdateAction' {} Maybe [Text]
a -> BatchApplyUpdateAction
s {$sel:replicationGroupIds:BatchApplyUpdateAction' :: Maybe [Text]
replicationGroupIds = Maybe [Text]
a} :: BatchApplyUpdateAction) 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
batchApplyUpdateAction_serviceUpdateName :: Lens.Lens' BatchApplyUpdateAction Prelude.Text
batchApplyUpdateAction_serviceUpdateName :: Lens' BatchApplyUpdateAction Text
batchApplyUpdateAction_serviceUpdateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchApplyUpdateAction' {Text
serviceUpdateName :: Text
$sel:serviceUpdateName:BatchApplyUpdateAction' :: BatchApplyUpdateAction -> Text
serviceUpdateName} -> Text
serviceUpdateName) (\s :: BatchApplyUpdateAction
s@BatchApplyUpdateAction' {} Text
a -> BatchApplyUpdateAction
s {$sel:serviceUpdateName:BatchApplyUpdateAction' :: Text
serviceUpdateName = Text
a} :: BatchApplyUpdateAction)

instance Core.AWSRequest BatchApplyUpdateAction where
  type
    AWSResponse BatchApplyUpdateAction =
      UpdateActionResultsMessage
  request :: (Service -> Service)
-> BatchApplyUpdateAction -> Request BatchApplyUpdateAction
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 BatchApplyUpdateAction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchApplyUpdateAction)))
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
"BatchApplyUpdateActionResult"
      (\Int
s ResponseHeaders
h [Node]
x -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance Prelude.Hashable BatchApplyUpdateAction where
  hashWithSalt :: Int -> BatchApplyUpdateAction -> Int
hashWithSalt Int
_salt BatchApplyUpdateAction' {Maybe [Text]
Text
serviceUpdateName :: Text
replicationGroupIds :: Maybe [Text]
cacheClusterIds :: Maybe [Text]
$sel:serviceUpdateName:BatchApplyUpdateAction' :: BatchApplyUpdateAction -> Text
$sel:replicationGroupIds:BatchApplyUpdateAction' :: BatchApplyUpdateAction -> Maybe [Text]
$sel:cacheClusterIds:BatchApplyUpdateAction' :: BatchApplyUpdateAction -> 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 BatchApplyUpdateAction where
  rnf :: BatchApplyUpdateAction -> ()
rnf BatchApplyUpdateAction' {Maybe [Text]
Text
serviceUpdateName :: Text
replicationGroupIds :: Maybe [Text]
cacheClusterIds :: Maybe [Text]
$sel:serviceUpdateName:BatchApplyUpdateAction' :: BatchApplyUpdateAction -> Text
$sel:replicationGroupIds:BatchApplyUpdateAction' :: BatchApplyUpdateAction -> Maybe [Text]
$sel:cacheClusterIds:BatchApplyUpdateAction' :: BatchApplyUpdateAction -> 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 BatchApplyUpdateAction where
  toHeaders :: BatchApplyUpdateAction -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery BatchApplyUpdateAction where
  toQuery :: BatchApplyUpdateAction -> QueryString
toQuery BatchApplyUpdateAction' {Maybe [Text]
Text
serviceUpdateName :: Text
replicationGroupIds :: Maybe [Text]
cacheClusterIds :: Maybe [Text]
$sel:serviceUpdateName:BatchApplyUpdateAction' :: BatchApplyUpdateAction -> Text
$sel:replicationGroupIds:BatchApplyUpdateAction' :: BatchApplyUpdateAction -> Maybe [Text]
$sel:cacheClusterIds:BatchApplyUpdateAction' :: BatchApplyUpdateAction -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"BatchApplyUpdateAction" :: 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
      ]