{-# 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.Route53.CreateKeySigningKey
-- 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 a new key-signing key (KSK) associated with a hosted zone. You
-- can only have two KSKs per hosted zone.
module Amazonka.Route53.CreateKeySigningKey
  ( -- * Creating a Request
    CreateKeySigningKey (..),
    newCreateKeySigningKey,

    -- * Request Lenses
    createKeySigningKey_callerReference,
    createKeySigningKey_hostedZoneId,
    createKeySigningKey_keyManagementServiceArn,
    createKeySigningKey_name,
    createKeySigningKey_status,

    -- * Destructuring the Response
    CreateKeySigningKeyResponse (..),
    newCreateKeySigningKeyResponse,

    -- * Response Lenses
    createKeySigningKeyResponse_httpStatus,
    createKeySigningKeyResponse_changeInfo,
    createKeySigningKeyResponse_keySigningKey,
    createKeySigningKeyResponse_location,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Route53.Types

-- | /See:/ 'newCreateKeySigningKey' smart constructor.
data CreateKeySigningKey = CreateKeySigningKey'
  { -- | A unique string that identifies the request.
    CreateKeySigningKey -> Text
callerReference :: Prelude.Text,
    -- | The unique string (ID) used to identify a hosted zone.
    CreateKeySigningKey -> ResourceId
hostedZoneId :: ResourceId,
    -- | The Amazon resource name (ARN) for a customer managed key in Key
    -- Management Service (KMS). The @KeyManagementServiceArn@ must be unique
    -- for each key-signing key (KSK) in a single hosted zone. To see an
    -- example of @KeyManagementServiceArn@ that grants the correct permissions
    -- for DNSSEC, scroll down to __Example__.
    --
    -- You must configure the customer managed customer managed key as follows:
    --
    -- [Status]
    --     Enabled
    --
    -- [Key spec]
    --     ECC_NIST_P256
    --
    -- [Key usage]
    --     Sign and verify
    --
    -- [Key policy]
    --     The key policy must give permission for the following actions:
    --
    --     -   DescribeKey
    --
    --     -   GetPublicKey
    --
    --     -   Sign
    --
    --     The key policy must also include the Amazon Route 53 service in the
    --     principal for your account. Specify the following:
    --
    --     -   @\"Service\": \"dnssec-route53.amazonaws.com\"@
    --
    -- For more information about working with a customer managed key in KMS,
    -- see
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html Key Management Service concepts>.
    CreateKeySigningKey -> Text
keyManagementServiceArn :: Prelude.Text,
    -- | A string used to identify a key-signing key (KSK). @Name@ can include
    -- numbers, letters, and underscores (_). @Name@ must be unique for each
    -- key-signing key in the same hosted zone.
    CreateKeySigningKey -> Text
name :: Prelude.Text,
    -- | A string specifying the initial status of the key-signing key (KSK). You
    -- can set the value to @ACTIVE@ or @INACTIVE@.
    CreateKeySigningKey -> Text
status :: Prelude.Text
  }
  deriving (CreateKeySigningKey -> CreateKeySigningKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateKeySigningKey -> CreateKeySigningKey -> Bool
$c/= :: CreateKeySigningKey -> CreateKeySigningKey -> Bool
== :: CreateKeySigningKey -> CreateKeySigningKey -> Bool
$c== :: CreateKeySigningKey -> CreateKeySigningKey -> Bool
Prelude.Eq, ReadPrec [CreateKeySigningKey]
ReadPrec CreateKeySigningKey
Int -> ReadS CreateKeySigningKey
ReadS [CreateKeySigningKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateKeySigningKey]
$creadListPrec :: ReadPrec [CreateKeySigningKey]
readPrec :: ReadPrec CreateKeySigningKey
$creadPrec :: ReadPrec CreateKeySigningKey
readList :: ReadS [CreateKeySigningKey]
$creadList :: ReadS [CreateKeySigningKey]
readsPrec :: Int -> ReadS CreateKeySigningKey
$creadsPrec :: Int -> ReadS CreateKeySigningKey
Prelude.Read, Int -> CreateKeySigningKey -> ShowS
[CreateKeySigningKey] -> ShowS
CreateKeySigningKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateKeySigningKey] -> ShowS
$cshowList :: [CreateKeySigningKey] -> ShowS
show :: CreateKeySigningKey -> String
$cshow :: CreateKeySigningKey -> String
showsPrec :: Int -> CreateKeySigningKey -> ShowS
$cshowsPrec :: Int -> CreateKeySigningKey -> ShowS
Prelude.Show, forall x. Rep CreateKeySigningKey x -> CreateKeySigningKey
forall x. CreateKeySigningKey -> Rep CreateKeySigningKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateKeySigningKey x -> CreateKeySigningKey
$cfrom :: forall x. CreateKeySigningKey -> Rep CreateKeySigningKey x
Prelude.Generic)

-- |
-- Create a value of 'CreateKeySigningKey' 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:
--
-- 'callerReference', 'createKeySigningKey_callerReference' - A unique string that identifies the request.
--
-- 'hostedZoneId', 'createKeySigningKey_hostedZoneId' - The unique string (ID) used to identify a hosted zone.
--
-- 'keyManagementServiceArn', 'createKeySigningKey_keyManagementServiceArn' - The Amazon resource name (ARN) for a customer managed key in Key
-- Management Service (KMS). The @KeyManagementServiceArn@ must be unique
-- for each key-signing key (KSK) in a single hosted zone. To see an
-- example of @KeyManagementServiceArn@ that grants the correct permissions
-- for DNSSEC, scroll down to __Example__.
--
-- You must configure the customer managed customer managed key as follows:
--
-- [Status]
--     Enabled
--
-- [Key spec]
--     ECC_NIST_P256
--
-- [Key usage]
--     Sign and verify
--
-- [Key policy]
--     The key policy must give permission for the following actions:
--
--     -   DescribeKey
--
--     -   GetPublicKey
--
--     -   Sign
--
--     The key policy must also include the Amazon Route 53 service in the
--     principal for your account. Specify the following:
--
--     -   @\"Service\": \"dnssec-route53.amazonaws.com\"@
--
-- For more information about working with a customer managed key in KMS,
-- see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html Key Management Service concepts>.
--
-- 'name', 'createKeySigningKey_name' - A string used to identify a key-signing key (KSK). @Name@ can include
-- numbers, letters, and underscores (_). @Name@ must be unique for each
-- key-signing key in the same hosted zone.
--
-- 'status', 'createKeySigningKey_status' - A string specifying the initial status of the key-signing key (KSK). You
-- can set the value to @ACTIVE@ or @INACTIVE@.
newCreateKeySigningKey ::
  -- | 'callerReference'
  Prelude.Text ->
  -- | 'hostedZoneId'
  ResourceId ->
  -- | 'keyManagementServiceArn'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'status'
  Prelude.Text ->
  CreateKeySigningKey
newCreateKeySigningKey :: Text -> ResourceId -> Text -> Text -> Text -> CreateKeySigningKey
newCreateKeySigningKey
  Text
pCallerReference_
  ResourceId
pHostedZoneId_
  Text
pKeyManagementServiceArn_
  Text
pName_
  Text
pStatus_ =
    CreateKeySigningKey'
      { $sel:callerReference:CreateKeySigningKey' :: Text
callerReference =
          Text
pCallerReference_,
        $sel:hostedZoneId:CreateKeySigningKey' :: ResourceId
hostedZoneId = ResourceId
pHostedZoneId_,
        $sel:keyManagementServiceArn:CreateKeySigningKey' :: Text
keyManagementServiceArn = Text
pKeyManagementServiceArn_,
        $sel:name:CreateKeySigningKey' :: Text
name = Text
pName_,
        $sel:status:CreateKeySigningKey' :: Text
status = Text
pStatus_
      }

-- | A unique string that identifies the request.
createKeySigningKey_callerReference :: Lens.Lens' CreateKeySigningKey Prelude.Text
createKeySigningKey_callerReference :: Lens' CreateKeySigningKey Text
createKeySigningKey_callerReference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeySigningKey' {Text
callerReference :: Text
$sel:callerReference:CreateKeySigningKey' :: CreateKeySigningKey -> Text
callerReference} -> Text
callerReference) (\s :: CreateKeySigningKey
s@CreateKeySigningKey' {} Text
a -> CreateKeySigningKey
s {$sel:callerReference:CreateKeySigningKey' :: Text
callerReference = Text
a} :: CreateKeySigningKey)

-- | The unique string (ID) used to identify a hosted zone.
createKeySigningKey_hostedZoneId :: Lens.Lens' CreateKeySigningKey ResourceId
createKeySigningKey_hostedZoneId :: Lens' CreateKeySigningKey ResourceId
createKeySigningKey_hostedZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeySigningKey' {ResourceId
hostedZoneId :: ResourceId
$sel:hostedZoneId:CreateKeySigningKey' :: CreateKeySigningKey -> ResourceId
hostedZoneId} -> ResourceId
hostedZoneId) (\s :: CreateKeySigningKey
s@CreateKeySigningKey' {} ResourceId
a -> CreateKeySigningKey
s {$sel:hostedZoneId:CreateKeySigningKey' :: ResourceId
hostedZoneId = ResourceId
a} :: CreateKeySigningKey)

-- | The Amazon resource name (ARN) for a customer managed key in Key
-- Management Service (KMS). The @KeyManagementServiceArn@ must be unique
-- for each key-signing key (KSK) in a single hosted zone. To see an
-- example of @KeyManagementServiceArn@ that grants the correct permissions
-- for DNSSEC, scroll down to __Example__.
--
-- You must configure the customer managed customer managed key as follows:
--
-- [Status]
--     Enabled
--
-- [Key spec]
--     ECC_NIST_P256
--
-- [Key usage]
--     Sign and verify
--
-- [Key policy]
--     The key policy must give permission for the following actions:
--
--     -   DescribeKey
--
--     -   GetPublicKey
--
--     -   Sign
--
--     The key policy must also include the Amazon Route 53 service in the
--     principal for your account. Specify the following:
--
--     -   @\"Service\": \"dnssec-route53.amazonaws.com\"@
--
-- For more information about working with a customer managed key in KMS,
-- see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html Key Management Service concepts>.
createKeySigningKey_keyManagementServiceArn :: Lens.Lens' CreateKeySigningKey Prelude.Text
createKeySigningKey_keyManagementServiceArn :: Lens' CreateKeySigningKey Text
createKeySigningKey_keyManagementServiceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeySigningKey' {Text
keyManagementServiceArn :: Text
$sel:keyManagementServiceArn:CreateKeySigningKey' :: CreateKeySigningKey -> Text
keyManagementServiceArn} -> Text
keyManagementServiceArn) (\s :: CreateKeySigningKey
s@CreateKeySigningKey' {} Text
a -> CreateKeySigningKey
s {$sel:keyManagementServiceArn:CreateKeySigningKey' :: Text
keyManagementServiceArn = Text
a} :: CreateKeySigningKey)

-- | A string used to identify a key-signing key (KSK). @Name@ can include
-- numbers, letters, and underscores (_). @Name@ must be unique for each
-- key-signing key in the same hosted zone.
createKeySigningKey_name :: Lens.Lens' CreateKeySigningKey Prelude.Text
createKeySigningKey_name :: Lens' CreateKeySigningKey Text
createKeySigningKey_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeySigningKey' {Text
name :: Text
$sel:name:CreateKeySigningKey' :: CreateKeySigningKey -> Text
name} -> Text
name) (\s :: CreateKeySigningKey
s@CreateKeySigningKey' {} Text
a -> CreateKeySigningKey
s {$sel:name:CreateKeySigningKey' :: Text
name = Text
a} :: CreateKeySigningKey)

-- | A string specifying the initial status of the key-signing key (KSK). You
-- can set the value to @ACTIVE@ or @INACTIVE@.
createKeySigningKey_status :: Lens.Lens' CreateKeySigningKey Prelude.Text
createKeySigningKey_status :: Lens' CreateKeySigningKey Text
createKeySigningKey_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeySigningKey' {Text
status :: Text
$sel:status:CreateKeySigningKey' :: CreateKeySigningKey -> Text
status} -> Text
status) (\s :: CreateKeySigningKey
s@CreateKeySigningKey' {} Text
a -> CreateKeySigningKey
s {$sel:status:CreateKeySigningKey' :: Text
status = Text
a} :: CreateKeySigningKey)

instance Core.AWSRequest CreateKeySigningKey where
  type
    AWSResponse CreateKeySigningKey =
      CreateKeySigningKeyResponse
  request :: (Service -> Service)
-> CreateKeySigningKey -> Request CreateKeySigningKey
request Service -> Service
overrides =
    forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
Request.postXML (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateKeySigningKey
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateKeySigningKey)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int
-> ChangeInfo
-> KeySigningKey
-> Text
-> CreateKeySigningKeyResponse
CreateKeySigningKeyResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"ChangeInfo")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"KeySigningKey")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String a
Data..# HeaderName
"Location")
      )

instance Prelude.Hashable CreateKeySigningKey where
  hashWithSalt :: Int -> CreateKeySigningKey -> Int
hashWithSalt Int
_salt CreateKeySigningKey' {Text
ResourceId
status :: Text
name :: Text
keyManagementServiceArn :: Text
hostedZoneId :: ResourceId
callerReference :: Text
$sel:status:CreateKeySigningKey' :: CreateKeySigningKey -> Text
$sel:name:CreateKeySigningKey' :: CreateKeySigningKey -> Text
$sel:keyManagementServiceArn:CreateKeySigningKey' :: CreateKeySigningKey -> Text
$sel:hostedZoneId:CreateKeySigningKey' :: CreateKeySigningKey -> ResourceId
$sel:callerReference:CreateKeySigningKey' :: CreateKeySigningKey -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
callerReference
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceId
hostedZoneId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyManagementServiceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
status

instance Prelude.NFData CreateKeySigningKey where
  rnf :: CreateKeySigningKey -> ()
rnf CreateKeySigningKey' {Text
ResourceId
status :: Text
name :: Text
keyManagementServiceArn :: Text
hostedZoneId :: ResourceId
callerReference :: Text
$sel:status:CreateKeySigningKey' :: CreateKeySigningKey -> Text
$sel:name:CreateKeySigningKey' :: CreateKeySigningKey -> Text
$sel:keyManagementServiceArn:CreateKeySigningKey' :: CreateKeySigningKey -> Text
$sel:hostedZoneId:CreateKeySigningKey' :: CreateKeySigningKey -> ResourceId
$sel:callerReference:CreateKeySigningKey' :: CreateKeySigningKey -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
callerReference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResourceId
hostedZoneId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
keyManagementServiceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
status

instance Data.ToElement CreateKeySigningKey where
  toElement :: CreateKeySigningKey -> Element
toElement =
    forall a. ToXML a => Name -> a -> Element
Data.mkElement
      Name
"{https://route53.amazonaws.com/doc/2013-04-01/}CreateKeySigningKeyRequest"

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

instance Data.ToPath CreateKeySigningKey where
  toPath :: CreateKeySigningKey -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/2013-04-01/keysigningkey"

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

instance Data.ToXML CreateKeySigningKey where
  toXML :: CreateKeySigningKey -> XML
toXML CreateKeySigningKey' {Text
ResourceId
status :: Text
name :: Text
keyManagementServiceArn :: Text
hostedZoneId :: ResourceId
callerReference :: Text
$sel:status:CreateKeySigningKey' :: CreateKeySigningKey -> Text
$sel:name:CreateKeySigningKey' :: CreateKeySigningKey -> Text
$sel:keyManagementServiceArn:CreateKeySigningKey' :: CreateKeySigningKey -> Text
$sel:hostedZoneId:CreateKeySigningKey' :: CreateKeySigningKey -> ResourceId
$sel:callerReference:CreateKeySigningKey' :: CreateKeySigningKey -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"CallerReference" forall a. ToXML a => Name -> a -> XML
Data.@= Text
callerReference,
        Name
"HostedZoneId" forall a. ToXML a => Name -> a -> XML
Data.@= ResourceId
hostedZoneId,
        Name
"KeyManagementServiceArn"
          forall a. ToXML a => Name -> a -> XML
Data.@= Text
keyManagementServiceArn,
        Name
"Name" forall a. ToXML a => Name -> a -> XML
Data.@= Text
name,
        Name
"Status" forall a. ToXML a => Name -> a -> XML
Data.@= Text
status
      ]

-- | /See:/ 'newCreateKeySigningKeyResponse' smart constructor.
data CreateKeySigningKeyResponse = CreateKeySigningKeyResponse'
  { -- | The response's http status code.
    CreateKeySigningKeyResponse -> Int
httpStatus :: Prelude.Int,
    CreateKeySigningKeyResponse -> ChangeInfo
changeInfo :: ChangeInfo,
    -- | The key-signing key (KSK) that the request creates.
    CreateKeySigningKeyResponse -> KeySigningKey
keySigningKey :: KeySigningKey,
    -- | The unique URL representing the new key-signing key (KSK).
    CreateKeySigningKeyResponse -> Text
location :: Prelude.Text
  }
  deriving (CreateKeySigningKeyResponse -> CreateKeySigningKeyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateKeySigningKeyResponse -> CreateKeySigningKeyResponse -> Bool
$c/= :: CreateKeySigningKeyResponse -> CreateKeySigningKeyResponse -> Bool
== :: CreateKeySigningKeyResponse -> CreateKeySigningKeyResponse -> Bool
$c== :: CreateKeySigningKeyResponse -> CreateKeySigningKeyResponse -> Bool
Prelude.Eq, ReadPrec [CreateKeySigningKeyResponse]
ReadPrec CreateKeySigningKeyResponse
Int -> ReadS CreateKeySigningKeyResponse
ReadS [CreateKeySigningKeyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateKeySigningKeyResponse]
$creadListPrec :: ReadPrec [CreateKeySigningKeyResponse]
readPrec :: ReadPrec CreateKeySigningKeyResponse
$creadPrec :: ReadPrec CreateKeySigningKeyResponse
readList :: ReadS [CreateKeySigningKeyResponse]
$creadList :: ReadS [CreateKeySigningKeyResponse]
readsPrec :: Int -> ReadS CreateKeySigningKeyResponse
$creadsPrec :: Int -> ReadS CreateKeySigningKeyResponse
Prelude.Read, Int -> CreateKeySigningKeyResponse -> ShowS
[CreateKeySigningKeyResponse] -> ShowS
CreateKeySigningKeyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateKeySigningKeyResponse] -> ShowS
$cshowList :: [CreateKeySigningKeyResponse] -> ShowS
show :: CreateKeySigningKeyResponse -> String
$cshow :: CreateKeySigningKeyResponse -> String
showsPrec :: Int -> CreateKeySigningKeyResponse -> ShowS
$cshowsPrec :: Int -> CreateKeySigningKeyResponse -> ShowS
Prelude.Show, forall x.
Rep CreateKeySigningKeyResponse x -> CreateKeySigningKeyResponse
forall x.
CreateKeySigningKeyResponse -> Rep CreateKeySigningKeyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateKeySigningKeyResponse x -> CreateKeySigningKeyResponse
$cfrom :: forall x.
CreateKeySigningKeyResponse -> Rep CreateKeySigningKeyResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateKeySigningKeyResponse' 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:
--
-- 'httpStatus', 'createKeySigningKeyResponse_httpStatus' - The response's http status code.
--
-- 'changeInfo', 'createKeySigningKeyResponse_changeInfo' - Undocumented member.
--
-- 'keySigningKey', 'createKeySigningKeyResponse_keySigningKey' - The key-signing key (KSK) that the request creates.
--
-- 'location', 'createKeySigningKeyResponse_location' - The unique URL representing the new key-signing key (KSK).
newCreateKeySigningKeyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'changeInfo'
  ChangeInfo ->
  -- | 'keySigningKey'
  KeySigningKey ->
  -- | 'location'
  Prelude.Text ->
  CreateKeySigningKeyResponse
newCreateKeySigningKeyResponse :: Int
-> ChangeInfo
-> KeySigningKey
-> Text
-> CreateKeySigningKeyResponse
newCreateKeySigningKeyResponse
  Int
pHttpStatus_
  ChangeInfo
pChangeInfo_
  KeySigningKey
pKeySigningKey_
  Text
pLocation_ =
    CreateKeySigningKeyResponse'
      { $sel:httpStatus:CreateKeySigningKeyResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:changeInfo:CreateKeySigningKeyResponse' :: ChangeInfo
changeInfo = ChangeInfo
pChangeInfo_,
        $sel:keySigningKey:CreateKeySigningKeyResponse' :: KeySigningKey
keySigningKey = KeySigningKey
pKeySigningKey_,
        $sel:location:CreateKeySigningKeyResponse' :: Text
location = Text
pLocation_
      }

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

-- | Undocumented member.
createKeySigningKeyResponse_changeInfo :: Lens.Lens' CreateKeySigningKeyResponse ChangeInfo
createKeySigningKeyResponse_changeInfo :: Lens' CreateKeySigningKeyResponse ChangeInfo
createKeySigningKeyResponse_changeInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeySigningKeyResponse' {ChangeInfo
changeInfo :: ChangeInfo
$sel:changeInfo:CreateKeySigningKeyResponse' :: CreateKeySigningKeyResponse -> ChangeInfo
changeInfo} -> ChangeInfo
changeInfo) (\s :: CreateKeySigningKeyResponse
s@CreateKeySigningKeyResponse' {} ChangeInfo
a -> CreateKeySigningKeyResponse
s {$sel:changeInfo:CreateKeySigningKeyResponse' :: ChangeInfo
changeInfo = ChangeInfo
a} :: CreateKeySigningKeyResponse)

-- | The key-signing key (KSK) that the request creates.
createKeySigningKeyResponse_keySigningKey :: Lens.Lens' CreateKeySigningKeyResponse KeySigningKey
createKeySigningKeyResponse_keySigningKey :: Lens' CreateKeySigningKeyResponse KeySigningKey
createKeySigningKeyResponse_keySigningKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeySigningKeyResponse' {KeySigningKey
keySigningKey :: KeySigningKey
$sel:keySigningKey:CreateKeySigningKeyResponse' :: CreateKeySigningKeyResponse -> KeySigningKey
keySigningKey} -> KeySigningKey
keySigningKey) (\s :: CreateKeySigningKeyResponse
s@CreateKeySigningKeyResponse' {} KeySigningKey
a -> CreateKeySigningKeyResponse
s {$sel:keySigningKey:CreateKeySigningKeyResponse' :: KeySigningKey
keySigningKey = KeySigningKey
a} :: CreateKeySigningKeyResponse)

-- | The unique URL representing the new key-signing key (KSK).
createKeySigningKeyResponse_location :: Lens.Lens' CreateKeySigningKeyResponse Prelude.Text
createKeySigningKeyResponse_location :: Lens' CreateKeySigningKeyResponse Text
createKeySigningKeyResponse_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeySigningKeyResponse' {Text
location :: Text
$sel:location:CreateKeySigningKeyResponse' :: CreateKeySigningKeyResponse -> Text
location} -> Text
location) (\s :: CreateKeySigningKeyResponse
s@CreateKeySigningKeyResponse' {} Text
a -> CreateKeySigningKeyResponse
s {$sel:location:CreateKeySigningKeyResponse' :: Text
location = Text
a} :: CreateKeySigningKeyResponse)

instance Prelude.NFData CreateKeySigningKeyResponse where
  rnf :: CreateKeySigningKeyResponse -> ()
rnf CreateKeySigningKeyResponse' {Int
Text
ChangeInfo
KeySigningKey
location :: Text
keySigningKey :: KeySigningKey
changeInfo :: ChangeInfo
httpStatus :: Int
$sel:location:CreateKeySigningKeyResponse' :: CreateKeySigningKeyResponse -> Text
$sel:keySigningKey:CreateKeySigningKeyResponse' :: CreateKeySigningKeyResponse -> KeySigningKey
$sel:changeInfo:CreateKeySigningKeyResponse' :: CreateKeySigningKeyResponse -> ChangeInfo
$sel:httpStatus:CreateKeySigningKeyResponse' :: CreateKeySigningKeyResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ChangeInfo
changeInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf KeySigningKey
keySigningKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
location