{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.KeySigningKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Route53.Types.KeySigningKey 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.Route53.Internal

-- | A key-signing key (KSK) is a complex type that represents a
-- public\/private key pair. The private key is used to generate a digital
-- signature for the zone signing key (ZSK). The public key is stored in
-- the DNS and is used to authenticate the ZSK. A KSK is always associated
-- with a hosted zone; it cannot exist by itself.
--
-- /See:/ 'newKeySigningKey' smart constructor.
data KeySigningKey = KeySigningKey'
  { -- | The date when the key-signing key (KSK) was created.
    KeySigningKey -> Maybe ISO8601
createdDate :: Prelude.Maybe Data.ISO8601,
    -- | A string that represents a DNSKEY record.
    KeySigningKey -> Maybe Text
dNSKEYRecord :: Prelude.Maybe Prelude.Text,
    -- | A string that represents a delegation signer (DS) record.
    KeySigningKey -> Maybe Text
dSRecord :: Prelude.Maybe Prelude.Text,
    -- | A string used to represent the delegation signer digest algorithm. This
    -- value must follow the guidelines provided by
    -- <https://tools.ietf.org/html/rfc8624#section-3.3 RFC-8624 Section 3.3>.
    KeySigningKey -> Maybe Text
digestAlgorithmMnemonic :: Prelude.Maybe Prelude.Text,
    -- | An integer used to represent the delegation signer digest algorithm.
    -- This value must follow the guidelines provided by
    -- <https://tools.ietf.org/html/rfc8624#section-3.3 RFC-8624 Section 3.3>.
    KeySigningKey -> Maybe Int
digestAlgorithmType :: Prelude.Maybe Prelude.Int,
    -- | A cryptographic digest of a DNSKEY resource record (RR). DNSKEY records
    -- are used to publish the public key that resolvers can use to verify
    -- DNSSEC signatures that are used to secure certain kinds of information
    -- provided by the DNS system.
    KeySigningKey -> Maybe Text
digestValue :: Prelude.Maybe Prelude.Text,
    -- | An integer that specifies how the key is used. For key-signing key
    -- (KSK), this value is always 257.
    KeySigningKey -> Maybe Int
flag :: Prelude.Maybe Prelude.Int,
    -- | An integer used to identify the DNSSEC record for the domain name. The
    -- process used to calculate the value is described in
    -- <https://tools.ietf.org/rfc/rfc4034.txt RFC-4034 Appendix B>.
    KeySigningKey -> Maybe Natural
keyTag :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon resource name (ARN) used to identify the customer managed key
    -- in Key Management Service (KMS). The @KmsArn@ must be unique for each
    -- key-signing key (KSK) in a single hosted zone.
    --
    -- You must configure the 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 the customer managed key in KMS,
    -- see
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html Key Management Service concepts>.
    KeySigningKey -> Maybe Text
kmsArn :: Prelude.Maybe Prelude.Text,
    -- | The last time that the key-signing key (KSK) was changed.
    KeySigningKey -> Maybe ISO8601
lastModifiedDate :: Prelude.Maybe Data.ISO8601,
    -- | 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.
    KeySigningKey -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The public key, represented as a Base64 encoding, as required by
    -- <https://tools.ietf.org/rfc/rfc4034.txt RFC-4034 Page 5>.
    KeySigningKey -> Maybe Text
publicKey :: Prelude.Maybe Prelude.Text,
    -- | A string used to represent the signing algorithm. This value must follow
    -- the guidelines provided by
    -- <https://tools.ietf.org/html/rfc8624#section-3.1 RFC-8624 Section 3.1>.
    KeySigningKey -> Maybe Text
signingAlgorithmMnemonic :: Prelude.Maybe Prelude.Text,
    -- | An integer used to represent the signing algorithm. This value must
    -- follow the guidelines provided by
    -- <https://tools.ietf.org/html/rfc8624#section-3.1 RFC-8624 Section 3.1>.
    KeySigningKey -> Maybe Int
signingAlgorithmType :: Prelude.Maybe Prelude.Int,
    -- | A string that represents the current key-signing key (KSK) status.
    --
    -- Status can have one of the following values:
    --
    -- [ACTIVE]
    --     The KSK is being used for signing.
    --
    -- [INACTIVE]
    --     The KSK is not being used for signing.
    --
    -- [DELETING]
    --     The KSK is in the process of being deleted.
    --
    -- [ACTION_NEEDED]
    --     There is a problem with the KSK that requires you to take action to
    --     resolve. For example, the customer managed key might have been
    --     deleted, or the permissions for the customer managed key might have
    --     been changed.
    --
    -- [INTERNAL_FAILURE]
    --     There was an error during a request. Before you can continue to work
    --     with DNSSEC signing, including actions that involve this KSK, you
    --     must correct the problem. For example, you may need to activate or
    --     deactivate the KSK.
    KeySigningKey -> Maybe Text
status :: Prelude.Maybe Prelude.Text,
    -- | The status message provided for the following key-signing key (KSK)
    -- statuses: @ACTION_NEEDED@ or @INTERNAL_FAILURE@. The status message
    -- includes information about what the problem might be and steps that you
    -- can take to correct the issue.
    KeySigningKey -> Maybe Text
statusMessage :: Prelude.Maybe Prelude.Text
  }
  deriving (KeySigningKey -> KeySigningKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeySigningKey -> KeySigningKey -> Bool
$c/= :: KeySigningKey -> KeySigningKey -> Bool
== :: KeySigningKey -> KeySigningKey -> Bool
$c== :: KeySigningKey -> KeySigningKey -> Bool
Prelude.Eq, ReadPrec [KeySigningKey]
ReadPrec KeySigningKey
Int -> ReadS KeySigningKey
ReadS [KeySigningKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [KeySigningKey]
$creadListPrec :: ReadPrec [KeySigningKey]
readPrec :: ReadPrec KeySigningKey
$creadPrec :: ReadPrec KeySigningKey
readList :: ReadS [KeySigningKey]
$creadList :: ReadS [KeySigningKey]
readsPrec :: Int -> ReadS KeySigningKey
$creadsPrec :: Int -> ReadS KeySigningKey
Prelude.Read, Int -> KeySigningKey -> ShowS
[KeySigningKey] -> ShowS
KeySigningKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeySigningKey] -> ShowS
$cshowList :: [KeySigningKey] -> ShowS
show :: KeySigningKey -> String
$cshow :: KeySigningKey -> String
showsPrec :: Int -> KeySigningKey -> ShowS
$cshowsPrec :: Int -> KeySigningKey -> ShowS
Prelude.Show, forall x. Rep KeySigningKey x -> KeySigningKey
forall x. KeySigningKey -> Rep KeySigningKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeySigningKey x -> KeySigningKey
$cfrom :: forall x. KeySigningKey -> Rep KeySigningKey x
Prelude.Generic)

-- |
-- Create a value of 'KeySigningKey' 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:
--
-- 'createdDate', 'keySigningKey_createdDate' - The date when the key-signing key (KSK) was created.
--
-- 'dNSKEYRecord', 'keySigningKey_dNSKEYRecord' - A string that represents a DNSKEY record.
--
-- 'dSRecord', 'keySigningKey_dSRecord' - A string that represents a delegation signer (DS) record.
--
-- 'digestAlgorithmMnemonic', 'keySigningKey_digestAlgorithmMnemonic' - A string used to represent the delegation signer digest algorithm. This
-- value must follow the guidelines provided by
-- <https://tools.ietf.org/html/rfc8624#section-3.3 RFC-8624 Section 3.3>.
--
-- 'digestAlgorithmType', 'keySigningKey_digestAlgorithmType' - An integer used to represent the delegation signer digest algorithm.
-- This value must follow the guidelines provided by
-- <https://tools.ietf.org/html/rfc8624#section-3.3 RFC-8624 Section 3.3>.
--
-- 'digestValue', 'keySigningKey_digestValue' - A cryptographic digest of a DNSKEY resource record (RR). DNSKEY records
-- are used to publish the public key that resolvers can use to verify
-- DNSSEC signatures that are used to secure certain kinds of information
-- provided by the DNS system.
--
-- 'flag', 'keySigningKey_flag' - An integer that specifies how the key is used. For key-signing key
-- (KSK), this value is always 257.
--
-- 'keyTag', 'keySigningKey_keyTag' - An integer used to identify the DNSSEC record for the domain name. The
-- process used to calculate the value is described in
-- <https://tools.ietf.org/rfc/rfc4034.txt RFC-4034 Appendix B>.
--
-- 'kmsArn', 'keySigningKey_kmsArn' - The Amazon resource name (ARN) used to identify the customer managed key
-- in Key Management Service (KMS). The @KmsArn@ must be unique for each
-- key-signing key (KSK) in a single hosted zone.
--
-- You must configure the 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 the customer managed key in KMS,
-- see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html Key Management Service concepts>.
--
-- 'lastModifiedDate', 'keySigningKey_lastModifiedDate' - The last time that the key-signing key (KSK) was changed.
--
-- 'name', 'keySigningKey_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.
--
-- 'publicKey', 'keySigningKey_publicKey' - The public key, represented as a Base64 encoding, as required by
-- <https://tools.ietf.org/rfc/rfc4034.txt RFC-4034 Page 5>.
--
-- 'signingAlgorithmMnemonic', 'keySigningKey_signingAlgorithmMnemonic' - A string used to represent the signing algorithm. This value must follow
-- the guidelines provided by
-- <https://tools.ietf.org/html/rfc8624#section-3.1 RFC-8624 Section 3.1>.
--
-- 'signingAlgorithmType', 'keySigningKey_signingAlgorithmType' - An integer used to represent the signing algorithm. This value must
-- follow the guidelines provided by
-- <https://tools.ietf.org/html/rfc8624#section-3.1 RFC-8624 Section 3.1>.
--
-- 'status', 'keySigningKey_status' - A string that represents the current key-signing key (KSK) status.
--
-- Status can have one of the following values:
--
-- [ACTIVE]
--     The KSK is being used for signing.
--
-- [INACTIVE]
--     The KSK is not being used for signing.
--
-- [DELETING]
--     The KSK is in the process of being deleted.
--
-- [ACTION_NEEDED]
--     There is a problem with the KSK that requires you to take action to
--     resolve. For example, the customer managed key might have been
--     deleted, or the permissions for the customer managed key might have
--     been changed.
--
-- [INTERNAL_FAILURE]
--     There was an error during a request. Before you can continue to work
--     with DNSSEC signing, including actions that involve this KSK, you
--     must correct the problem. For example, you may need to activate or
--     deactivate the KSK.
--
-- 'statusMessage', 'keySigningKey_statusMessage' - The status message provided for the following key-signing key (KSK)
-- statuses: @ACTION_NEEDED@ or @INTERNAL_FAILURE@. The status message
-- includes information about what the problem might be and steps that you
-- can take to correct the issue.
newKeySigningKey ::
  KeySigningKey
newKeySigningKey :: KeySigningKey
newKeySigningKey =
  KeySigningKey'
    { $sel:createdDate:KeySigningKey' :: Maybe ISO8601
createdDate = forall a. Maybe a
Prelude.Nothing,
      $sel:dNSKEYRecord:KeySigningKey' :: Maybe Text
dNSKEYRecord = forall a. Maybe a
Prelude.Nothing,
      $sel:dSRecord:KeySigningKey' :: Maybe Text
dSRecord = forall a. Maybe a
Prelude.Nothing,
      $sel:digestAlgorithmMnemonic:KeySigningKey' :: Maybe Text
digestAlgorithmMnemonic = forall a. Maybe a
Prelude.Nothing,
      $sel:digestAlgorithmType:KeySigningKey' :: Maybe Int
digestAlgorithmType = forall a. Maybe a
Prelude.Nothing,
      $sel:digestValue:KeySigningKey' :: Maybe Text
digestValue = forall a. Maybe a
Prelude.Nothing,
      $sel:flag:KeySigningKey' :: Maybe Int
flag = forall a. Maybe a
Prelude.Nothing,
      $sel:keyTag:KeySigningKey' :: Maybe Natural
keyTag = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsArn:KeySigningKey' :: Maybe Text
kmsArn = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedDate:KeySigningKey' :: Maybe ISO8601
lastModifiedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:name:KeySigningKey' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:publicKey:KeySigningKey' :: Maybe Text
publicKey = forall a. Maybe a
Prelude.Nothing,
      $sel:signingAlgorithmMnemonic:KeySigningKey' :: Maybe Text
signingAlgorithmMnemonic = forall a. Maybe a
Prelude.Nothing,
      $sel:signingAlgorithmType:KeySigningKey' :: Maybe Int
signingAlgorithmType = forall a. Maybe a
Prelude.Nothing,
      $sel:status:KeySigningKey' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusMessage:KeySigningKey' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing
    }

-- | The date when the key-signing key (KSK) was created.
keySigningKey_createdDate :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.UTCTime)
keySigningKey_createdDate :: Lens' KeySigningKey (Maybe UTCTime)
keySigningKey_createdDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe ISO8601
createdDate :: Maybe ISO8601
$sel:createdDate:KeySigningKey' :: KeySigningKey -> Maybe ISO8601
createdDate} -> Maybe ISO8601
createdDate) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe ISO8601
a -> KeySigningKey
s {$sel:createdDate:KeySigningKey' :: Maybe ISO8601
createdDate = Maybe ISO8601
a} :: KeySigningKey) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | A string that represents a DNSKEY record.
keySigningKey_dNSKEYRecord :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.Text)
keySigningKey_dNSKEYRecord :: Lens' KeySigningKey (Maybe Text)
keySigningKey_dNSKEYRecord = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe Text
dNSKEYRecord :: Maybe Text
$sel:dNSKEYRecord:KeySigningKey' :: KeySigningKey -> Maybe Text
dNSKEYRecord} -> Maybe Text
dNSKEYRecord) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe Text
a -> KeySigningKey
s {$sel:dNSKEYRecord:KeySigningKey' :: Maybe Text
dNSKEYRecord = Maybe Text
a} :: KeySigningKey)

-- | A string that represents a delegation signer (DS) record.
keySigningKey_dSRecord :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.Text)
keySigningKey_dSRecord :: Lens' KeySigningKey (Maybe Text)
keySigningKey_dSRecord = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe Text
dSRecord :: Maybe Text
$sel:dSRecord:KeySigningKey' :: KeySigningKey -> Maybe Text
dSRecord} -> Maybe Text
dSRecord) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe Text
a -> KeySigningKey
s {$sel:dSRecord:KeySigningKey' :: Maybe Text
dSRecord = Maybe Text
a} :: KeySigningKey)

-- | A string used to represent the delegation signer digest algorithm. This
-- value must follow the guidelines provided by
-- <https://tools.ietf.org/html/rfc8624#section-3.3 RFC-8624 Section 3.3>.
keySigningKey_digestAlgorithmMnemonic :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.Text)
keySigningKey_digestAlgorithmMnemonic :: Lens' KeySigningKey (Maybe Text)
keySigningKey_digestAlgorithmMnemonic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe Text
digestAlgorithmMnemonic :: Maybe Text
$sel:digestAlgorithmMnemonic:KeySigningKey' :: KeySigningKey -> Maybe Text
digestAlgorithmMnemonic} -> Maybe Text
digestAlgorithmMnemonic) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe Text
a -> KeySigningKey
s {$sel:digestAlgorithmMnemonic:KeySigningKey' :: Maybe Text
digestAlgorithmMnemonic = Maybe Text
a} :: KeySigningKey)

-- | An integer used to represent the delegation signer digest algorithm.
-- This value must follow the guidelines provided by
-- <https://tools.ietf.org/html/rfc8624#section-3.3 RFC-8624 Section 3.3>.
keySigningKey_digestAlgorithmType :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.Int)
keySigningKey_digestAlgorithmType :: Lens' KeySigningKey (Maybe Int)
keySigningKey_digestAlgorithmType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe Int
digestAlgorithmType :: Maybe Int
$sel:digestAlgorithmType:KeySigningKey' :: KeySigningKey -> Maybe Int
digestAlgorithmType} -> Maybe Int
digestAlgorithmType) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe Int
a -> KeySigningKey
s {$sel:digestAlgorithmType:KeySigningKey' :: Maybe Int
digestAlgorithmType = Maybe Int
a} :: KeySigningKey)

-- | A cryptographic digest of a DNSKEY resource record (RR). DNSKEY records
-- are used to publish the public key that resolvers can use to verify
-- DNSSEC signatures that are used to secure certain kinds of information
-- provided by the DNS system.
keySigningKey_digestValue :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.Text)
keySigningKey_digestValue :: Lens' KeySigningKey (Maybe Text)
keySigningKey_digestValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe Text
digestValue :: Maybe Text
$sel:digestValue:KeySigningKey' :: KeySigningKey -> Maybe Text
digestValue} -> Maybe Text
digestValue) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe Text
a -> KeySigningKey
s {$sel:digestValue:KeySigningKey' :: Maybe Text
digestValue = Maybe Text
a} :: KeySigningKey)

-- | An integer that specifies how the key is used. For key-signing key
-- (KSK), this value is always 257.
keySigningKey_flag :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.Int)
keySigningKey_flag :: Lens' KeySigningKey (Maybe Int)
keySigningKey_flag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe Int
flag :: Maybe Int
$sel:flag:KeySigningKey' :: KeySigningKey -> Maybe Int
flag} -> Maybe Int
flag) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe Int
a -> KeySigningKey
s {$sel:flag:KeySigningKey' :: Maybe Int
flag = Maybe Int
a} :: KeySigningKey)

-- | An integer used to identify the DNSSEC record for the domain name. The
-- process used to calculate the value is described in
-- <https://tools.ietf.org/rfc/rfc4034.txt RFC-4034 Appendix B>.
keySigningKey_keyTag :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.Natural)
keySigningKey_keyTag :: Lens' KeySigningKey (Maybe Natural)
keySigningKey_keyTag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe Natural
keyTag :: Maybe Natural
$sel:keyTag:KeySigningKey' :: KeySigningKey -> Maybe Natural
keyTag} -> Maybe Natural
keyTag) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe Natural
a -> KeySigningKey
s {$sel:keyTag:KeySigningKey' :: Maybe Natural
keyTag = Maybe Natural
a} :: KeySigningKey)

-- | The Amazon resource name (ARN) used to identify the customer managed key
-- in Key Management Service (KMS). The @KmsArn@ must be unique for each
-- key-signing key (KSK) in a single hosted zone.
--
-- You must configure the 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 the customer managed key in KMS,
-- see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html Key Management Service concepts>.
keySigningKey_kmsArn :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.Text)
keySigningKey_kmsArn :: Lens' KeySigningKey (Maybe Text)
keySigningKey_kmsArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe Text
kmsArn :: Maybe Text
$sel:kmsArn:KeySigningKey' :: KeySigningKey -> Maybe Text
kmsArn} -> Maybe Text
kmsArn) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe Text
a -> KeySigningKey
s {$sel:kmsArn:KeySigningKey' :: Maybe Text
kmsArn = Maybe Text
a} :: KeySigningKey)

-- | The last time that the key-signing key (KSK) was changed.
keySigningKey_lastModifiedDate :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.UTCTime)
keySigningKey_lastModifiedDate :: Lens' KeySigningKey (Maybe UTCTime)
keySigningKey_lastModifiedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe ISO8601
lastModifiedDate :: Maybe ISO8601
$sel:lastModifiedDate:KeySigningKey' :: KeySigningKey -> Maybe ISO8601
lastModifiedDate} -> Maybe ISO8601
lastModifiedDate) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe ISO8601
a -> KeySigningKey
s {$sel:lastModifiedDate:KeySigningKey' :: Maybe ISO8601
lastModifiedDate = Maybe ISO8601
a} :: KeySigningKey) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | 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.
keySigningKey_name :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.Text)
keySigningKey_name :: Lens' KeySigningKey (Maybe Text)
keySigningKey_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe Text
name :: Maybe Text
$sel:name:KeySigningKey' :: KeySigningKey -> Maybe Text
name} -> Maybe Text
name) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe Text
a -> KeySigningKey
s {$sel:name:KeySigningKey' :: Maybe Text
name = Maybe Text
a} :: KeySigningKey)

-- | The public key, represented as a Base64 encoding, as required by
-- <https://tools.ietf.org/rfc/rfc4034.txt RFC-4034 Page 5>.
keySigningKey_publicKey :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.Text)
keySigningKey_publicKey :: Lens' KeySigningKey (Maybe Text)
keySigningKey_publicKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe Text
publicKey :: Maybe Text
$sel:publicKey:KeySigningKey' :: KeySigningKey -> Maybe Text
publicKey} -> Maybe Text
publicKey) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe Text
a -> KeySigningKey
s {$sel:publicKey:KeySigningKey' :: Maybe Text
publicKey = Maybe Text
a} :: KeySigningKey)

-- | A string used to represent the signing algorithm. This value must follow
-- the guidelines provided by
-- <https://tools.ietf.org/html/rfc8624#section-3.1 RFC-8624 Section 3.1>.
keySigningKey_signingAlgorithmMnemonic :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.Text)
keySigningKey_signingAlgorithmMnemonic :: Lens' KeySigningKey (Maybe Text)
keySigningKey_signingAlgorithmMnemonic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe Text
signingAlgorithmMnemonic :: Maybe Text
$sel:signingAlgorithmMnemonic:KeySigningKey' :: KeySigningKey -> Maybe Text
signingAlgorithmMnemonic} -> Maybe Text
signingAlgorithmMnemonic) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe Text
a -> KeySigningKey
s {$sel:signingAlgorithmMnemonic:KeySigningKey' :: Maybe Text
signingAlgorithmMnemonic = Maybe Text
a} :: KeySigningKey)

-- | An integer used to represent the signing algorithm. This value must
-- follow the guidelines provided by
-- <https://tools.ietf.org/html/rfc8624#section-3.1 RFC-8624 Section 3.1>.
keySigningKey_signingAlgorithmType :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.Int)
keySigningKey_signingAlgorithmType :: Lens' KeySigningKey (Maybe Int)
keySigningKey_signingAlgorithmType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe Int
signingAlgorithmType :: Maybe Int
$sel:signingAlgorithmType:KeySigningKey' :: KeySigningKey -> Maybe Int
signingAlgorithmType} -> Maybe Int
signingAlgorithmType) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe Int
a -> KeySigningKey
s {$sel:signingAlgorithmType:KeySigningKey' :: Maybe Int
signingAlgorithmType = Maybe Int
a} :: KeySigningKey)

-- | A string that represents the current key-signing key (KSK) status.
--
-- Status can have one of the following values:
--
-- [ACTIVE]
--     The KSK is being used for signing.
--
-- [INACTIVE]
--     The KSK is not being used for signing.
--
-- [DELETING]
--     The KSK is in the process of being deleted.
--
-- [ACTION_NEEDED]
--     There is a problem with the KSK that requires you to take action to
--     resolve. For example, the customer managed key might have been
--     deleted, or the permissions for the customer managed key might have
--     been changed.
--
-- [INTERNAL_FAILURE]
--     There was an error during a request. Before you can continue to work
--     with DNSSEC signing, including actions that involve this KSK, you
--     must correct the problem. For example, you may need to activate or
--     deactivate the KSK.
keySigningKey_status :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.Text)
keySigningKey_status :: Lens' KeySigningKey (Maybe Text)
keySigningKey_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe Text
status :: Maybe Text
$sel:status:KeySigningKey' :: KeySigningKey -> Maybe Text
status} -> Maybe Text
status) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe Text
a -> KeySigningKey
s {$sel:status:KeySigningKey' :: Maybe Text
status = Maybe Text
a} :: KeySigningKey)

-- | The status message provided for the following key-signing key (KSK)
-- statuses: @ACTION_NEEDED@ or @INTERNAL_FAILURE@. The status message
-- includes information about what the problem might be and steps that you
-- can take to correct the issue.
keySigningKey_statusMessage :: Lens.Lens' KeySigningKey (Prelude.Maybe Prelude.Text)
keySigningKey_statusMessage :: Lens' KeySigningKey (Maybe Text)
keySigningKey_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeySigningKey' {Maybe Text
statusMessage :: Maybe Text
$sel:statusMessage:KeySigningKey' :: KeySigningKey -> Maybe Text
statusMessage} -> Maybe Text
statusMessage) (\s :: KeySigningKey
s@KeySigningKey' {} Maybe Text
a -> KeySigningKey
s {$sel:statusMessage:KeySigningKey' :: Maybe Text
statusMessage = Maybe Text
a} :: KeySigningKey)

instance Data.FromXML KeySigningKey where
  parseXML :: [Node] -> Either String KeySigningKey
parseXML [Node]
x =
    Maybe ISO8601
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe Natural
-> Maybe Text
-> Maybe ISO8601
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> KeySigningKey
KeySigningKey'
      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
"CreatedDate")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DNSKEYRecord")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DSRecord")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DigestAlgorithmMnemonic")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DigestAlgorithmType")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DigestValue")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Flag")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"KeyTag")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"KmsArn")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"LastModifiedDate")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Name")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"PublicKey")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"SigningAlgorithmMnemonic")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"SigningAlgorithmType")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Status")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"StatusMessage")

instance Prelude.Hashable KeySigningKey where
  hashWithSalt :: Int -> KeySigningKey -> Int
hashWithSalt Int
_salt KeySigningKey' {Maybe Int
Maybe Natural
Maybe Text
Maybe ISO8601
statusMessage :: Maybe Text
status :: Maybe Text
signingAlgorithmType :: Maybe Int
signingAlgorithmMnemonic :: Maybe Text
publicKey :: Maybe Text
name :: Maybe Text
lastModifiedDate :: Maybe ISO8601
kmsArn :: Maybe Text
keyTag :: Maybe Natural
flag :: Maybe Int
digestValue :: Maybe Text
digestAlgorithmType :: Maybe Int
digestAlgorithmMnemonic :: Maybe Text
dSRecord :: Maybe Text
dNSKEYRecord :: Maybe Text
createdDate :: Maybe ISO8601
$sel:statusMessage:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:status:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:signingAlgorithmType:KeySigningKey' :: KeySigningKey -> Maybe Int
$sel:signingAlgorithmMnemonic:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:publicKey:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:name:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:lastModifiedDate:KeySigningKey' :: KeySigningKey -> Maybe ISO8601
$sel:kmsArn:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:keyTag:KeySigningKey' :: KeySigningKey -> Maybe Natural
$sel:flag:KeySigningKey' :: KeySigningKey -> Maybe Int
$sel:digestValue:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:digestAlgorithmType:KeySigningKey' :: KeySigningKey -> Maybe Int
$sel:digestAlgorithmMnemonic:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:dSRecord:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:dNSKEYRecord:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:createdDate:KeySigningKey' :: KeySigningKey -> Maybe ISO8601
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
createdDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dNSKEYRecord
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dSRecord
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
digestAlgorithmMnemonic
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
digestAlgorithmType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
digestValue
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
flag
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
keyTag
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
lastModifiedDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
publicKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
signingAlgorithmMnemonic
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
signingAlgorithmType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statusMessage

instance Prelude.NFData KeySigningKey where
  rnf :: KeySigningKey -> ()
rnf KeySigningKey' {Maybe Int
Maybe Natural
Maybe Text
Maybe ISO8601
statusMessage :: Maybe Text
status :: Maybe Text
signingAlgorithmType :: Maybe Int
signingAlgorithmMnemonic :: Maybe Text
publicKey :: Maybe Text
name :: Maybe Text
lastModifiedDate :: Maybe ISO8601
kmsArn :: Maybe Text
keyTag :: Maybe Natural
flag :: Maybe Int
digestValue :: Maybe Text
digestAlgorithmType :: Maybe Int
digestAlgorithmMnemonic :: Maybe Text
dSRecord :: Maybe Text
dNSKEYRecord :: Maybe Text
createdDate :: Maybe ISO8601
$sel:statusMessage:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:status:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:signingAlgorithmType:KeySigningKey' :: KeySigningKey -> Maybe Int
$sel:signingAlgorithmMnemonic:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:publicKey:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:name:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:lastModifiedDate:KeySigningKey' :: KeySigningKey -> Maybe ISO8601
$sel:kmsArn:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:keyTag:KeySigningKey' :: KeySigningKey -> Maybe Natural
$sel:flag:KeySigningKey' :: KeySigningKey -> Maybe Int
$sel:digestValue:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:digestAlgorithmType:KeySigningKey' :: KeySigningKey -> Maybe Int
$sel:digestAlgorithmMnemonic:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:dSRecord:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:dNSKEYRecord:KeySigningKey' :: KeySigningKey -> Maybe Text
$sel:createdDate:KeySigningKey' :: KeySigningKey -> Maybe ISO8601
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
createdDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dNSKEYRecord
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dSRecord
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
digestAlgorithmMnemonic
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
digestAlgorithmType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
digestValue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
flag
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
keyTag
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
lastModifiedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
publicKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
signingAlgorithmMnemonic
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
signingAlgorithmType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusMessage