{-# 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.DescribeUpdateActions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns details of the update actions
--
-- This operation returns paginated results.
module Amazonka.ElastiCache.DescribeUpdateActions
  ( -- * Creating a Request
    DescribeUpdateActions (..),
    newDescribeUpdateActions,

    -- * Request Lenses
    describeUpdateActions_cacheClusterIds,
    describeUpdateActions_engine,
    describeUpdateActions_marker,
    describeUpdateActions_maxRecords,
    describeUpdateActions_replicationGroupIds,
    describeUpdateActions_serviceUpdateName,
    describeUpdateActions_serviceUpdateStatus,
    describeUpdateActions_serviceUpdateTimeRange,
    describeUpdateActions_showNodeLevelUpdateStatus,
    describeUpdateActions_updateActionStatus,

    -- * Destructuring the Response
    DescribeUpdateActionsResponse (..),
    newDescribeUpdateActionsResponse,

    -- * Response Lenses
    describeUpdateActionsResponse_marker,
    describeUpdateActionsResponse_updateActions,
    describeUpdateActionsResponse_httpStatus,
  )
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:/ 'newDescribeUpdateActions' smart constructor.
data DescribeUpdateActions = DescribeUpdateActions'
  { -- | The cache cluster IDs
    DescribeUpdateActions -> Maybe [Text]
cacheClusterIds :: Prelude.Maybe [Prelude.Text],
    -- | The Elasticache engine to which the update applies. Either Redis or
    -- Memcached
    DescribeUpdateActions -> Maybe Text
engine :: Prelude.Maybe Prelude.Text,
    -- | An optional marker returned from a prior request. Use this marker for
    -- pagination of results from this operation. If this parameter is
    -- specified, the response includes only records beyond the marker, up to
    -- the value specified by @MaxRecords@.
    DescribeUpdateActions -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of records to include in the response
    DescribeUpdateActions -> Maybe Int
maxRecords :: Prelude.Maybe Prelude.Int,
    -- | The replication group IDs
    DescribeUpdateActions -> Maybe [Text]
replicationGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The unique ID of the service update
    DescribeUpdateActions -> Maybe Text
serviceUpdateName :: Prelude.Maybe Prelude.Text,
    -- | The status of the service update
    DescribeUpdateActions -> Maybe [ServiceUpdateStatus]
serviceUpdateStatus :: Prelude.Maybe [ServiceUpdateStatus],
    -- | The range of time specified to search for service updates that are in
    -- available status
    DescribeUpdateActions -> Maybe TimeRangeFilter
serviceUpdateTimeRange :: Prelude.Maybe TimeRangeFilter,
    -- | Dictates whether to include node level update status in the response
    DescribeUpdateActions -> Maybe Bool
showNodeLevelUpdateStatus :: Prelude.Maybe Prelude.Bool,
    -- | The status of the update action.
    DescribeUpdateActions -> Maybe [UpdateActionStatus]
updateActionStatus :: Prelude.Maybe [UpdateActionStatus]
  }
  deriving (DescribeUpdateActions -> DescribeUpdateActions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeUpdateActions -> DescribeUpdateActions -> Bool
$c/= :: DescribeUpdateActions -> DescribeUpdateActions -> Bool
== :: DescribeUpdateActions -> DescribeUpdateActions -> Bool
$c== :: DescribeUpdateActions -> DescribeUpdateActions -> Bool
Prelude.Eq, ReadPrec [DescribeUpdateActions]
ReadPrec DescribeUpdateActions
Int -> ReadS DescribeUpdateActions
ReadS [DescribeUpdateActions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeUpdateActions]
$creadListPrec :: ReadPrec [DescribeUpdateActions]
readPrec :: ReadPrec DescribeUpdateActions
$creadPrec :: ReadPrec DescribeUpdateActions
readList :: ReadS [DescribeUpdateActions]
$creadList :: ReadS [DescribeUpdateActions]
readsPrec :: Int -> ReadS DescribeUpdateActions
$creadsPrec :: Int -> ReadS DescribeUpdateActions
Prelude.Read, Int -> DescribeUpdateActions -> ShowS
[DescribeUpdateActions] -> ShowS
DescribeUpdateActions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeUpdateActions] -> ShowS
$cshowList :: [DescribeUpdateActions] -> ShowS
show :: DescribeUpdateActions -> String
$cshow :: DescribeUpdateActions -> String
showsPrec :: Int -> DescribeUpdateActions -> ShowS
$cshowsPrec :: Int -> DescribeUpdateActions -> ShowS
Prelude.Show, forall x. Rep DescribeUpdateActions x -> DescribeUpdateActions
forall x. DescribeUpdateActions -> Rep DescribeUpdateActions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeUpdateActions x -> DescribeUpdateActions
$cfrom :: forall x. DescribeUpdateActions -> Rep DescribeUpdateActions x
Prelude.Generic)

-- |
-- Create a value of 'DescribeUpdateActions' 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', 'describeUpdateActions_cacheClusterIds' - The cache cluster IDs
--
-- 'engine', 'describeUpdateActions_engine' - The Elasticache engine to which the update applies. Either Redis or
-- Memcached
--
-- 'marker', 'describeUpdateActions_marker' - An optional marker returned from a prior request. Use this marker for
-- pagination of results from this operation. If this parameter is
-- specified, the response includes only records beyond the marker, up to
-- the value specified by @MaxRecords@.
--
-- 'maxRecords', 'describeUpdateActions_maxRecords' - The maximum number of records to include in the response
--
-- 'replicationGroupIds', 'describeUpdateActions_replicationGroupIds' - The replication group IDs
--
-- 'serviceUpdateName', 'describeUpdateActions_serviceUpdateName' - The unique ID of the service update
--
-- 'serviceUpdateStatus', 'describeUpdateActions_serviceUpdateStatus' - The status of the service update
--
-- 'serviceUpdateTimeRange', 'describeUpdateActions_serviceUpdateTimeRange' - The range of time specified to search for service updates that are in
-- available status
--
-- 'showNodeLevelUpdateStatus', 'describeUpdateActions_showNodeLevelUpdateStatus' - Dictates whether to include node level update status in the response
--
-- 'updateActionStatus', 'describeUpdateActions_updateActionStatus' - The status of the update action.
newDescribeUpdateActions ::
  DescribeUpdateActions
newDescribeUpdateActions :: DescribeUpdateActions
newDescribeUpdateActions =
  DescribeUpdateActions'
    { $sel:cacheClusterIds:DescribeUpdateActions' :: Maybe [Text]
cacheClusterIds =
        forall a. Maybe a
Prelude.Nothing,
      $sel:engine:DescribeUpdateActions' :: Maybe Text
engine = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:DescribeUpdateActions' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxRecords:DescribeUpdateActions' :: Maybe Int
maxRecords = forall a. Maybe a
Prelude.Nothing,
      $sel:replicationGroupIds:DescribeUpdateActions' :: Maybe [Text]
replicationGroupIds = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceUpdateName:DescribeUpdateActions' :: Maybe Text
serviceUpdateName = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceUpdateStatus:DescribeUpdateActions' :: Maybe [ServiceUpdateStatus]
serviceUpdateStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceUpdateTimeRange:DescribeUpdateActions' :: Maybe TimeRangeFilter
serviceUpdateTimeRange = forall a. Maybe a
Prelude.Nothing,
      $sel:showNodeLevelUpdateStatus:DescribeUpdateActions' :: Maybe Bool
showNodeLevelUpdateStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:updateActionStatus:DescribeUpdateActions' :: Maybe [UpdateActionStatus]
updateActionStatus = forall a. Maybe a
Prelude.Nothing
    }

-- | The cache cluster IDs
describeUpdateActions_cacheClusterIds :: Lens.Lens' DescribeUpdateActions (Prelude.Maybe [Prelude.Text])
describeUpdateActions_cacheClusterIds :: Lens' DescribeUpdateActions (Maybe [Text])
describeUpdateActions_cacheClusterIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdateActions' {Maybe [Text]
cacheClusterIds :: Maybe [Text]
$sel:cacheClusterIds:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe [Text]
cacheClusterIds} -> Maybe [Text]
cacheClusterIds) (\s :: DescribeUpdateActions
s@DescribeUpdateActions' {} Maybe [Text]
a -> DescribeUpdateActions
s {$sel:cacheClusterIds:DescribeUpdateActions' :: Maybe [Text]
cacheClusterIds = Maybe [Text]
a} :: DescribeUpdateActions) 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 Elasticache engine to which the update applies. Either Redis or
-- Memcached
describeUpdateActions_engine :: Lens.Lens' DescribeUpdateActions (Prelude.Maybe Prelude.Text)
describeUpdateActions_engine :: Lens' DescribeUpdateActions (Maybe Text)
describeUpdateActions_engine = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdateActions' {Maybe Text
engine :: Maybe Text
$sel:engine:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Text
engine} -> Maybe Text
engine) (\s :: DescribeUpdateActions
s@DescribeUpdateActions' {} Maybe Text
a -> DescribeUpdateActions
s {$sel:engine:DescribeUpdateActions' :: Maybe Text
engine = Maybe Text
a} :: DescribeUpdateActions)

-- | An optional marker returned from a prior request. Use this marker for
-- pagination of results from this operation. If this parameter is
-- specified, the response includes only records beyond the marker, up to
-- the value specified by @MaxRecords@.
describeUpdateActions_marker :: Lens.Lens' DescribeUpdateActions (Prelude.Maybe Prelude.Text)
describeUpdateActions_marker :: Lens' DescribeUpdateActions (Maybe Text)
describeUpdateActions_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdateActions' {Maybe Text
marker :: Maybe Text
$sel:marker:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Text
marker} -> Maybe Text
marker) (\s :: DescribeUpdateActions
s@DescribeUpdateActions' {} Maybe Text
a -> DescribeUpdateActions
s {$sel:marker:DescribeUpdateActions' :: Maybe Text
marker = Maybe Text
a} :: DescribeUpdateActions)

-- | The maximum number of records to include in the response
describeUpdateActions_maxRecords :: Lens.Lens' DescribeUpdateActions (Prelude.Maybe Prelude.Int)
describeUpdateActions_maxRecords :: Lens' DescribeUpdateActions (Maybe Int)
describeUpdateActions_maxRecords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdateActions' {Maybe Int
maxRecords :: Maybe Int
$sel:maxRecords:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Int
maxRecords} -> Maybe Int
maxRecords) (\s :: DescribeUpdateActions
s@DescribeUpdateActions' {} Maybe Int
a -> DescribeUpdateActions
s {$sel:maxRecords:DescribeUpdateActions' :: Maybe Int
maxRecords = Maybe Int
a} :: DescribeUpdateActions)

-- | The replication group IDs
describeUpdateActions_replicationGroupIds :: Lens.Lens' DescribeUpdateActions (Prelude.Maybe [Prelude.Text])
describeUpdateActions_replicationGroupIds :: Lens' DescribeUpdateActions (Maybe [Text])
describeUpdateActions_replicationGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdateActions' {Maybe [Text]
replicationGroupIds :: Maybe [Text]
$sel:replicationGroupIds:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe [Text]
replicationGroupIds} -> Maybe [Text]
replicationGroupIds) (\s :: DescribeUpdateActions
s@DescribeUpdateActions' {} Maybe [Text]
a -> DescribeUpdateActions
s {$sel:replicationGroupIds:DescribeUpdateActions' :: Maybe [Text]
replicationGroupIds = Maybe [Text]
a} :: DescribeUpdateActions) 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
describeUpdateActions_serviceUpdateName :: Lens.Lens' DescribeUpdateActions (Prelude.Maybe Prelude.Text)
describeUpdateActions_serviceUpdateName :: Lens' DescribeUpdateActions (Maybe Text)
describeUpdateActions_serviceUpdateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdateActions' {Maybe Text
serviceUpdateName :: Maybe Text
$sel:serviceUpdateName:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Text
serviceUpdateName} -> Maybe Text
serviceUpdateName) (\s :: DescribeUpdateActions
s@DescribeUpdateActions' {} Maybe Text
a -> DescribeUpdateActions
s {$sel:serviceUpdateName:DescribeUpdateActions' :: Maybe Text
serviceUpdateName = Maybe Text
a} :: DescribeUpdateActions)

-- | The status of the service update
describeUpdateActions_serviceUpdateStatus :: Lens.Lens' DescribeUpdateActions (Prelude.Maybe [ServiceUpdateStatus])
describeUpdateActions_serviceUpdateStatus :: Lens' DescribeUpdateActions (Maybe [ServiceUpdateStatus])
describeUpdateActions_serviceUpdateStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdateActions' {Maybe [ServiceUpdateStatus]
serviceUpdateStatus :: Maybe [ServiceUpdateStatus]
$sel:serviceUpdateStatus:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe [ServiceUpdateStatus]
serviceUpdateStatus} -> Maybe [ServiceUpdateStatus]
serviceUpdateStatus) (\s :: DescribeUpdateActions
s@DescribeUpdateActions' {} Maybe [ServiceUpdateStatus]
a -> DescribeUpdateActions
s {$sel:serviceUpdateStatus:DescribeUpdateActions' :: Maybe [ServiceUpdateStatus]
serviceUpdateStatus = Maybe [ServiceUpdateStatus]
a} :: DescribeUpdateActions) 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 range of time specified to search for service updates that are in
-- available status
describeUpdateActions_serviceUpdateTimeRange :: Lens.Lens' DescribeUpdateActions (Prelude.Maybe TimeRangeFilter)
describeUpdateActions_serviceUpdateTimeRange :: Lens' DescribeUpdateActions (Maybe TimeRangeFilter)
describeUpdateActions_serviceUpdateTimeRange = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdateActions' {Maybe TimeRangeFilter
serviceUpdateTimeRange :: Maybe TimeRangeFilter
$sel:serviceUpdateTimeRange:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe TimeRangeFilter
serviceUpdateTimeRange} -> Maybe TimeRangeFilter
serviceUpdateTimeRange) (\s :: DescribeUpdateActions
s@DescribeUpdateActions' {} Maybe TimeRangeFilter
a -> DescribeUpdateActions
s {$sel:serviceUpdateTimeRange:DescribeUpdateActions' :: Maybe TimeRangeFilter
serviceUpdateTimeRange = Maybe TimeRangeFilter
a} :: DescribeUpdateActions)

-- | Dictates whether to include node level update status in the response
describeUpdateActions_showNodeLevelUpdateStatus :: Lens.Lens' DescribeUpdateActions (Prelude.Maybe Prelude.Bool)
describeUpdateActions_showNodeLevelUpdateStatus :: Lens' DescribeUpdateActions (Maybe Bool)
describeUpdateActions_showNodeLevelUpdateStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdateActions' {Maybe Bool
showNodeLevelUpdateStatus :: Maybe Bool
$sel:showNodeLevelUpdateStatus:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Bool
showNodeLevelUpdateStatus} -> Maybe Bool
showNodeLevelUpdateStatus) (\s :: DescribeUpdateActions
s@DescribeUpdateActions' {} Maybe Bool
a -> DescribeUpdateActions
s {$sel:showNodeLevelUpdateStatus:DescribeUpdateActions' :: Maybe Bool
showNodeLevelUpdateStatus = Maybe Bool
a} :: DescribeUpdateActions)

-- | The status of the update action.
describeUpdateActions_updateActionStatus :: Lens.Lens' DescribeUpdateActions (Prelude.Maybe [UpdateActionStatus])
describeUpdateActions_updateActionStatus :: Lens' DescribeUpdateActions (Maybe [UpdateActionStatus])
describeUpdateActions_updateActionStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdateActions' {Maybe [UpdateActionStatus]
updateActionStatus :: Maybe [UpdateActionStatus]
$sel:updateActionStatus:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe [UpdateActionStatus]
updateActionStatus} -> Maybe [UpdateActionStatus]
updateActionStatus) (\s :: DescribeUpdateActions
s@DescribeUpdateActions' {} Maybe [UpdateActionStatus]
a -> DescribeUpdateActions
s {$sel:updateActionStatus:DescribeUpdateActions' :: Maybe [UpdateActionStatus]
updateActionStatus = Maybe [UpdateActionStatus]
a} :: DescribeUpdateActions) 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

instance Core.AWSPager DescribeUpdateActions where
  page :: DescribeUpdateActions
-> AWSResponse DescribeUpdateActions -> Maybe DescribeUpdateActions
page DescribeUpdateActions
rq AWSResponse DescribeUpdateActions
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeUpdateActions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeUpdateActionsResponse (Maybe Text)
describeUpdateActionsResponse_marker
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeUpdateActions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeUpdateActionsResponse (Maybe [UpdateAction])
describeUpdateActionsResponse_updateActions
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ DescribeUpdateActions
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeUpdateActions (Maybe Text)
describeUpdateActions_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeUpdateActions
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeUpdateActionsResponse (Maybe Text)
describeUpdateActionsResponse_marker
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest DescribeUpdateActions where
  type
    AWSResponse DescribeUpdateActions =
      DescribeUpdateActionsResponse
  request :: (Service -> Service)
-> DescribeUpdateActions -> Request DescribeUpdateActions
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 DescribeUpdateActions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeUpdateActions)))
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
"DescribeUpdateActionsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe [UpdateAction] -> Int -> DescribeUpdateActionsResponse
DescribeUpdateActionsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Marker")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"UpdateActions"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"UpdateAction")
                        )
            forall (f :: * -> *) a b. Applicative f => 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 DescribeUpdateActions where
  hashWithSalt :: Int -> DescribeUpdateActions -> Int
hashWithSalt Int
_salt DescribeUpdateActions' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [ServiceUpdateStatus]
Maybe [UpdateActionStatus]
Maybe Text
Maybe TimeRangeFilter
updateActionStatus :: Maybe [UpdateActionStatus]
showNodeLevelUpdateStatus :: Maybe Bool
serviceUpdateTimeRange :: Maybe TimeRangeFilter
serviceUpdateStatus :: Maybe [ServiceUpdateStatus]
serviceUpdateName :: Maybe Text
replicationGroupIds :: Maybe [Text]
maxRecords :: Maybe Int
marker :: Maybe Text
engine :: Maybe Text
cacheClusterIds :: Maybe [Text]
$sel:updateActionStatus:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe [UpdateActionStatus]
$sel:showNodeLevelUpdateStatus:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Bool
$sel:serviceUpdateTimeRange:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe TimeRangeFilter
$sel:serviceUpdateStatus:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe [ServiceUpdateStatus]
$sel:serviceUpdateName:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Text
$sel:replicationGroupIds:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe [Text]
$sel:maxRecords:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Int
$sel:marker:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Text
$sel:engine:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Text
$sel:cacheClusterIds:DescribeUpdateActions' :: DescribeUpdateActions -> 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
engine
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxRecords
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
replicationGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceUpdateName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ServiceUpdateStatus]
serviceUpdateStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TimeRangeFilter
serviceUpdateTimeRange
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
showNodeLevelUpdateStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [UpdateActionStatus]
updateActionStatus

instance Prelude.NFData DescribeUpdateActions where
  rnf :: DescribeUpdateActions -> ()
rnf DescribeUpdateActions' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [ServiceUpdateStatus]
Maybe [UpdateActionStatus]
Maybe Text
Maybe TimeRangeFilter
updateActionStatus :: Maybe [UpdateActionStatus]
showNodeLevelUpdateStatus :: Maybe Bool
serviceUpdateTimeRange :: Maybe TimeRangeFilter
serviceUpdateStatus :: Maybe [ServiceUpdateStatus]
serviceUpdateName :: Maybe Text
replicationGroupIds :: Maybe [Text]
maxRecords :: Maybe Int
marker :: Maybe Text
engine :: Maybe Text
cacheClusterIds :: Maybe [Text]
$sel:updateActionStatus:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe [UpdateActionStatus]
$sel:showNodeLevelUpdateStatus:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Bool
$sel:serviceUpdateTimeRange:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe TimeRangeFilter
$sel:serviceUpdateStatus:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe [ServiceUpdateStatus]
$sel:serviceUpdateName:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Text
$sel:replicationGroupIds:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe [Text]
$sel:maxRecords:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Int
$sel:marker:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Text
$sel:engine:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Text
$sel:cacheClusterIds:DescribeUpdateActions' :: DescribeUpdateActions -> 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
engine
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxRecords
      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 Maybe Text
serviceUpdateName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ServiceUpdateStatus]
serviceUpdateStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TimeRangeFilter
serviceUpdateTimeRange
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
showNodeLevelUpdateStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UpdateActionStatus]
updateActionStatus

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

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

instance Data.ToQuery DescribeUpdateActions where
  toQuery :: DescribeUpdateActions -> QueryString
toQuery DescribeUpdateActions' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [ServiceUpdateStatus]
Maybe [UpdateActionStatus]
Maybe Text
Maybe TimeRangeFilter
updateActionStatus :: Maybe [UpdateActionStatus]
showNodeLevelUpdateStatus :: Maybe Bool
serviceUpdateTimeRange :: Maybe TimeRangeFilter
serviceUpdateStatus :: Maybe [ServiceUpdateStatus]
serviceUpdateName :: Maybe Text
replicationGroupIds :: Maybe [Text]
maxRecords :: Maybe Int
marker :: Maybe Text
engine :: Maybe Text
cacheClusterIds :: Maybe [Text]
$sel:updateActionStatus:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe [UpdateActionStatus]
$sel:showNodeLevelUpdateStatus:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Bool
$sel:serviceUpdateTimeRange:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe TimeRangeFilter
$sel:serviceUpdateStatus:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe [ServiceUpdateStatus]
$sel:serviceUpdateName:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Text
$sel:replicationGroupIds:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe [Text]
$sel:maxRecords:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Int
$sel:marker:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Text
$sel:engine:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe Text
$sel:cacheClusterIds:DescribeUpdateActions' :: DescribeUpdateActions -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DescribeUpdateActions" :: 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
"Engine" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
engine,
        ByteString
"Marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
marker,
        ByteString
"MaxRecords" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxRecords,
        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.=: Maybe Text
serviceUpdateName,
        ByteString
"ServiceUpdateStatus"
          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 [ServiceUpdateStatus]
serviceUpdateStatus
            ),
        ByteString
"ServiceUpdateTimeRange"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe TimeRangeFilter
serviceUpdateTimeRange,
        ByteString
"ShowNodeLevelUpdateStatus"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
showNodeLevelUpdateStatus,
        ByteString
"UpdateActionStatus"
          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 [UpdateActionStatus]
updateActionStatus
            )
      ]

-- | /See:/ 'newDescribeUpdateActionsResponse' smart constructor.
data DescribeUpdateActionsResponse = DescribeUpdateActionsResponse'
  { -- | An optional marker returned from a prior request. Use this marker for
    -- pagination of results from this operation. If this parameter is
    -- specified, the response includes only records beyond the marker, up to
    -- the value specified by @MaxRecords@.
    DescribeUpdateActionsResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | Returns a list of update actions
    DescribeUpdateActionsResponse -> Maybe [UpdateAction]
updateActions :: Prelude.Maybe [UpdateAction],
    -- | The response's http status code.
    DescribeUpdateActionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeUpdateActionsResponse
-> DescribeUpdateActionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeUpdateActionsResponse
-> DescribeUpdateActionsResponse -> Bool
$c/= :: DescribeUpdateActionsResponse
-> DescribeUpdateActionsResponse -> Bool
== :: DescribeUpdateActionsResponse
-> DescribeUpdateActionsResponse -> Bool
$c== :: DescribeUpdateActionsResponse
-> DescribeUpdateActionsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeUpdateActionsResponse]
ReadPrec DescribeUpdateActionsResponse
Int -> ReadS DescribeUpdateActionsResponse
ReadS [DescribeUpdateActionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeUpdateActionsResponse]
$creadListPrec :: ReadPrec [DescribeUpdateActionsResponse]
readPrec :: ReadPrec DescribeUpdateActionsResponse
$creadPrec :: ReadPrec DescribeUpdateActionsResponse
readList :: ReadS [DescribeUpdateActionsResponse]
$creadList :: ReadS [DescribeUpdateActionsResponse]
readsPrec :: Int -> ReadS DescribeUpdateActionsResponse
$creadsPrec :: Int -> ReadS DescribeUpdateActionsResponse
Prelude.Read, Int -> DescribeUpdateActionsResponse -> ShowS
[DescribeUpdateActionsResponse] -> ShowS
DescribeUpdateActionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeUpdateActionsResponse] -> ShowS
$cshowList :: [DescribeUpdateActionsResponse] -> ShowS
show :: DescribeUpdateActionsResponse -> String
$cshow :: DescribeUpdateActionsResponse -> String
showsPrec :: Int -> DescribeUpdateActionsResponse -> ShowS
$cshowsPrec :: Int -> DescribeUpdateActionsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeUpdateActionsResponse x
-> DescribeUpdateActionsResponse
forall x.
DescribeUpdateActionsResponse
-> Rep DescribeUpdateActionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeUpdateActionsResponse x
-> DescribeUpdateActionsResponse
$cfrom :: forall x.
DescribeUpdateActionsResponse
-> Rep DescribeUpdateActionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeUpdateActionsResponse' 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:
--
-- 'marker', 'describeUpdateActionsResponse_marker' - An optional marker returned from a prior request. Use this marker for
-- pagination of results from this operation. If this parameter is
-- specified, the response includes only records beyond the marker, up to
-- the value specified by @MaxRecords@.
--
-- 'updateActions', 'describeUpdateActionsResponse_updateActions' - Returns a list of update actions
--
-- 'httpStatus', 'describeUpdateActionsResponse_httpStatus' - The response's http status code.
newDescribeUpdateActionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeUpdateActionsResponse
newDescribeUpdateActionsResponse :: Int -> DescribeUpdateActionsResponse
newDescribeUpdateActionsResponse Int
pHttpStatus_ =
  DescribeUpdateActionsResponse'
    { $sel:marker:DescribeUpdateActionsResponse' :: Maybe Text
marker =
        forall a. Maybe a
Prelude.Nothing,
      $sel:updateActions:DescribeUpdateActionsResponse' :: Maybe [UpdateAction]
updateActions = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeUpdateActionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An optional marker returned from a prior request. Use this marker for
-- pagination of results from this operation. If this parameter is
-- specified, the response includes only records beyond the marker, up to
-- the value specified by @MaxRecords@.
describeUpdateActionsResponse_marker :: Lens.Lens' DescribeUpdateActionsResponse (Prelude.Maybe Prelude.Text)
describeUpdateActionsResponse_marker :: Lens' DescribeUpdateActionsResponse (Maybe Text)
describeUpdateActionsResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdateActionsResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:DescribeUpdateActionsResponse' :: DescribeUpdateActionsResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: DescribeUpdateActionsResponse
s@DescribeUpdateActionsResponse' {} Maybe Text
a -> DescribeUpdateActionsResponse
s {$sel:marker:DescribeUpdateActionsResponse' :: Maybe Text
marker = Maybe Text
a} :: DescribeUpdateActionsResponse)

-- | Returns a list of update actions
describeUpdateActionsResponse_updateActions :: Lens.Lens' DescribeUpdateActionsResponse (Prelude.Maybe [UpdateAction])
describeUpdateActionsResponse_updateActions :: Lens' DescribeUpdateActionsResponse (Maybe [UpdateAction])
describeUpdateActionsResponse_updateActions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdateActionsResponse' {Maybe [UpdateAction]
updateActions :: Maybe [UpdateAction]
$sel:updateActions:DescribeUpdateActionsResponse' :: DescribeUpdateActionsResponse -> Maybe [UpdateAction]
updateActions} -> Maybe [UpdateAction]
updateActions) (\s :: DescribeUpdateActionsResponse
s@DescribeUpdateActionsResponse' {} Maybe [UpdateAction]
a -> DescribeUpdateActionsResponse
s {$sel:updateActions:DescribeUpdateActionsResponse' :: Maybe [UpdateAction]
updateActions = Maybe [UpdateAction]
a} :: DescribeUpdateActionsResponse) 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 response's http status code.
describeUpdateActionsResponse_httpStatus :: Lens.Lens' DescribeUpdateActionsResponse Prelude.Int
describeUpdateActionsResponse_httpStatus :: Lens' DescribeUpdateActionsResponse Int
describeUpdateActionsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdateActionsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeUpdateActionsResponse' :: DescribeUpdateActionsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeUpdateActionsResponse
s@DescribeUpdateActionsResponse' {} Int
a -> DescribeUpdateActionsResponse
s {$sel:httpStatus:DescribeUpdateActionsResponse' :: Int
httpStatus = Int
a} :: DescribeUpdateActionsResponse)

instance Prelude.NFData DescribeUpdateActionsResponse where
  rnf :: DescribeUpdateActionsResponse -> ()
rnf DescribeUpdateActionsResponse' {Int
Maybe [UpdateAction]
Maybe Text
httpStatus :: Int
updateActions :: Maybe [UpdateAction]
marker :: Maybe Text
$sel:httpStatus:DescribeUpdateActionsResponse' :: DescribeUpdateActionsResponse -> Int
$sel:updateActions:DescribeUpdateActionsResponse' :: DescribeUpdateActionsResponse -> Maybe [UpdateAction]
$sel:marker:DescribeUpdateActionsResponse' :: DescribeUpdateActionsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UpdateAction]
updateActions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus