{-# 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.ModifyHsm
-- 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 HSM.
--
-- This operation can result in the HSM being offline for up to 15 minutes
-- while the AWS CloudHSM service is reconfigured. If you are modifying a
-- production HSM, you should ensure that your AWS CloudHSM service is
-- configured for high availability, and consider executing this operation
-- during a maintenance window.
module Amazonka.CloudHSM.ModifyHsm
  ( -- * Creating a Request
    ModifyHsm (..),
    newModifyHsm,

    -- * Request Lenses
    modifyHsm_eniIp,
    modifyHsm_externalId,
    modifyHsm_iamRoleArn,
    modifyHsm_subnetId,
    modifyHsm_syslogIp,
    modifyHsm_hsmArn,

    -- * Destructuring the Response
    ModifyHsmResponse (..),
    newModifyHsmResponse,

    -- * Response Lenses
    modifyHsmResponse_hsmArn,
    modifyHsmResponse_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

-- | Contains the inputs for the ModifyHsm operation.
--
-- /See:/ 'newModifyHsm' smart constructor.
data ModifyHsm = ModifyHsm'
  { -- | The new IP address for the elastic network interface (ENI) attached to
    -- the HSM.
    --
    -- If the HSM is moved to a different subnet, and an IP address is not
    -- specified, an IP address will be randomly chosen from the CIDR range of
    -- the new subnet.
    ModifyHsm -> Maybe Text
eniIp :: Prelude.Maybe Prelude.Text,
    -- | The new external ID.
    ModifyHsm -> Maybe Text
externalId :: Prelude.Maybe Prelude.Text,
    -- | The new IAM role ARN.
    ModifyHsm -> Maybe Text
iamRoleArn :: Prelude.Maybe Prelude.Text,
    -- | The new identifier of the subnet that the HSM is in. The new subnet must
    -- be in the same Availability Zone as the current subnet.
    ModifyHsm -> Maybe Text
subnetId :: Prelude.Maybe Prelude.Text,
    -- | The new IP address for the syslog monitoring server. The AWS CloudHSM
    -- service only supports one syslog monitoring server.
    ModifyHsm -> Maybe Text
syslogIp :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the HSM to modify.
    ModifyHsm -> Text
hsmArn :: Prelude.Text
  }
  deriving (ModifyHsm -> ModifyHsm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyHsm -> ModifyHsm -> Bool
$c/= :: ModifyHsm -> ModifyHsm -> Bool
== :: ModifyHsm -> ModifyHsm -> Bool
$c== :: ModifyHsm -> ModifyHsm -> Bool
Prelude.Eq, ReadPrec [ModifyHsm]
ReadPrec ModifyHsm
Int -> ReadS ModifyHsm
ReadS [ModifyHsm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyHsm]
$creadListPrec :: ReadPrec [ModifyHsm]
readPrec :: ReadPrec ModifyHsm
$creadPrec :: ReadPrec ModifyHsm
readList :: ReadS [ModifyHsm]
$creadList :: ReadS [ModifyHsm]
readsPrec :: Int -> ReadS ModifyHsm
$creadsPrec :: Int -> ReadS ModifyHsm
Prelude.Read, Int -> ModifyHsm -> ShowS
[ModifyHsm] -> ShowS
ModifyHsm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyHsm] -> ShowS
$cshowList :: [ModifyHsm] -> ShowS
show :: ModifyHsm -> String
$cshow :: ModifyHsm -> String
showsPrec :: Int -> ModifyHsm -> ShowS
$cshowsPrec :: Int -> ModifyHsm -> ShowS
Prelude.Show, forall x. Rep ModifyHsm x -> ModifyHsm
forall x. ModifyHsm -> Rep ModifyHsm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyHsm x -> ModifyHsm
$cfrom :: forall x. ModifyHsm -> Rep ModifyHsm x
Prelude.Generic)

-- |
-- Create a value of 'ModifyHsm' 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:
--
-- 'eniIp', 'modifyHsm_eniIp' - The new IP address for the elastic network interface (ENI) attached to
-- the HSM.
--
-- If the HSM is moved to a different subnet, and an IP address is not
-- specified, an IP address will be randomly chosen from the CIDR range of
-- the new subnet.
--
-- 'externalId', 'modifyHsm_externalId' - The new external ID.
--
-- 'iamRoleArn', 'modifyHsm_iamRoleArn' - The new IAM role ARN.
--
-- 'subnetId', 'modifyHsm_subnetId' - The new identifier of the subnet that the HSM is in. The new subnet must
-- be in the same Availability Zone as the current subnet.
--
-- 'syslogIp', 'modifyHsm_syslogIp' - The new IP address for the syslog monitoring server. The AWS CloudHSM
-- service only supports one syslog monitoring server.
--
-- 'hsmArn', 'modifyHsm_hsmArn' - The ARN of the HSM to modify.
newModifyHsm ::
  -- | 'hsmArn'
  Prelude.Text ->
  ModifyHsm
newModifyHsm :: Text -> ModifyHsm
newModifyHsm Text
pHsmArn_ =
  ModifyHsm'
    { $sel:eniIp:ModifyHsm' :: Maybe Text
eniIp = forall a. Maybe a
Prelude.Nothing,
      $sel:externalId:ModifyHsm' :: Maybe Text
externalId = forall a. Maybe a
Prelude.Nothing,
      $sel:iamRoleArn:ModifyHsm' :: Maybe Text
iamRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:subnetId:ModifyHsm' :: Maybe Text
subnetId = forall a. Maybe a
Prelude.Nothing,
      $sel:syslogIp:ModifyHsm' :: Maybe Text
syslogIp = forall a. Maybe a
Prelude.Nothing,
      $sel:hsmArn:ModifyHsm' :: Text
hsmArn = Text
pHsmArn_
    }

-- | The new IP address for the elastic network interface (ENI) attached to
-- the HSM.
--
-- If the HSM is moved to a different subnet, and an IP address is not
-- specified, an IP address will be randomly chosen from the CIDR range of
-- the new subnet.
modifyHsm_eniIp :: Lens.Lens' ModifyHsm (Prelude.Maybe Prelude.Text)
modifyHsm_eniIp :: Lens' ModifyHsm (Maybe Text)
modifyHsm_eniIp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHsm' {Maybe Text
eniIp :: Maybe Text
$sel:eniIp:ModifyHsm' :: ModifyHsm -> Maybe Text
eniIp} -> Maybe Text
eniIp) (\s :: ModifyHsm
s@ModifyHsm' {} Maybe Text
a -> ModifyHsm
s {$sel:eniIp:ModifyHsm' :: Maybe Text
eniIp = Maybe Text
a} :: ModifyHsm)

-- | The new external ID.
modifyHsm_externalId :: Lens.Lens' ModifyHsm (Prelude.Maybe Prelude.Text)
modifyHsm_externalId :: Lens' ModifyHsm (Maybe Text)
modifyHsm_externalId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHsm' {Maybe Text
externalId :: Maybe Text
$sel:externalId:ModifyHsm' :: ModifyHsm -> Maybe Text
externalId} -> Maybe Text
externalId) (\s :: ModifyHsm
s@ModifyHsm' {} Maybe Text
a -> ModifyHsm
s {$sel:externalId:ModifyHsm' :: Maybe Text
externalId = Maybe Text
a} :: ModifyHsm)

-- | The new IAM role ARN.
modifyHsm_iamRoleArn :: Lens.Lens' ModifyHsm (Prelude.Maybe Prelude.Text)
modifyHsm_iamRoleArn :: Lens' ModifyHsm (Maybe Text)
modifyHsm_iamRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHsm' {Maybe Text
iamRoleArn :: Maybe Text
$sel:iamRoleArn:ModifyHsm' :: ModifyHsm -> Maybe Text
iamRoleArn} -> Maybe Text
iamRoleArn) (\s :: ModifyHsm
s@ModifyHsm' {} Maybe Text
a -> ModifyHsm
s {$sel:iamRoleArn:ModifyHsm' :: Maybe Text
iamRoleArn = Maybe Text
a} :: ModifyHsm)

-- | The new identifier of the subnet that the HSM is in. The new subnet must
-- be in the same Availability Zone as the current subnet.
modifyHsm_subnetId :: Lens.Lens' ModifyHsm (Prelude.Maybe Prelude.Text)
modifyHsm_subnetId :: Lens' ModifyHsm (Maybe Text)
modifyHsm_subnetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHsm' {Maybe Text
subnetId :: Maybe Text
$sel:subnetId:ModifyHsm' :: ModifyHsm -> Maybe Text
subnetId} -> Maybe Text
subnetId) (\s :: ModifyHsm
s@ModifyHsm' {} Maybe Text
a -> ModifyHsm
s {$sel:subnetId:ModifyHsm' :: Maybe Text
subnetId = Maybe Text
a} :: ModifyHsm)

-- | The new IP address for the syslog monitoring server. The AWS CloudHSM
-- service only supports one syslog monitoring server.
modifyHsm_syslogIp :: Lens.Lens' ModifyHsm (Prelude.Maybe Prelude.Text)
modifyHsm_syslogIp :: Lens' ModifyHsm (Maybe Text)
modifyHsm_syslogIp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHsm' {Maybe Text
syslogIp :: Maybe Text
$sel:syslogIp:ModifyHsm' :: ModifyHsm -> Maybe Text
syslogIp} -> Maybe Text
syslogIp) (\s :: ModifyHsm
s@ModifyHsm' {} Maybe Text
a -> ModifyHsm
s {$sel:syslogIp:ModifyHsm' :: Maybe Text
syslogIp = Maybe Text
a} :: ModifyHsm)

-- | The ARN of the HSM to modify.
modifyHsm_hsmArn :: Lens.Lens' ModifyHsm Prelude.Text
modifyHsm_hsmArn :: Lens' ModifyHsm Text
modifyHsm_hsmArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHsm' {Text
hsmArn :: Text
$sel:hsmArn:ModifyHsm' :: ModifyHsm -> Text
hsmArn} -> Text
hsmArn) (\s :: ModifyHsm
s@ModifyHsm' {} Text
a -> ModifyHsm
s {$sel:hsmArn:ModifyHsm' :: Text
hsmArn = Text
a} :: ModifyHsm)

instance Core.AWSRequest ModifyHsm where
  type AWSResponse ModifyHsm = ModifyHsmResponse
  request :: (Service -> Service) -> ModifyHsm -> Request ModifyHsm
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 ModifyHsm
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ModifyHsm)))
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 -> ModifyHsmResponse
ModifyHsmResponse'
            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
"HsmArn")
            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 ModifyHsm where
  hashWithSalt :: Int -> ModifyHsm -> Int
hashWithSalt Int
_salt ModifyHsm' {Maybe Text
Text
hsmArn :: Text
syslogIp :: Maybe Text
subnetId :: Maybe Text
iamRoleArn :: Maybe Text
externalId :: Maybe Text
eniIp :: Maybe Text
$sel:hsmArn:ModifyHsm' :: ModifyHsm -> Text
$sel:syslogIp:ModifyHsm' :: ModifyHsm -> Maybe Text
$sel:subnetId:ModifyHsm' :: ModifyHsm -> Maybe Text
$sel:iamRoleArn:ModifyHsm' :: ModifyHsm -> Maybe Text
$sel:externalId:ModifyHsm' :: ModifyHsm -> Maybe Text
$sel:eniIp:ModifyHsm' :: ModifyHsm -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
eniIp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
externalId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
iamRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subnetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
syslogIp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hsmArn

instance Prelude.NFData ModifyHsm where
  rnf :: ModifyHsm -> ()
rnf ModifyHsm' {Maybe Text
Text
hsmArn :: Text
syslogIp :: Maybe Text
subnetId :: Maybe Text
iamRoleArn :: Maybe Text
externalId :: Maybe Text
eniIp :: Maybe Text
$sel:hsmArn:ModifyHsm' :: ModifyHsm -> Text
$sel:syslogIp:ModifyHsm' :: ModifyHsm -> Maybe Text
$sel:subnetId:ModifyHsm' :: ModifyHsm -> Maybe Text
$sel:iamRoleArn:ModifyHsm' :: ModifyHsm -> Maybe Text
$sel:externalId:ModifyHsm' :: ModifyHsm -> Maybe Text
$sel:eniIp:ModifyHsm' :: ModifyHsm -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eniIp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
externalId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
iamRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subnetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
syslogIp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
hsmArn

instance Data.ToHeaders ModifyHsm where
  toHeaders :: ModifyHsm -> 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.ModifyHsm" ::
                          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 ModifyHsm where
  toJSON :: ModifyHsm -> Value
toJSON ModifyHsm' {Maybe Text
Text
hsmArn :: Text
syslogIp :: Maybe Text
subnetId :: Maybe Text
iamRoleArn :: Maybe Text
externalId :: Maybe Text
eniIp :: Maybe Text
$sel:hsmArn:ModifyHsm' :: ModifyHsm -> Text
$sel:syslogIp:ModifyHsm' :: ModifyHsm -> Maybe Text
$sel:subnetId:ModifyHsm' :: ModifyHsm -> Maybe Text
$sel:iamRoleArn:ModifyHsm' :: ModifyHsm -> Maybe Text
$sel:externalId:ModifyHsm' :: ModifyHsm -> Maybe Text
$sel:eniIp:ModifyHsm' :: ModifyHsm -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"EniIp" 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
eniIp,
            (Key
"ExternalId" 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
externalId,
            (Key
"IamRoleArn" 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
iamRoleArn,
            (Key
"SubnetId" 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
subnetId,
            (Key
"SyslogIp" 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
syslogIp,
            forall a. a -> Maybe a
Prelude.Just (Key
"HsmArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
hsmArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'ModifyHsmResponse' 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:
--
-- 'hsmArn', 'modifyHsmResponse_hsmArn' - The ARN of the HSM.
--
-- 'httpStatus', 'modifyHsmResponse_httpStatus' - The response's http status code.
newModifyHsmResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyHsmResponse
newModifyHsmResponse :: Int -> ModifyHsmResponse
newModifyHsmResponse Int
pHttpStatus_ =
  ModifyHsmResponse'
    { $sel:hsmArn:ModifyHsmResponse' :: Maybe Text
hsmArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyHsmResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the HSM.
modifyHsmResponse_hsmArn :: Lens.Lens' ModifyHsmResponse (Prelude.Maybe Prelude.Text)
modifyHsmResponse_hsmArn :: Lens' ModifyHsmResponse (Maybe Text)
modifyHsmResponse_hsmArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHsmResponse' {Maybe Text
hsmArn :: Maybe Text
$sel:hsmArn:ModifyHsmResponse' :: ModifyHsmResponse -> Maybe Text
hsmArn} -> Maybe Text
hsmArn) (\s :: ModifyHsmResponse
s@ModifyHsmResponse' {} Maybe Text
a -> ModifyHsmResponse
s {$sel:hsmArn:ModifyHsmResponse' :: Maybe Text
hsmArn = Maybe Text
a} :: ModifyHsmResponse)

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

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