{-# 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.GetDNSSEC
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns information about DNSSEC for a specific hosted zone, including
-- the key-signing keys (KSKs) in the hosted zone.
module Amazonka.Route53.GetDNSSEC
  ( -- * Creating a Request
    GetDNSSEC (..),
    newGetDNSSEC,

    -- * Request Lenses
    getDNSSEC_hostedZoneId,

    -- * Destructuring the Response
    GetDNSSECResponse (..),
    newGetDNSSECResponse,

    -- * Response Lenses
    getDNSSECResponse_httpStatus,
    getDNSSECResponse_status,
    getDNSSECResponse_keySigningKeys,
  )
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:/ 'newGetDNSSEC' smart constructor.
data GetDNSSEC = GetDNSSEC'
  { -- | A unique string used to identify a hosted zone.
    GetDNSSEC -> ResourceId
hostedZoneId :: ResourceId
  }
  deriving (GetDNSSEC -> GetDNSSEC -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDNSSEC -> GetDNSSEC -> Bool
$c/= :: GetDNSSEC -> GetDNSSEC -> Bool
== :: GetDNSSEC -> GetDNSSEC -> Bool
$c== :: GetDNSSEC -> GetDNSSEC -> Bool
Prelude.Eq, ReadPrec [GetDNSSEC]
ReadPrec GetDNSSEC
Int -> ReadS GetDNSSEC
ReadS [GetDNSSEC]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDNSSEC]
$creadListPrec :: ReadPrec [GetDNSSEC]
readPrec :: ReadPrec GetDNSSEC
$creadPrec :: ReadPrec GetDNSSEC
readList :: ReadS [GetDNSSEC]
$creadList :: ReadS [GetDNSSEC]
readsPrec :: Int -> ReadS GetDNSSEC
$creadsPrec :: Int -> ReadS GetDNSSEC
Prelude.Read, Int -> GetDNSSEC -> ShowS
[GetDNSSEC] -> ShowS
GetDNSSEC -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDNSSEC] -> ShowS
$cshowList :: [GetDNSSEC] -> ShowS
show :: GetDNSSEC -> String
$cshow :: GetDNSSEC -> String
showsPrec :: Int -> GetDNSSEC -> ShowS
$cshowsPrec :: Int -> GetDNSSEC -> ShowS
Prelude.Show, forall x. Rep GetDNSSEC x -> GetDNSSEC
forall x. GetDNSSEC -> Rep GetDNSSEC x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDNSSEC x -> GetDNSSEC
$cfrom :: forall x. GetDNSSEC -> Rep GetDNSSEC x
Prelude.Generic)

-- |
-- Create a value of 'GetDNSSEC' 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:
--
-- 'hostedZoneId', 'getDNSSEC_hostedZoneId' - A unique string used to identify a hosted zone.
newGetDNSSEC ::
  -- | 'hostedZoneId'
  ResourceId ->
  GetDNSSEC
newGetDNSSEC :: ResourceId -> GetDNSSEC
newGetDNSSEC ResourceId
pHostedZoneId_ =
  GetDNSSEC' {$sel:hostedZoneId:GetDNSSEC' :: ResourceId
hostedZoneId = ResourceId
pHostedZoneId_}

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

instance Core.AWSRequest GetDNSSEC where
  type AWSResponse GetDNSSEC = GetDNSSECResponse
  request :: (Service -> Service) -> GetDNSSEC -> Request GetDNSSEC
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetDNSSEC
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetDNSSEC)))
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 -> DNSSECStatus -> [KeySigningKey] -> GetDNSSECResponse
GetDNSSECResponse'
            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
"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
"KeySigningKeys"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member"
                        )
      )

instance Prelude.Hashable GetDNSSEC where
  hashWithSalt :: Int -> GetDNSSEC -> Int
hashWithSalt Int
_salt GetDNSSEC' {ResourceId
hostedZoneId :: ResourceId
$sel:hostedZoneId:GetDNSSEC' :: GetDNSSEC -> ResourceId
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceId
hostedZoneId

instance Prelude.NFData GetDNSSEC where
  rnf :: GetDNSSEC -> ()
rnf GetDNSSEC' {ResourceId
hostedZoneId :: ResourceId
$sel:hostedZoneId:GetDNSSEC' :: GetDNSSEC -> ResourceId
..} = forall a. NFData a => a -> ()
Prelude.rnf ResourceId
hostedZoneId

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

instance Data.ToPath GetDNSSEC where
  toPath :: GetDNSSEC -> ByteString
toPath GetDNSSEC' {ResourceId
hostedZoneId :: ResourceId
$sel:hostedZoneId:GetDNSSEC' :: GetDNSSEC -> ResourceId
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2013-04-01/hostedzone/",
        forall a. ToByteString a => a -> ByteString
Data.toBS ResourceId
hostedZoneId,
        ByteString
"/dnssec"
      ]

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

-- | /See:/ 'newGetDNSSECResponse' smart constructor.
data GetDNSSECResponse = GetDNSSECResponse'
  { -- | The response's http status code.
    GetDNSSECResponse -> Int
httpStatus :: Prelude.Int,
    -- | A string repesenting the status of DNSSEC.
    GetDNSSECResponse -> DNSSECStatus
status :: DNSSECStatus,
    -- | The key-signing keys (KSKs) in your account.
    GetDNSSECResponse -> [KeySigningKey]
keySigningKeys :: [KeySigningKey]
  }
  deriving (GetDNSSECResponse -> GetDNSSECResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDNSSECResponse -> GetDNSSECResponse -> Bool
$c/= :: GetDNSSECResponse -> GetDNSSECResponse -> Bool
== :: GetDNSSECResponse -> GetDNSSECResponse -> Bool
$c== :: GetDNSSECResponse -> GetDNSSECResponse -> Bool
Prelude.Eq, ReadPrec [GetDNSSECResponse]
ReadPrec GetDNSSECResponse
Int -> ReadS GetDNSSECResponse
ReadS [GetDNSSECResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDNSSECResponse]
$creadListPrec :: ReadPrec [GetDNSSECResponse]
readPrec :: ReadPrec GetDNSSECResponse
$creadPrec :: ReadPrec GetDNSSECResponse
readList :: ReadS [GetDNSSECResponse]
$creadList :: ReadS [GetDNSSECResponse]
readsPrec :: Int -> ReadS GetDNSSECResponse
$creadsPrec :: Int -> ReadS GetDNSSECResponse
Prelude.Read, Int -> GetDNSSECResponse -> ShowS
[GetDNSSECResponse] -> ShowS
GetDNSSECResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDNSSECResponse] -> ShowS
$cshowList :: [GetDNSSECResponse] -> ShowS
show :: GetDNSSECResponse -> String
$cshow :: GetDNSSECResponse -> String
showsPrec :: Int -> GetDNSSECResponse -> ShowS
$cshowsPrec :: Int -> GetDNSSECResponse -> ShowS
Prelude.Show, forall x. Rep GetDNSSECResponse x -> GetDNSSECResponse
forall x. GetDNSSECResponse -> Rep GetDNSSECResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDNSSECResponse x -> GetDNSSECResponse
$cfrom :: forall x. GetDNSSECResponse -> Rep GetDNSSECResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDNSSECResponse' 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', 'getDNSSECResponse_httpStatus' - The response's http status code.
--
-- 'status', 'getDNSSECResponse_status' - A string repesenting the status of DNSSEC.
--
-- 'keySigningKeys', 'getDNSSECResponse_keySigningKeys' - The key-signing keys (KSKs) in your account.
newGetDNSSECResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'status'
  DNSSECStatus ->
  GetDNSSECResponse
newGetDNSSECResponse :: Int -> DNSSECStatus -> GetDNSSECResponse
newGetDNSSECResponse Int
pHttpStatus_ DNSSECStatus
pStatus_ =
  GetDNSSECResponse'
    { $sel:httpStatus:GetDNSSECResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:status:GetDNSSECResponse' :: DNSSECStatus
status = DNSSECStatus
pStatus_,
      $sel:keySigningKeys:GetDNSSECResponse' :: [KeySigningKey]
keySigningKeys = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | A string repesenting the status of DNSSEC.
getDNSSECResponse_status :: Lens.Lens' GetDNSSECResponse DNSSECStatus
getDNSSECResponse_status :: Lens' GetDNSSECResponse DNSSECStatus
getDNSSECResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDNSSECResponse' {DNSSECStatus
status :: DNSSECStatus
$sel:status:GetDNSSECResponse' :: GetDNSSECResponse -> DNSSECStatus
status} -> DNSSECStatus
status) (\s :: GetDNSSECResponse
s@GetDNSSECResponse' {} DNSSECStatus
a -> GetDNSSECResponse
s {$sel:status:GetDNSSECResponse' :: DNSSECStatus
status = DNSSECStatus
a} :: GetDNSSECResponse)

-- | The key-signing keys (KSKs) in your account.
getDNSSECResponse_keySigningKeys :: Lens.Lens' GetDNSSECResponse [KeySigningKey]
getDNSSECResponse_keySigningKeys :: Lens' GetDNSSECResponse [KeySigningKey]
getDNSSECResponse_keySigningKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDNSSECResponse' {[KeySigningKey]
keySigningKeys :: [KeySigningKey]
$sel:keySigningKeys:GetDNSSECResponse' :: GetDNSSECResponse -> [KeySigningKey]
keySigningKeys} -> [KeySigningKey]
keySigningKeys) (\s :: GetDNSSECResponse
s@GetDNSSECResponse' {} [KeySigningKey]
a -> GetDNSSECResponse
s {$sel:keySigningKeys:GetDNSSECResponse' :: [KeySigningKey]
keySigningKeys = [KeySigningKey]
a} :: GetDNSSECResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData GetDNSSECResponse where
  rnf :: GetDNSSECResponse -> ()
rnf GetDNSSECResponse' {Int
[KeySigningKey]
DNSSECStatus
keySigningKeys :: [KeySigningKey]
status :: DNSSECStatus
httpStatus :: Int
$sel:keySigningKeys:GetDNSSECResponse' :: GetDNSSECResponse -> [KeySigningKey]
$sel:status:GetDNSSECResponse' :: GetDNSSECResponse -> DNSSECStatus
$sel:httpStatus:GetDNSSECResponse' :: GetDNSSECResponse -> 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 DNSSECStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [KeySigningKey]
keySigningKeys