{-# 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.CreateHsmClientCertificate
-- 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 client certificate that an Amazon Redshift cluster will
-- use to connect to the client\'s HSM in order to store and retrieve the
-- keys used to encrypt the cluster databases.
--
-- The command returns a public key, which you must store in the HSM. In
-- addition to creating the HSM certificate, you must create an Amazon
-- Redshift HSM configuration that provides a cluster the information
-- needed to store and use encryption keys in the HSM. For more
-- information, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-db-encryption.html#working-with-HSM Hardware Security Modules>
-- in the /Amazon Redshift Cluster Management Guide/.
module Amazonka.Redshift.CreateHsmClientCertificate
  ( -- * Creating a Request
    CreateHsmClientCertificate (..),
    newCreateHsmClientCertificate,

    -- * Request Lenses
    createHsmClientCertificate_tags,
    createHsmClientCertificate_hsmClientCertificateIdentifier,

    -- * Destructuring the Response
    CreateHsmClientCertificateResponse (..),
    newCreateHsmClientCertificateResponse,

    -- * Response Lenses
    createHsmClientCertificateResponse_hsmClientCertificate,
    createHsmClientCertificateResponse_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:/ 'newCreateHsmClientCertificate' smart constructor.
data CreateHsmClientCertificate = CreateHsmClientCertificate'
  { -- | A list of tag instances.
    CreateHsmClientCertificate -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The identifier to be assigned to the new HSM client certificate that the
    -- cluster will use to connect to the HSM to use the database encryption
    -- keys.
    CreateHsmClientCertificate -> Text
hsmClientCertificateIdentifier :: Prelude.Text
  }
  deriving (CreateHsmClientCertificate -> CreateHsmClientCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateHsmClientCertificate -> CreateHsmClientCertificate -> Bool
$c/= :: CreateHsmClientCertificate -> CreateHsmClientCertificate -> Bool
== :: CreateHsmClientCertificate -> CreateHsmClientCertificate -> Bool
$c== :: CreateHsmClientCertificate -> CreateHsmClientCertificate -> Bool
Prelude.Eq, ReadPrec [CreateHsmClientCertificate]
ReadPrec CreateHsmClientCertificate
Int -> ReadS CreateHsmClientCertificate
ReadS [CreateHsmClientCertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateHsmClientCertificate]
$creadListPrec :: ReadPrec [CreateHsmClientCertificate]
readPrec :: ReadPrec CreateHsmClientCertificate
$creadPrec :: ReadPrec CreateHsmClientCertificate
readList :: ReadS [CreateHsmClientCertificate]
$creadList :: ReadS [CreateHsmClientCertificate]
readsPrec :: Int -> ReadS CreateHsmClientCertificate
$creadsPrec :: Int -> ReadS CreateHsmClientCertificate
Prelude.Read, Int -> CreateHsmClientCertificate -> ShowS
[CreateHsmClientCertificate] -> ShowS
CreateHsmClientCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateHsmClientCertificate] -> ShowS
$cshowList :: [CreateHsmClientCertificate] -> ShowS
show :: CreateHsmClientCertificate -> String
$cshow :: CreateHsmClientCertificate -> String
showsPrec :: Int -> CreateHsmClientCertificate -> ShowS
$cshowsPrec :: Int -> CreateHsmClientCertificate -> ShowS
Prelude.Show, forall x.
Rep CreateHsmClientCertificate x -> CreateHsmClientCertificate
forall x.
CreateHsmClientCertificate -> Rep CreateHsmClientCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateHsmClientCertificate x -> CreateHsmClientCertificate
$cfrom :: forall x.
CreateHsmClientCertificate -> Rep CreateHsmClientCertificate x
Prelude.Generic)

-- |
-- Create a value of 'CreateHsmClientCertificate' 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', 'createHsmClientCertificate_tags' - A list of tag instances.
--
-- 'hsmClientCertificateIdentifier', 'createHsmClientCertificate_hsmClientCertificateIdentifier' - The identifier to be assigned to the new HSM client certificate that the
-- cluster will use to connect to the HSM to use the database encryption
-- keys.
newCreateHsmClientCertificate ::
  -- | 'hsmClientCertificateIdentifier'
  Prelude.Text ->
  CreateHsmClientCertificate
newCreateHsmClientCertificate :: Text -> CreateHsmClientCertificate
newCreateHsmClientCertificate
  Text
pHsmClientCertificateIdentifier_ =
    CreateHsmClientCertificate'
      { $sel:tags:CreateHsmClientCertificate' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:hsmClientCertificateIdentifier:CreateHsmClientCertificate' :: Text
hsmClientCertificateIdentifier =
          Text
pHsmClientCertificateIdentifier_
      }

-- | A list of tag instances.
createHsmClientCertificate_tags :: Lens.Lens' CreateHsmClientCertificate (Prelude.Maybe [Tag])
createHsmClientCertificate_tags :: Lens' CreateHsmClientCertificate (Maybe [Tag])
createHsmClientCertificate_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHsmClientCertificate' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateHsmClientCertificate' :: CreateHsmClientCertificate -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateHsmClientCertificate
s@CreateHsmClientCertificate' {} Maybe [Tag]
a -> CreateHsmClientCertificate
s {$sel:tags:CreateHsmClientCertificate' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateHsmClientCertificate) 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 HSM client certificate that the
-- cluster will use to connect to the HSM to use the database encryption
-- keys.
createHsmClientCertificate_hsmClientCertificateIdentifier :: Lens.Lens' CreateHsmClientCertificate Prelude.Text
createHsmClientCertificate_hsmClientCertificateIdentifier :: Lens' CreateHsmClientCertificate Text
createHsmClientCertificate_hsmClientCertificateIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHsmClientCertificate' {Text
hsmClientCertificateIdentifier :: Text
$sel:hsmClientCertificateIdentifier:CreateHsmClientCertificate' :: CreateHsmClientCertificate -> Text
hsmClientCertificateIdentifier} -> Text
hsmClientCertificateIdentifier) (\s :: CreateHsmClientCertificate
s@CreateHsmClientCertificate' {} Text
a -> CreateHsmClientCertificate
s {$sel:hsmClientCertificateIdentifier:CreateHsmClientCertificate' :: Text
hsmClientCertificateIdentifier = Text
a} :: CreateHsmClientCertificate)

instance Core.AWSRequest CreateHsmClientCertificate where
  type
    AWSResponse CreateHsmClientCertificate =
      CreateHsmClientCertificateResponse
  request :: (Service -> Service)
-> CreateHsmClientCertificate -> Request CreateHsmClientCertificate
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 CreateHsmClientCertificate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateHsmClientCertificate)))
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
"CreateHsmClientCertificateResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe HsmClientCertificate
-> Int -> CreateHsmClientCertificateResponse
CreateHsmClientCertificateResponse'
            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
"HsmClientCertificate")
            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 CreateHsmClientCertificate where
  hashWithSalt :: Int -> CreateHsmClientCertificate -> Int
hashWithSalt Int
_salt CreateHsmClientCertificate' {Maybe [Tag]
Text
hsmClientCertificateIdentifier :: Text
tags :: Maybe [Tag]
$sel:hsmClientCertificateIdentifier:CreateHsmClientCertificate' :: CreateHsmClientCertificate -> Text
$sel:tags:CreateHsmClientCertificate' :: CreateHsmClientCertificate -> 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
hsmClientCertificateIdentifier

instance Prelude.NFData CreateHsmClientCertificate where
  rnf :: CreateHsmClientCertificate -> ()
rnf CreateHsmClientCertificate' {Maybe [Tag]
Text
hsmClientCertificateIdentifier :: Text
tags :: Maybe [Tag]
$sel:hsmClientCertificateIdentifier:CreateHsmClientCertificate' :: CreateHsmClientCertificate -> Text
$sel:tags:CreateHsmClientCertificate' :: CreateHsmClientCertificate -> 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
hsmClientCertificateIdentifier

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

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

instance Data.ToQuery CreateHsmClientCertificate where
  toQuery :: CreateHsmClientCertificate -> QueryString
toQuery CreateHsmClientCertificate' {Maybe [Tag]
Text
hsmClientCertificateIdentifier :: Text
tags :: Maybe [Tag]
$sel:hsmClientCertificateIdentifier:CreateHsmClientCertificate' :: CreateHsmClientCertificate -> Text
$sel:tags:CreateHsmClientCertificate' :: CreateHsmClientCertificate -> Maybe [Tag]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateHsmClientCertificate" :: 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
"HsmClientCertificateIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
hsmClientCertificateIdentifier
      ]

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

-- |
-- Create a value of 'CreateHsmClientCertificateResponse' 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:
--
-- 'hsmClientCertificate', 'createHsmClientCertificateResponse_hsmClientCertificate' - Undocumented member.
--
-- 'httpStatus', 'createHsmClientCertificateResponse_httpStatus' - The response's http status code.
newCreateHsmClientCertificateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateHsmClientCertificateResponse
newCreateHsmClientCertificateResponse :: Int -> CreateHsmClientCertificateResponse
newCreateHsmClientCertificateResponse Int
pHttpStatus_ =
  CreateHsmClientCertificateResponse'
    { $sel:hsmClientCertificate:CreateHsmClientCertificateResponse' :: Maybe HsmClientCertificate
hsmClientCertificate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateHsmClientCertificateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
createHsmClientCertificateResponse_hsmClientCertificate :: Lens.Lens' CreateHsmClientCertificateResponse (Prelude.Maybe HsmClientCertificate)
createHsmClientCertificateResponse_hsmClientCertificate :: Lens'
  CreateHsmClientCertificateResponse (Maybe HsmClientCertificate)
createHsmClientCertificateResponse_hsmClientCertificate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHsmClientCertificateResponse' {Maybe HsmClientCertificate
hsmClientCertificate :: Maybe HsmClientCertificate
$sel:hsmClientCertificate:CreateHsmClientCertificateResponse' :: CreateHsmClientCertificateResponse -> Maybe HsmClientCertificate
hsmClientCertificate} -> Maybe HsmClientCertificate
hsmClientCertificate) (\s :: CreateHsmClientCertificateResponse
s@CreateHsmClientCertificateResponse' {} Maybe HsmClientCertificate
a -> CreateHsmClientCertificateResponse
s {$sel:hsmClientCertificate:CreateHsmClientCertificateResponse' :: Maybe HsmClientCertificate
hsmClientCertificate = Maybe HsmClientCertificate
a} :: CreateHsmClientCertificateResponse)

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

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