{-# 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.Redshift.CreateHsmConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an HSM configuration that contains the information required by
-- an Amazon Redshift cluster to store and use database encryption keys in
-- a Hardware Security Module (HSM). After creating the HSM configuration,
-- you can specify it as a parameter when creating a cluster. The cluster
-- will then store its encryption keys in the HSM.
--
-- In addition to creating an HSM configuration, you must also create an
-- HSM client certificate. For more information, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-HSM.html Hardware Security Modules>
-- in the Amazon Redshift Cluster Management Guide.
module Amazonka.Redshift.CreateHsmConfiguration
  ( -- * Creating a Request
    CreateHsmConfiguration (..),
    newCreateHsmConfiguration,

    -- * Request Lenses
    createHsmConfiguration_tags,
    createHsmConfiguration_hsmConfigurationIdentifier,
    createHsmConfiguration_description,
    createHsmConfiguration_hsmIpAddress,
    createHsmConfiguration_hsmPartitionName,
    createHsmConfiguration_hsmPartitionPassword,
    createHsmConfiguration_hsmServerPublicCertificate,

    -- * Destructuring the Response
    CreateHsmConfigurationResponse (..),
    newCreateHsmConfigurationResponse,

    -- * Response Lenses
    createHsmConfigurationResponse_hsmConfiguration,
    createHsmConfigurationResponse_httpStatus,
  )
where

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 Amazonka.Redshift.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newCreateHsmConfiguration' smart constructor.
data CreateHsmConfiguration = CreateHsmConfiguration'
  { -- | A list of tag instances.
    CreateHsmConfiguration -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The identifier to be assigned to the new Amazon Redshift HSM
    -- configuration.
    CreateHsmConfiguration -> Text
hsmConfigurationIdentifier :: Prelude.Text,
    -- | A text description of the HSM configuration to be created.
    CreateHsmConfiguration -> Text
description :: Prelude.Text,
    -- | The IP address that the Amazon Redshift cluster must use to access the
    -- HSM.
    CreateHsmConfiguration -> Text
hsmIpAddress :: Prelude.Text,
    -- | The name of the partition in the HSM where the Amazon Redshift clusters
    -- will store their database encryption keys.
    CreateHsmConfiguration -> Text
hsmPartitionName :: Prelude.Text,
    -- | The password required to access the HSM partition.
    CreateHsmConfiguration -> Text
hsmPartitionPassword :: Prelude.Text,
    -- | The HSMs public certificate file. When using Cloud HSM, the file name is
    -- server.pem.
    CreateHsmConfiguration -> Text
hsmServerPublicCertificate :: Prelude.Text
  }
  deriving (CreateHsmConfiguration -> CreateHsmConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateHsmConfiguration -> CreateHsmConfiguration -> Bool
$c/= :: CreateHsmConfiguration -> CreateHsmConfiguration -> Bool
== :: CreateHsmConfiguration -> CreateHsmConfiguration -> Bool
$c== :: CreateHsmConfiguration -> CreateHsmConfiguration -> Bool
Prelude.Eq, ReadPrec [CreateHsmConfiguration]
ReadPrec CreateHsmConfiguration
Int -> ReadS CreateHsmConfiguration
ReadS [CreateHsmConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateHsmConfiguration]
$creadListPrec :: ReadPrec [CreateHsmConfiguration]
readPrec :: ReadPrec CreateHsmConfiguration
$creadPrec :: ReadPrec CreateHsmConfiguration
readList :: ReadS [CreateHsmConfiguration]
$creadList :: ReadS [CreateHsmConfiguration]
readsPrec :: Int -> ReadS CreateHsmConfiguration
$creadsPrec :: Int -> ReadS CreateHsmConfiguration
Prelude.Read, Int -> CreateHsmConfiguration -> ShowS
[CreateHsmConfiguration] -> ShowS
CreateHsmConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateHsmConfiguration] -> ShowS
$cshowList :: [CreateHsmConfiguration] -> ShowS
show :: CreateHsmConfiguration -> String
$cshow :: CreateHsmConfiguration -> String
showsPrec :: Int -> CreateHsmConfiguration -> ShowS
$cshowsPrec :: Int -> CreateHsmConfiguration -> ShowS
Prelude.Show, forall x. Rep CreateHsmConfiguration x -> CreateHsmConfiguration
forall x. CreateHsmConfiguration -> Rep CreateHsmConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateHsmConfiguration x -> CreateHsmConfiguration
$cfrom :: forall x. CreateHsmConfiguration -> Rep CreateHsmConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'CreateHsmConfiguration' 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:
--
-- 'tags', 'createHsmConfiguration_tags' - A list of tag instances.
--
-- 'hsmConfigurationIdentifier', 'createHsmConfiguration_hsmConfigurationIdentifier' - The identifier to be assigned to the new Amazon Redshift HSM
-- configuration.
--
-- 'description', 'createHsmConfiguration_description' - A text description of the HSM configuration to be created.
--
-- 'hsmIpAddress', 'createHsmConfiguration_hsmIpAddress' - The IP address that the Amazon Redshift cluster must use to access the
-- HSM.
--
-- 'hsmPartitionName', 'createHsmConfiguration_hsmPartitionName' - The name of the partition in the HSM where the Amazon Redshift clusters
-- will store their database encryption keys.
--
-- 'hsmPartitionPassword', 'createHsmConfiguration_hsmPartitionPassword' - The password required to access the HSM partition.
--
-- 'hsmServerPublicCertificate', 'createHsmConfiguration_hsmServerPublicCertificate' - The HSMs public certificate file. When using Cloud HSM, the file name is
-- server.pem.
newCreateHsmConfiguration ::
  -- | 'hsmConfigurationIdentifier'
  Prelude.Text ->
  -- | 'description'
  Prelude.Text ->
  -- | 'hsmIpAddress'
  Prelude.Text ->
  -- | 'hsmPartitionName'
  Prelude.Text ->
  -- | 'hsmPartitionPassword'
  Prelude.Text ->
  -- | 'hsmServerPublicCertificate'
  Prelude.Text ->
  CreateHsmConfiguration
newCreateHsmConfiguration :: Text
-> Text -> Text -> Text -> Text -> Text -> CreateHsmConfiguration
newCreateHsmConfiguration
  Text
pHsmConfigurationIdentifier_
  Text
pDescription_
  Text
pHsmIpAddress_
  Text
pHsmPartitionName_
  Text
pHsmPartitionPassword_
  Text
pHsmServerPublicCertificate_ =
    CreateHsmConfiguration'
      { $sel:tags:CreateHsmConfiguration' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:hsmConfigurationIdentifier:CreateHsmConfiguration' :: Text
hsmConfigurationIdentifier =
          Text
pHsmConfigurationIdentifier_,
        $sel:description:CreateHsmConfiguration' :: Text
description = Text
pDescription_,
        $sel:hsmIpAddress:CreateHsmConfiguration' :: Text
hsmIpAddress = Text
pHsmIpAddress_,
        $sel:hsmPartitionName:CreateHsmConfiguration' :: Text
hsmPartitionName = Text
pHsmPartitionName_,
        $sel:hsmPartitionPassword:CreateHsmConfiguration' :: Text
hsmPartitionPassword = Text
pHsmPartitionPassword_,
        $sel:hsmServerPublicCertificate:CreateHsmConfiguration' :: Text
hsmServerPublicCertificate =
          Text
pHsmServerPublicCertificate_
      }

-- | A list of tag instances.
createHsmConfiguration_tags :: Lens.Lens' CreateHsmConfiguration (Prelude.Maybe [Tag])
createHsmConfiguration_tags :: Lens' CreateHsmConfiguration (Maybe [Tag])
createHsmConfiguration_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHsmConfiguration' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateHsmConfiguration' :: CreateHsmConfiguration -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateHsmConfiguration
s@CreateHsmConfiguration' {} Maybe [Tag]
a -> CreateHsmConfiguration
s {$sel:tags:CreateHsmConfiguration' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateHsmConfiguration) 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 identifier to be assigned to the new Amazon Redshift HSM
-- configuration.
createHsmConfiguration_hsmConfigurationIdentifier :: Lens.Lens' CreateHsmConfiguration Prelude.Text
createHsmConfiguration_hsmConfigurationIdentifier :: Lens' CreateHsmConfiguration Text
createHsmConfiguration_hsmConfigurationIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHsmConfiguration' {Text
hsmConfigurationIdentifier :: Text
$sel:hsmConfigurationIdentifier:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
hsmConfigurationIdentifier} -> Text
hsmConfigurationIdentifier) (\s :: CreateHsmConfiguration
s@CreateHsmConfiguration' {} Text
a -> CreateHsmConfiguration
s {$sel:hsmConfigurationIdentifier:CreateHsmConfiguration' :: Text
hsmConfigurationIdentifier = Text
a} :: CreateHsmConfiguration)

-- | A text description of the HSM configuration to be created.
createHsmConfiguration_description :: Lens.Lens' CreateHsmConfiguration Prelude.Text
createHsmConfiguration_description :: Lens' CreateHsmConfiguration Text
createHsmConfiguration_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHsmConfiguration' {Text
description :: Text
$sel:description:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
description} -> Text
description) (\s :: CreateHsmConfiguration
s@CreateHsmConfiguration' {} Text
a -> CreateHsmConfiguration
s {$sel:description:CreateHsmConfiguration' :: Text
description = Text
a} :: CreateHsmConfiguration)

-- | The IP address that the Amazon Redshift cluster must use to access the
-- HSM.
createHsmConfiguration_hsmIpAddress :: Lens.Lens' CreateHsmConfiguration Prelude.Text
createHsmConfiguration_hsmIpAddress :: Lens' CreateHsmConfiguration Text
createHsmConfiguration_hsmIpAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHsmConfiguration' {Text
hsmIpAddress :: Text
$sel:hsmIpAddress:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
hsmIpAddress} -> Text
hsmIpAddress) (\s :: CreateHsmConfiguration
s@CreateHsmConfiguration' {} Text
a -> CreateHsmConfiguration
s {$sel:hsmIpAddress:CreateHsmConfiguration' :: Text
hsmIpAddress = Text
a} :: CreateHsmConfiguration)

-- | The name of the partition in the HSM where the Amazon Redshift clusters
-- will store their database encryption keys.
createHsmConfiguration_hsmPartitionName :: Lens.Lens' CreateHsmConfiguration Prelude.Text
createHsmConfiguration_hsmPartitionName :: Lens' CreateHsmConfiguration Text
createHsmConfiguration_hsmPartitionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHsmConfiguration' {Text
hsmPartitionName :: Text
$sel:hsmPartitionName:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
hsmPartitionName} -> Text
hsmPartitionName) (\s :: CreateHsmConfiguration
s@CreateHsmConfiguration' {} Text
a -> CreateHsmConfiguration
s {$sel:hsmPartitionName:CreateHsmConfiguration' :: Text
hsmPartitionName = Text
a} :: CreateHsmConfiguration)

-- | The password required to access the HSM partition.
createHsmConfiguration_hsmPartitionPassword :: Lens.Lens' CreateHsmConfiguration Prelude.Text
createHsmConfiguration_hsmPartitionPassword :: Lens' CreateHsmConfiguration Text
createHsmConfiguration_hsmPartitionPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHsmConfiguration' {Text
hsmPartitionPassword :: Text
$sel:hsmPartitionPassword:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
hsmPartitionPassword} -> Text
hsmPartitionPassword) (\s :: CreateHsmConfiguration
s@CreateHsmConfiguration' {} Text
a -> CreateHsmConfiguration
s {$sel:hsmPartitionPassword:CreateHsmConfiguration' :: Text
hsmPartitionPassword = Text
a} :: CreateHsmConfiguration)

-- | The HSMs public certificate file. When using Cloud HSM, the file name is
-- server.pem.
createHsmConfiguration_hsmServerPublicCertificate :: Lens.Lens' CreateHsmConfiguration Prelude.Text
createHsmConfiguration_hsmServerPublicCertificate :: Lens' CreateHsmConfiguration Text
createHsmConfiguration_hsmServerPublicCertificate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHsmConfiguration' {Text
hsmServerPublicCertificate :: Text
$sel:hsmServerPublicCertificate:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
hsmServerPublicCertificate} -> Text
hsmServerPublicCertificate) (\s :: CreateHsmConfiguration
s@CreateHsmConfiguration' {} Text
a -> CreateHsmConfiguration
s {$sel:hsmServerPublicCertificate:CreateHsmConfiguration' :: Text
hsmServerPublicCertificate = Text
a} :: CreateHsmConfiguration)

instance Core.AWSRequest CreateHsmConfiguration where
  type
    AWSResponse CreateHsmConfiguration =
      CreateHsmConfigurationResponse
  request :: (Service -> Service)
-> CreateHsmConfiguration -> Request CreateHsmConfiguration
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 CreateHsmConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateHsmConfiguration)))
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
"CreateHsmConfigurationResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe HsmConfiguration -> Int -> CreateHsmConfigurationResponse
CreateHsmConfigurationResponse'
            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
"HsmConfiguration")
            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 CreateHsmConfiguration where
  hashWithSalt :: Int -> CreateHsmConfiguration -> Int
hashWithSalt Int
_salt CreateHsmConfiguration' {Maybe [Tag]
Text
hsmServerPublicCertificate :: Text
hsmPartitionPassword :: Text
hsmPartitionName :: Text
hsmIpAddress :: Text
description :: Text
hsmConfigurationIdentifier :: Text
tags :: Maybe [Tag]
$sel:hsmServerPublicCertificate:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:hsmPartitionPassword:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:hsmPartitionName:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:hsmIpAddress:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:description:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:hsmConfigurationIdentifier:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:tags:CreateHsmConfiguration' :: CreateHsmConfiguration -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hsmConfigurationIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hsmIpAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hsmPartitionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hsmPartitionPassword
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hsmServerPublicCertificate

instance Prelude.NFData CreateHsmConfiguration where
  rnf :: CreateHsmConfiguration -> ()
rnf CreateHsmConfiguration' {Maybe [Tag]
Text
hsmServerPublicCertificate :: Text
hsmPartitionPassword :: Text
hsmPartitionName :: Text
hsmIpAddress :: Text
description :: Text
hsmConfigurationIdentifier :: Text
tags :: Maybe [Tag]
$sel:hsmServerPublicCertificate:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:hsmPartitionPassword:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:hsmPartitionName:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:hsmIpAddress:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:description:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:hsmConfigurationIdentifier:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:tags:CreateHsmConfiguration' :: CreateHsmConfiguration -> Maybe [Tag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
hsmConfigurationIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
hsmIpAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
hsmPartitionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
hsmPartitionPassword
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
hsmServerPublicCertificate

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

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

instance Data.ToQuery CreateHsmConfiguration where
  toQuery :: CreateHsmConfiguration -> QueryString
toQuery CreateHsmConfiguration' {Maybe [Tag]
Text
hsmServerPublicCertificate :: Text
hsmPartitionPassword :: Text
hsmPartitionName :: Text
hsmIpAddress :: Text
description :: Text
hsmConfigurationIdentifier :: Text
tags :: Maybe [Tag]
$sel:hsmServerPublicCertificate:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:hsmPartitionPassword:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:hsmPartitionName:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:hsmIpAddress:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:description:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:hsmConfigurationIdentifier:CreateHsmConfiguration' :: CreateHsmConfiguration -> Text
$sel:tags:CreateHsmConfiguration' :: CreateHsmConfiguration -> Maybe [Tag]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateHsmConfiguration" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"Tags"
          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
"Tag" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags),
        ByteString
"HsmConfigurationIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
hsmConfigurationIdentifier,
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
description,
        ByteString
"HsmIpAddress" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
hsmIpAddress,
        ByteString
"HsmPartitionName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
hsmPartitionName,
        ByteString
"HsmPartitionPassword" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
hsmPartitionPassword,
        ByteString
"HsmServerPublicCertificate"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
hsmServerPublicCertificate
      ]

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

-- |
-- Create a value of 'CreateHsmConfigurationResponse' 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:
--
-- 'hsmConfiguration', 'createHsmConfigurationResponse_hsmConfiguration' - Undocumented member.
--
-- 'httpStatus', 'createHsmConfigurationResponse_httpStatus' - The response's http status code.
newCreateHsmConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateHsmConfigurationResponse
newCreateHsmConfigurationResponse :: Int -> CreateHsmConfigurationResponse
newCreateHsmConfigurationResponse Int
pHttpStatus_ =
  CreateHsmConfigurationResponse'
    { $sel:hsmConfiguration:CreateHsmConfigurationResponse' :: Maybe HsmConfiguration
hsmConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateHsmConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
createHsmConfigurationResponse_hsmConfiguration :: Lens.Lens' CreateHsmConfigurationResponse (Prelude.Maybe HsmConfiguration)
createHsmConfigurationResponse_hsmConfiguration :: Lens' CreateHsmConfigurationResponse (Maybe HsmConfiguration)
createHsmConfigurationResponse_hsmConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHsmConfigurationResponse' {Maybe HsmConfiguration
hsmConfiguration :: Maybe HsmConfiguration
$sel:hsmConfiguration:CreateHsmConfigurationResponse' :: CreateHsmConfigurationResponse -> Maybe HsmConfiguration
hsmConfiguration} -> Maybe HsmConfiguration
hsmConfiguration) (\s :: CreateHsmConfigurationResponse
s@CreateHsmConfigurationResponse' {} Maybe HsmConfiguration
a -> CreateHsmConfigurationResponse
s {$sel:hsmConfiguration:CreateHsmConfigurationResponse' :: Maybe HsmConfiguration
hsmConfiguration = Maybe HsmConfiguration
a} :: CreateHsmConfigurationResponse)

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

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