{-# 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.RebootCacheCluster
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Reboots some, or all, of the cache nodes within a provisioned cluster.
-- This operation applies any modified cache parameter groups to the
-- cluster. The reboot operation takes place as soon as possible, and
-- results in a momentary outage to the cluster. During the reboot, the
-- cluster status is set to REBOOTING.
--
-- The reboot causes the contents of the cache (for each cache node being
-- rebooted) to be lost.
--
-- When the reboot is complete, a cluster event is created.
--
-- Rebooting a cluster is currently supported on Memcached and Redis
-- (cluster mode disabled) clusters. Rebooting is not supported on Redis
-- (cluster mode enabled) clusters.
--
-- If you make changes to parameters that require a Redis (cluster mode
-- enabled) cluster reboot for the changes to be applied, see
-- <http://docs.aws.amazon.com/AmazonElastiCache/latest/red-ug/nodes.rebooting.html Rebooting a Cluster>
-- for an alternate process.
module Amazonka.ElastiCache.RebootCacheCluster
  ( -- * Creating a Request
    RebootCacheCluster (..),
    newRebootCacheCluster,

    -- * Request Lenses
    rebootCacheCluster_cacheClusterId,
    rebootCacheCluster_cacheNodeIdsToReboot,

    -- * Destructuring the Response
    RebootCacheClusterResponse (..),
    newRebootCacheClusterResponse,

    -- * Response Lenses
    rebootCacheClusterResponse_cacheCluster,
    rebootCacheClusterResponse_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

-- | Represents the input of a @RebootCacheCluster@ operation.
--
-- /See:/ 'newRebootCacheCluster' smart constructor.
data RebootCacheCluster = RebootCacheCluster'
  { -- | The cluster identifier. This parameter is stored as a lowercase string.
    RebootCacheCluster -> Text
cacheClusterId :: Prelude.Text,
    -- | A list of cache node IDs to reboot. A node ID is a numeric identifier
    -- (0001, 0002, etc.). To reboot an entire cluster, specify all of the
    -- cache node IDs.
    RebootCacheCluster -> [Text]
cacheNodeIdsToReboot :: [Prelude.Text]
  }
  deriving (RebootCacheCluster -> RebootCacheCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RebootCacheCluster -> RebootCacheCluster -> Bool
$c/= :: RebootCacheCluster -> RebootCacheCluster -> Bool
== :: RebootCacheCluster -> RebootCacheCluster -> Bool
$c== :: RebootCacheCluster -> RebootCacheCluster -> Bool
Prelude.Eq, ReadPrec [RebootCacheCluster]
ReadPrec RebootCacheCluster
Int -> ReadS RebootCacheCluster
ReadS [RebootCacheCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RebootCacheCluster]
$creadListPrec :: ReadPrec [RebootCacheCluster]
readPrec :: ReadPrec RebootCacheCluster
$creadPrec :: ReadPrec RebootCacheCluster
readList :: ReadS [RebootCacheCluster]
$creadList :: ReadS [RebootCacheCluster]
readsPrec :: Int -> ReadS RebootCacheCluster
$creadsPrec :: Int -> ReadS RebootCacheCluster
Prelude.Read, Int -> RebootCacheCluster -> ShowS
[RebootCacheCluster] -> ShowS
RebootCacheCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RebootCacheCluster] -> ShowS
$cshowList :: [RebootCacheCluster] -> ShowS
show :: RebootCacheCluster -> String
$cshow :: RebootCacheCluster -> String
showsPrec :: Int -> RebootCacheCluster -> ShowS
$cshowsPrec :: Int -> RebootCacheCluster -> ShowS
Prelude.Show, forall x. Rep RebootCacheCluster x -> RebootCacheCluster
forall x. RebootCacheCluster -> Rep RebootCacheCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RebootCacheCluster x -> RebootCacheCluster
$cfrom :: forall x. RebootCacheCluster -> Rep RebootCacheCluster x
Prelude.Generic)

-- |
-- Create a value of 'RebootCacheCluster' 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:
--
-- 'cacheClusterId', 'rebootCacheCluster_cacheClusterId' - The cluster identifier. This parameter is stored as a lowercase string.
--
-- 'cacheNodeIdsToReboot', 'rebootCacheCluster_cacheNodeIdsToReboot' - A list of cache node IDs to reboot. A node ID is a numeric identifier
-- (0001, 0002, etc.). To reboot an entire cluster, specify all of the
-- cache node IDs.
newRebootCacheCluster ::
  -- | 'cacheClusterId'
  Prelude.Text ->
  RebootCacheCluster
newRebootCacheCluster :: Text -> RebootCacheCluster
newRebootCacheCluster Text
pCacheClusterId_ =
  RebootCacheCluster'
    { $sel:cacheClusterId:RebootCacheCluster' :: Text
cacheClusterId =
        Text
pCacheClusterId_,
      $sel:cacheNodeIdsToReboot:RebootCacheCluster' :: [Text]
cacheNodeIdsToReboot = forall a. Monoid a => a
Prelude.mempty
    }

-- | The cluster identifier. This parameter is stored as a lowercase string.
rebootCacheCluster_cacheClusterId :: Lens.Lens' RebootCacheCluster Prelude.Text
rebootCacheCluster_cacheClusterId :: Lens' RebootCacheCluster Text
rebootCacheCluster_cacheClusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RebootCacheCluster' {Text
cacheClusterId :: Text
$sel:cacheClusterId:RebootCacheCluster' :: RebootCacheCluster -> Text
cacheClusterId} -> Text
cacheClusterId) (\s :: RebootCacheCluster
s@RebootCacheCluster' {} Text
a -> RebootCacheCluster
s {$sel:cacheClusterId:RebootCacheCluster' :: Text
cacheClusterId = Text
a} :: RebootCacheCluster)

-- | A list of cache node IDs to reboot. A node ID is a numeric identifier
-- (0001, 0002, etc.). To reboot an entire cluster, specify all of the
-- cache node IDs.
rebootCacheCluster_cacheNodeIdsToReboot :: Lens.Lens' RebootCacheCluster [Prelude.Text]
rebootCacheCluster_cacheNodeIdsToReboot :: Lens' RebootCacheCluster [Text]
rebootCacheCluster_cacheNodeIdsToReboot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RebootCacheCluster' {[Text]
cacheNodeIdsToReboot :: [Text]
$sel:cacheNodeIdsToReboot:RebootCacheCluster' :: RebootCacheCluster -> [Text]
cacheNodeIdsToReboot} -> [Text]
cacheNodeIdsToReboot) (\s :: RebootCacheCluster
s@RebootCacheCluster' {} [Text]
a -> RebootCacheCluster
s {$sel:cacheNodeIdsToReboot:RebootCacheCluster' :: [Text]
cacheNodeIdsToReboot = [Text]
a} :: RebootCacheCluster) 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 RebootCacheCluster where
  type
    AWSResponse RebootCacheCluster =
      RebootCacheClusterResponse
  request :: (Service -> Service)
-> RebootCacheCluster -> Request RebootCacheCluster
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 RebootCacheCluster
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RebootCacheCluster)))
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
"RebootCacheClusterResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe CacheCluster -> Int -> RebootCacheClusterResponse
RebootCacheClusterResponse'
            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
"CacheCluster")
            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 RebootCacheCluster where
  hashWithSalt :: Int -> RebootCacheCluster -> Int
hashWithSalt Int
_salt RebootCacheCluster' {[Text]
Text
cacheNodeIdsToReboot :: [Text]
cacheClusterId :: Text
$sel:cacheNodeIdsToReboot:RebootCacheCluster' :: RebootCacheCluster -> [Text]
$sel:cacheClusterId:RebootCacheCluster' :: RebootCacheCluster -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
cacheClusterId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
cacheNodeIdsToReboot

instance Prelude.NFData RebootCacheCluster where
  rnf :: RebootCacheCluster -> ()
rnf RebootCacheCluster' {[Text]
Text
cacheNodeIdsToReboot :: [Text]
cacheClusterId :: Text
$sel:cacheNodeIdsToReboot:RebootCacheCluster' :: RebootCacheCluster -> [Text]
$sel:cacheClusterId:RebootCacheCluster' :: RebootCacheCluster -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
cacheClusterId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
cacheNodeIdsToReboot

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

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

instance Data.ToQuery RebootCacheCluster where
  toQuery :: RebootCacheCluster -> QueryString
toQuery RebootCacheCluster' {[Text]
Text
cacheNodeIdsToReboot :: [Text]
cacheClusterId :: Text
$sel:cacheNodeIdsToReboot:RebootCacheCluster' :: RebootCacheCluster -> [Text]
$sel:cacheClusterId:RebootCacheCluster' :: RebootCacheCluster -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RebootCacheCluster" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2015-02-02" :: Prelude.ByteString),
        ByteString
"CacheClusterId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
cacheClusterId,
        ByteString
"CacheNodeIdsToReboot"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"CacheNodeId" [Text]
cacheNodeIdsToReboot
      ]

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

-- |
-- Create a value of 'RebootCacheClusterResponse' 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:
--
-- 'cacheCluster', 'rebootCacheClusterResponse_cacheCluster' - Undocumented member.
--
-- 'httpStatus', 'rebootCacheClusterResponse_httpStatus' - The response's http status code.
newRebootCacheClusterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RebootCacheClusterResponse
newRebootCacheClusterResponse :: Int -> RebootCacheClusterResponse
newRebootCacheClusterResponse Int
pHttpStatus_ =
  RebootCacheClusterResponse'
    { $sel:cacheCluster:RebootCacheClusterResponse' :: Maybe CacheCluster
cacheCluster =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RebootCacheClusterResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
rebootCacheClusterResponse_cacheCluster :: Lens.Lens' RebootCacheClusterResponse (Prelude.Maybe CacheCluster)
rebootCacheClusterResponse_cacheCluster :: Lens' RebootCacheClusterResponse (Maybe CacheCluster)
rebootCacheClusterResponse_cacheCluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RebootCacheClusterResponse' {Maybe CacheCluster
cacheCluster :: Maybe CacheCluster
$sel:cacheCluster:RebootCacheClusterResponse' :: RebootCacheClusterResponse -> Maybe CacheCluster
cacheCluster} -> Maybe CacheCluster
cacheCluster) (\s :: RebootCacheClusterResponse
s@RebootCacheClusterResponse' {} Maybe CacheCluster
a -> RebootCacheClusterResponse
s {$sel:cacheCluster:RebootCacheClusterResponse' :: Maybe CacheCluster
cacheCluster = Maybe CacheCluster
a} :: RebootCacheClusterResponse)

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

instance Prelude.NFData RebootCacheClusterResponse where
  rnf :: RebootCacheClusterResponse -> ()
rnf RebootCacheClusterResponse' {Int
Maybe CacheCluster
httpStatus :: Int
cacheCluster :: Maybe CacheCluster
$sel:httpStatus:RebootCacheClusterResponse' :: RebootCacheClusterResponse -> Int
$sel:cacheCluster:RebootCacheClusterResponse' :: RebootCacheClusterResponse -> Maybe CacheCluster
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CacheCluster
cacheCluster
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus