{-# 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.MemoryDb.FailoverShard
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Used to failover a shard. This API is designed for testing the behavior
-- of your application in case of MemoryDB failover. It is not designed to
-- be used as a production-level tool for initiating a failover to overcome
-- a problem you may have with the cluster. Moreover, in certain conditions
-- such as large scale operational events, Amazon may block this API.
module Amazonka.MemoryDb.FailoverShard
  ( -- * Creating a Request
    FailoverShard (..),
    newFailoverShard,

    -- * Request Lenses
    failoverShard_clusterName,
    failoverShard_shardName,

    -- * Destructuring the Response
    FailoverShardResponse (..),
    newFailoverShardResponse,

    -- * Response Lenses
    failoverShardResponse_cluster,
    failoverShardResponse_httpStatus,
  )
where

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

-- | /See:/ 'newFailoverShard' smart constructor.
data FailoverShard = FailoverShard'
  { -- | The cluster being failed over
    FailoverShard -> Text
clusterName :: Prelude.Text,
    -- | The name of the shard
    FailoverShard -> Text
shardName :: Prelude.Text
  }
  deriving (FailoverShard -> FailoverShard -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailoverShard -> FailoverShard -> Bool
$c/= :: FailoverShard -> FailoverShard -> Bool
== :: FailoverShard -> FailoverShard -> Bool
$c== :: FailoverShard -> FailoverShard -> Bool
Prelude.Eq, ReadPrec [FailoverShard]
ReadPrec FailoverShard
Int -> ReadS FailoverShard
ReadS [FailoverShard]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FailoverShard]
$creadListPrec :: ReadPrec [FailoverShard]
readPrec :: ReadPrec FailoverShard
$creadPrec :: ReadPrec FailoverShard
readList :: ReadS [FailoverShard]
$creadList :: ReadS [FailoverShard]
readsPrec :: Int -> ReadS FailoverShard
$creadsPrec :: Int -> ReadS FailoverShard
Prelude.Read, Int -> FailoverShard -> ShowS
[FailoverShard] -> ShowS
FailoverShard -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailoverShard] -> ShowS
$cshowList :: [FailoverShard] -> ShowS
show :: FailoverShard -> String
$cshow :: FailoverShard -> String
showsPrec :: Int -> FailoverShard -> ShowS
$cshowsPrec :: Int -> FailoverShard -> ShowS
Prelude.Show, forall x. Rep FailoverShard x -> FailoverShard
forall x. FailoverShard -> Rep FailoverShard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FailoverShard x -> FailoverShard
$cfrom :: forall x. FailoverShard -> Rep FailoverShard x
Prelude.Generic)

-- |
-- Create a value of 'FailoverShard' 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:
--
-- 'clusterName', 'failoverShard_clusterName' - The cluster being failed over
--
-- 'shardName', 'failoverShard_shardName' - The name of the shard
newFailoverShard ::
  -- | 'clusterName'
  Prelude.Text ->
  -- | 'shardName'
  Prelude.Text ->
  FailoverShard
newFailoverShard :: Text -> Text -> FailoverShard
newFailoverShard Text
pClusterName_ Text
pShardName_ =
  FailoverShard'
    { $sel:clusterName:FailoverShard' :: Text
clusterName = Text
pClusterName_,
      $sel:shardName:FailoverShard' :: Text
shardName = Text
pShardName_
    }

-- | The cluster being failed over
failoverShard_clusterName :: Lens.Lens' FailoverShard Prelude.Text
failoverShard_clusterName :: Lens' FailoverShard Text
failoverShard_clusterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FailoverShard' {Text
clusterName :: Text
$sel:clusterName:FailoverShard' :: FailoverShard -> Text
clusterName} -> Text
clusterName) (\s :: FailoverShard
s@FailoverShard' {} Text
a -> FailoverShard
s {$sel:clusterName:FailoverShard' :: Text
clusterName = Text
a} :: FailoverShard)

-- | The name of the shard
failoverShard_shardName :: Lens.Lens' FailoverShard Prelude.Text
failoverShard_shardName :: Lens' FailoverShard Text
failoverShard_shardName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FailoverShard' {Text
shardName :: Text
$sel:shardName:FailoverShard' :: FailoverShard -> Text
shardName} -> Text
shardName) (\s :: FailoverShard
s@FailoverShard' {} Text
a -> FailoverShard
s {$sel:shardName:FailoverShard' :: Text
shardName = Text
a} :: FailoverShard)

instance Core.AWSRequest FailoverShard where
  type
    AWSResponse FailoverShard =
      FailoverShardResponse
  request :: (Service -> Service) -> FailoverShard -> Request FailoverShard
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 FailoverShard
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse FailoverShard)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Cluster -> Int -> FailoverShardResponse
FailoverShardResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Cluster")
            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 FailoverShard where
  hashWithSalt :: Int -> FailoverShard -> Int
hashWithSalt Int
_salt FailoverShard' {Text
shardName :: Text
clusterName :: Text
$sel:shardName:FailoverShard' :: FailoverShard -> Text
$sel:clusterName:FailoverShard' :: FailoverShard -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
shardName

instance Prelude.NFData FailoverShard where
  rnf :: FailoverShard -> ()
rnf FailoverShard' {Text
shardName :: Text
clusterName :: Text
$sel:shardName:FailoverShard' :: FailoverShard -> Text
$sel:clusterName:FailoverShard' :: FailoverShard -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
clusterName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
shardName

instance Data.ToHeaders FailoverShard where
  toHeaders :: FailoverShard -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AmazonMemoryDB.FailoverShard" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON FailoverShard where
  toJSON :: FailoverShard -> Value
toJSON FailoverShard' {Text
shardName :: Text
clusterName :: Text
$sel:shardName:FailoverShard' :: FailoverShard -> Text
$sel:clusterName:FailoverShard' :: FailoverShard -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ClusterName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clusterName),
            forall a. a -> Maybe a
Prelude.Just (Key
"ShardName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
shardName)
          ]
      )

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

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

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

-- |
-- Create a value of 'FailoverShardResponse' 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:
--
-- 'cluster', 'failoverShardResponse_cluster' - The cluster being failed over
--
-- 'httpStatus', 'failoverShardResponse_httpStatus' - The response's http status code.
newFailoverShardResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  FailoverShardResponse
newFailoverShardResponse :: Int -> FailoverShardResponse
newFailoverShardResponse Int
pHttpStatus_ =
  FailoverShardResponse'
    { $sel:cluster:FailoverShardResponse' :: Maybe Cluster
cluster = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:FailoverShardResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The cluster being failed over
failoverShardResponse_cluster :: Lens.Lens' FailoverShardResponse (Prelude.Maybe Cluster)
failoverShardResponse_cluster :: Lens' FailoverShardResponse (Maybe Cluster)
failoverShardResponse_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FailoverShardResponse' {Maybe Cluster
cluster :: Maybe Cluster
$sel:cluster:FailoverShardResponse' :: FailoverShardResponse -> Maybe Cluster
cluster} -> Maybe Cluster
cluster) (\s :: FailoverShardResponse
s@FailoverShardResponse' {} Maybe Cluster
a -> FailoverShardResponse
s {$sel:cluster:FailoverShardResponse' :: Maybe Cluster
cluster = Maybe Cluster
a} :: FailoverShardResponse)

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

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