{-# 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.Glue.GetDataCatalogEncryptionSettings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the security configuration for a specified catalog.
module Amazonka.Glue.GetDataCatalogEncryptionSettings
  ( -- * Creating a Request
    GetDataCatalogEncryptionSettings (..),
    newGetDataCatalogEncryptionSettings,

    -- * Request Lenses
    getDataCatalogEncryptionSettings_catalogId,

    -- * Destructuring the Response
    GetDataCatalogEncryptionSettingsResponse (..),
    newGetDataCatalogEncryptionSettingsResponse,

    -- * Response Lenses
    getDataCatalogEncryptionSettingsResponse_dataCatalogEncryptionSettings,
    getDataCatalogEncryptionSettingsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Glue.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetDataCatalogEncryptionSettings' smart constructor.
data GetDataCatalogEncryptionSettings = GetDataCatalogEncryptionSettings'
  { -- | The ID of the Data Catalog to retrieve the security configuration for.
    -- If none is provided, the Amazon Web Services account ID is used by
    -- default.
    GetDataCatalogEncryptionSettings -> Maybe Text
catalogId :: Prelude.Maybe Prelude.Text
  }
  deriving (GetDataCatalogEncryptionSettings
-> GetDataCatalogEncryptionSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDataCatalogEncryptionSettings
-> GetDataCatalogEncryptionSettings -> Bool
$c/= :: GetDataCatalogEncryptionSettings
-> GetDataCatalogEncryptionSettings -> Bool
== :: GetDataCatalogEncryptionSettings
-> GetDataCatalogEncryptionSettings -> Bool
$c== :: GetDataCatalogEncryptionSettings
-> GetDataCatalogEncryptionSettings -> Bool
Prelude.Eq, ReadPrec [GetDataCatalogEncryptionSettings]
ReadPrec GetDataCatalogEncryptionSettings
Int -> ReadS GetDataCatalogEncryptionSettings
ReadS [GetDataCatalogEncryptionSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDataCatalogEncryptionSettings]
$creadListPrec :: ReadPrec [GetDataCatalogEncryptionSettings]
readPrec :: ReadPrec GetDataCatalogEncryptionSettings
$creadPrec :: ReadPrec GetDataCatalogEncryptionSettings
readList :: ReadS [GetDataCatalogEncryptionSettings]
$creadList :: ReadS [GetDataCatalogEncryptionSettings]
readsPrec :: Int -> ReadS GetDataCatalogEncryptionSettings
$creadsPrec :: Int -> ReadS GetDataCatalogEncryptionSettings
Prelude.Read, Int -> GetDataCatalogEncryptionSettings -> ShowS
[GetDataCatalogEncryptionSettings] -> ShowS
GetDataCatalogEncryptionSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDataCatalogEncryptionSettings] -> ShowS
$cshowList :: [GetDataCatalogEncryptionSettings] -> ShowS
show :: GetDataCatalogEncryptionSettings -> String
$cshow :: GetDataCatalogEncryptionSettings -> String
showsPrec :: Int -> GetDataCatalogEncryptionSettings -> ShowS
$cshowsPrec :: Int -> GetDataCatalogEncryptionSettings -> ShowS
Prelude.Show, forall x.
Rep GetDataCatalogEncryptionSettings x
-> GetDataCatalogEncryptionSettings
forall x.
GetDataCatalogEncryptionSettings
-> Rep GetDataCatalogEncryptionSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDataCatalogEncryptionSettings x
-> GetDataCatalogEncryptionSettings
$cfrom :: forall x.
GetDataCatalogEncryptionSettings
-> Rep GetDataCatalogEncryptionSettings x
Prelude.Generic)

-- |
-- Create a value of 'GetDataCatalogEncryptionSettings' 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:
--
-- 'catalogId', 'getDataCatalogEncryptionSettings_catalogId' - The ID of the Data Catalog to retrieve the security configuration for.
-- If none is provided, the Amazon Web Services account ID is used by
-- default.
newGetDataCatalogEncryptionSettings ::
  GetDataCatalogEncryptionSettings
newGetDataCatalogEncryptionSettings :: GetDataCatalogEncryptionSettings
newGetDataCatalogEncryptionSettings =
  GetDataCatalogEncryptionSettings'
    { $sel:catalogId:GetDataCatalogEncryptionSettings' :: Maybe Text
catalogId =
        forall a. Maybe a
Prelude.Nothing
    }

-- | The ID of the Data Catalog to retrieve the security configuration for.
-- If none is provided, the Amazon Web Services account ID is used by
-- default.
getDataCatalogEncryptionSettings_catalogId :: Lens.Lens' GetDataCatalogEncryptionSettings (Prelude.Maybe Prelude.Text)
getDataCatalogEncryptionSettings_catalogId :: Lens' GetDataCatalogEncryptionSettings (Maybe Text)
getDataCatalogEncryptionSettings_catalogId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataCatalogEncryptionSettings' {Maybe Text
catalogId :: Maybe Text
$sel:catalogId:GetDataCatalogEncryptionSettings' :: GetDataCatalogEncryptionSettings -> Maybe Text
catalogId} -> Maybe Text
catalogId) (\s :: GetDataCatalogEncryptionSettings
s@GetDataCatalogEncryptionSettings' {} Maybe Text
a -> GetDataCatalogEncryptionSettings
s {$sel:catalogId:GetDataCatalogEncryptionSettings' :: Maybe Text
catalogId = Maybe Text
a} :: GetDataCatalogEncryptionSettings)

instance
  Core.AWSRequest
    GetDataCatalogEncryptionSettings
  where
  type
    AWSResponse GetDataCatalogEncryptionSettings =
      GetDataCatalogEncryptionSettingsResponse
  request :: (Service -> Service)
-> GetDataCatalogEncryptionSettings
-> Request GetDataCatalogEncryptionSettings
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetDataCatalogEncryptionSettings
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GetDataCatalogEncryptionSettings)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe DataCatalogEncryptionSettings
-> Int -> GetDataCatalogEncryptionSettingsResponse
GetDataCatalogEncryptionSettingsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DataCatalogEncryptionSettings")
            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
    GetDataCatalogEncryptionSettings
  where
  hashWithSalt :: Int -> GetDataCatalogEncryptionSettings -> Int
hashWithSalt
    Int
_salt
    GetDataCatalogEncryptionSettings' {Maybe Text
catalogId :: Maybe Text
$sel:catalogId:GetDataCatalogEncryptionSettings' :: GetDataCatalogEncryptionSettings -> Maybe Text
..} =
      Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
catalogId

instance
  Prelude.NFData
    GetDataCatalogEncryptionSettings
  where
  rnf :: GetDataCatalogEncryptionSettings -> ()
rnf GetDataCatalogEncryptionSettings' {Maybe Text
catalogId :: Maybe Text
$sel:catalogId:GetDataCatalogEncryptionSettings' :: GetDataCatalogEncryptionSettings -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
catalogId

instance
  Data.ToHeaders
    GetDataCatalogEncryptionSettings
  where
  toHeaders :: GetDataCatalogEncryptionSettings -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AWSGlue.GetDataCatalogEncryptionSettings" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON GetDataCatalogEncryptionSettings where
  toJSON :: GetDataCatalogEncryptionSettings -> Value
toJSON GetDataCatalogEncryptionSettings' {Maybe Text
catalogId :: Maybe Text
$sel:catalogId:GetDataCatalogEncryptionSettings' :: GetDataCatalogEncryptionSettings -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"CatalogId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
catalogId]
      )

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

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

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

-- |
-- Create a value of 'GetDataCatalogEncryptionSettingsResponse' 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:
--
-- 'dataCatalogEncryptionSettings', 'getDataCatalogEncryptionSettingsResponse_dataCatalogEncryptionSettings' - The requested security configuration.
--
-- 'httpStatus', 'getDataCatalogEncryptionSettingsResponse_httpStatus' - The response's http status code.
newGetDataCatalogEncryptionSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDataCatalogEncryptionSettingsResponse
newGetDataCatalogEncryptionSettingsResponse :: Int -> GetDataCatalogEncryptionSettingsResponse
newGetDataCatalogEncryptionSettingsResponse
  Int
pHttpStatus_ =
    GetDataCatalogEncryptionSettingsResponse'
      { $sel:dataCatalogEncryptionSettings:GetDataCatalogEncryptionSettingsResponse' :: Maybe DataCatalogEncryptionSettings
dataCatalogEncryptionSettings =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetDataCatalogEncryptionSettingsResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The requested security configuration.
getDataCatalogEncryptionSettingsResponse_dataCatalogEncryptionSettings :: Lens.Lens' GetDataCatalogEncryptionSettingsResponse (Prelude.Maybe DataCatalogEncryptionSettings)
getDataCatalogEncryptionSettingsResponse_dataCatalogEncryptionSettings :: Lens'
  GetDataCatalogEncryptionSettingsResponse
  (Maybe DataCatalogEncryptionSettings)
getDataCatalogEncryptionSettingsResponse_dataCatalogEncryptionSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataCatalogEncryptionSettingsResponse' {Maybe DataCatalogEncryptionSettings
dataCatalogEncryptionSettings :: Maybe DataCatalogEncryptionSettings
$sel:dataCatalogEncryptionSettings:GetDataCatalogEncryptionSettingsResponse' :: GetDataCatalogEncryptionSettingsResponse
-> Maybe DataCatalogEncryptionSettings
dataCatalogEncryptionSettings} -> Maybe DataCatalogEncryptionSettings
dataCatalogEncryptionSettings) (\s :: GetDataCatalogEncryptionSettingsResponse
s@GetDataCatalogEncryptionSettingsResponse' {} Maybe DataCatalogEncryptionSettings
a -> GetDataCatalogEncryptionSettingsResponse
s {$sel:dataCatalogEncryptionSettings:GetDataCatalogEncryptionSettingsResponse' :: Maybe DataCatalogEncryptionSettings
dataCatalogEncryptionSettings = Maybe DataCatalogEncryptionSettings
a} :: GetDataCatalogEncryptionSettingsResponse)

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

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