{-# 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.CloudHSM.ModifyHapg
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This is documentation for __AWS CloudHSM Classic__. For more
-- information, see
-- <http://aws.amazon.com/cloudhsm/faqs-classic/ AWS CloudHSM Classic FAQs>,
-- the
-- <https://docs.aws.amazon.com/cloudhsm/classic/userguide/ AWS CloudHSM Classic User Guide>,
-- and the
-- <https://docs.aws.amazon.com/cloudhsm/classic/APIReference/ AWS CloudHSM Classic API Reference>.
--
-- __For information about the current version of AWS CloudHSM__, see
-- <http://aws.amazon.com/cloudhsm/ AWS CloudHSM>, the
-- <https://docs.aws.amazon.com/cloudhsm/latest/userguide/ AWS CloudHSM User Guide>,
-- and the
-- <https://docs.aws.amazon.com/cloudhsm/latest/APIReference/ AWS CloudHSM API Reference>.
--
-- Modifies an existing high-availability partition group.
module Amazonka.CloudHSM.ModifyHapg
  ( -- * Creating a Request
    ModifyHapg (..),
    newModifyHapg,

    -- * Request Lenses
    modifyHapg_label,
    modifyHapg_partitionSerialList,
    modifyHapg_hapgArn,

    -- * Destructuring the Response
    ModifyHapgResponse (..),
    newModifyHapgResponse,

    -- * Response Lenses
    modifyHapgResponse_hapgArn,
    modifyHapgResponse_httpStatus,
  )
where

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

-- | /See:/ 'newModifyHapg' smart constructor.
data ModifyHapg = ModifyHapg'
  { -- | The new label for the high-availability partition group.
    ModifyHapg -> Maybe Text
label :: Prelude.Maybe Prelude.Text,
    -- | The list of partition serial numbers to make members of the
    -- high-availability partition group.
    ModifyHapg -> Maybe [Text]
partitionSerialList :: Prelude.Maybe [Prelude.Text],
    -- | The ARN of the high-availability partition group to modify.
    ModifyHapg -> Text
hapgArn :: Prelude.Text
  }
  deriving (ModifyHapg -> ModifyHapg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyHapg -> ModifyHapg -> Bool
$c/= :: ModifyHapg -> ModifyHapg -> Bool
== :: ModifyHapg -> ModifyHapg -> Bool
$c== :: ModifyHapg -> ModifyHapg -> Bool
Prelude.Eq, ReadPrec [ModifyHapg]
ReadPrec ModifyHapg
Int -> ReadS ModifyHapg
ReadS [ModifyHapg]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyHapg]
$creadListPrec :: ReadPrec [ModifyHapg]
readPrec :: ReadPrec ModifyHapg
$creadPrec :: ReadPrec ModifyHapg
readList :: ReadS [ModifyHapg]
$creadList :: ReadS [ModifyHapg]
readsPrec :: Int -> ReadS ModifyHapg
$creadsPrec :: Int -> ReadS ModifyHapg
Prelude.Read, Int -> ModifyHapg -> ShowS
[ModifyHapg] -> ShowS
ModifyHapg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyHapg] -> ShowS
$cshowList :: [ModifyHapg] -> ShowS
show :: ModifyHapg -> String
$cshow :: ModifyHapg -> String
showsPrec :: Int -> ModifyHapg -> ShowS
$cshowsPrec :: Int -> ModifyHapg -> ShowS
Prelude.Show, forall x. Rep ModifyHapg x -> ModifyHapg
forall x. ModifyHapg -> Rep ModifyHapg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyHapg x -> ModifyHapg
$cfrom :: forall x. ModifyHapg -> Rep ModifyHapg x
Prelude.Generic)

-- |
-- Create a value of 'ModifyHapg' 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:
--
-- 'label', 'modifyHapg_label' - The new label for the high-availability partition group.
--
-- 'partitionSerialList', 'modifyHapg_partitionSerialList' - The list of partition serial numbers to make members of the
-- high-availability partition group.
--
-- 'hapgArn', 'modifyHapg_hapgArn' - The ARN of the high-availability partition group to modify.
newModifyHapg ::
  -- | 'hapgArn'
  Prelude.Text ->
  ModifyHapg
newModifyHapg :: Text -> ModifyHapg
newModifyHapg Text
pHapgArn_ =
  ModifyHapg'
    { $sel:label:ModifyHapg' :: Maybe Text
label = forall a. Maybe a
Prelude.Nothing,
      $sel:partitionSerialList:ModifyHapg' :: Maybe [Text]
partitionSerialList = forall a. Maybe a
Prelude.Nothing,
      $sel:hapgArn:ModifyHapg' :: Text
hapgArn = Text
pHapgArn_
    }

-- | The new label for the high-availability partition group.
modifyHapg_label :: Lens.Lens' ModifyHapg (Prelude.Maybe Prelude.Text)
modifyHapg_label :: Lens' ModifyHapg (Maybe Text)
modifyHapg_label = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHapg' {Maybe Text
label :: Maybe Text
$sel:label:ModifyHapg' :: ModifyHapg -> Maybe Text
label} -> Maybe Text
label) (\s :: ModifyHapg
s@ModifyHapg' {} Maybe Text
a -> ModifyHapg
s {$sel:label:ModifyHapg' :: Maybe Text
label = Maybe Text
a} :: ModifyHapg)

-- | The list of partition serial numbers to make members of the
-- high-availability partition group.
modifyHapg_partitionSerialList :: Lens.Lens' ModifyHapg (Prelude.Maybe [Prelude.Text])
modifyHapg_partitionSerialList :: Lens' ModifyHapg (Maybe [Text])
modifyHapg_partitionSerialList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHapg' {Maybe [Text]
partitionSerialList :: Maybe [Text]
$sel:partitionSerialList:ModifyHapg' :: ModifyHapg -> Maybe [Text]
partitionSerialList} -> Maybe [Text]
partitionSerialList) (\s :: ModifyHapg
s@ModifyHapg' {} Maybe [Text]
a -> ModifyHapg
s {$sel:partitionSerialList:ModifyHapg' :: Maybe [Text]
partitionSerialList = Maybe [Text]
a} :: ModifyHapg) 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 ARN of the high-availability partition group to modify.
modifyHapg_hapgArn :: Lens.Lens' ModifyHapg Prelude.Text
modifyHapg_hapgArn :: Lens' ModifyHapg Text
modifyHapg_hapgArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHapg' {Text
hapgArn :: Text
$sel:hapgArn:ModifyHapg' :: ModifyHapg -> Text
hapgArn} -> Text
hapgArn) (\s :: ModifyHapg
s@ModifyHapg' {} Text
a -> ModifyHapg
s {$sel:hapgArn:ModifyHapg' :: Text
hapgArn = Text
a} :: ModifyHapg)

instance Core.AWSRequest ModifyHapg where
  type AWSResponse ModifyHapg = ModifyHapgResponse
  request :: (Service -> Service) -> ModifyHapg -> Request ModifyHapg
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 ModifyHapg
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ModifyHapg)))
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 Text -> Int -> ModifyHapgResponse
ModifyHapgResponse'
            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
"HapgArn")
            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 ModifyHapg where
  hashWithSalt :: Int -> ModifyHapg -> Int
hashWithSalt Int
_salt ModifyHapg' {Maybe [Text]
Maybe Text
Text
hapgArn :: Text
partitionSerialList :: Maybe [Text]
label :: Maybe Text
$sel:hapgArn:ModifyHapg' :: ModifyHapg -> Text
$sel:partitionSerialList:ModifyHapg' :: ModifyHapg -> Maybe [Text]
$sel:label:ModifyHapg' :: ModifyHapg -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
label
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
partitionSerialList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hapgArn

instance Prelude.NFData ModifyHapg where
  rnf :: ModifyHapg -> ()
rnf ModifyHapg' {Maybe [Text]
Maybe Text
Text
hapgArn :: Text
partitionSerialList :: Maybe [Text]
label :: Maybe Text
$sel:hapgArn:ModifyHapg' :: ModifyHapg -> Text
$sel:partitionSerialList:ModifyHapg' :: ModifyHapg -> Maybe [Text]
$sel:label:ModifyHapg' :: ModifyHapg -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
label
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
partitionSerialList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
hapgArn

instance Data.ToHeaders ModifyHapg where
  toHeaders :: ModifyHapg -> 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
"CloudHsmFrontendService.ModifyHapg" ::
                          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 ModifyHapg where
  toJSON :: ModifyHapg -> Value
toJSON ModifyHapg' {Maybe [Text]
Maybe Text
Text
hapgArn :: Text
partitionSerialList :: Maybe [Text]
label :: Maybe Text
$sel:hapgArn:ModifyHapg' :: ModifyHapg -> Text
$sel:partitionSerialList:ModifyHapg' :: ModifyHapg -> Maybe [Text]
$sel:label:ModifyHapg' :: ModifyHapg -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Label" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
label,
            (Key
"PartitionSerialList" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
partitionSerialList,
            forall a. a -> Maybe a
Prelude.Just (Key
"HapgArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
hapgArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'ModifyHapgResponse' 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:
--
-- 'hapgArn', 'modifyHapgResponse_hapgArn' - The ARN of the high-availability partition group.
--
-- 'httpStatus', 'modifyHapgResponse_httpStatus' - The response's http status code.
newModifyHapgResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyHapgResponse
newModifyHapgResponse :: Int -> ModifyHapgResponse
newModifyHapgResponse Int
pHttpStatus_ =
  ModifyHapgResponse'
    { $sel:hapgArn:ModifyHapgResponse' :: Maybe Text
hapgArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyHapgResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the high-availability partition group.
modifyHapgResponse_hapgArn :: Lens.Lens' ModifyHapgResponse (Prelude.Maybe Prelude.Text)
modifyHapgResponse_hapgArn :: Lens' ModifyHapgResponse (Maybe Text)
modifyHapgResponse_hapgArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHapgResponse' {Maybe Text
hapgArn :: Maybe Text
$sel:hapgArn:ModifyHapgResponse' :: ModifyHapgResponse -> Maybe Text
hapgArn} -> Maybe Text
hapgArn) (\s :: ModifyHapgResponse
s@ModifyHapgResponse' {} Maybe Text
a -> ModifyHapgResponse
s {$sel:hapgArn:ModifyHapgResponse' :: Maybe Text
hapgArn = Maybe Text
a} :: ModifyHapgResponse)

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

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