{-# 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.XRay.PutEncryptionConfig
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the encryption configuration for X-Ray data.
module Amazonka.XRay.PutEncryptionConfig
  ( -- * Creating a Request
    PutEncryptionConfig (..),
    newPutEncryptionConfig,

    -- * Request Lenses
    putEncryptionConfig_keyId,
    putEncryptionConfig_type,

    -- * Destructuring the Response
    PutEncryptionConfigResponse (..),
    newPutEncryptionConfigResponse,

    -- * Response Lenses
    putEncryptionConfigResponse_encryptionConfig,
    putEncryptionConfigResponse_httpStatus,
  )
where

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

-- | /See:/ 'newPutEncryptionConfig' smart constructor.
data PutEncryptionConfig = PutEncryptionConfig'
  { -- | An Amazon Web Services KMS key in one of the following formats:
    --
    -- -   __Alias__ - The name of the key. For example, @alias\/MyKey@.
    --
    -- -   __Key ID__ - The KMS key ID of the key. For example,
    --     @ae4aa6d49-a4d8-9df9-a475-4ff6d7898456@. Amazon Web Services X-Ray
    --     does not support asymmetric KMS keys.
    --
    -- -   __ARN__ - The full Amazon Resource Name of the key ID or alias. For
    --     example,
    --     @arn:aws:kms:us-east-2:123456789012:key\/ae4aa6d49-a4d8-9df9-a475-4ff6d7898456@.
    --     Use this format to specify a key in a different account.
    --
    -- Omit this key if you set @Type@ to @NONE@.
    PutEncryptionConfig -> Maybe Text
keyId :: Prelude.Maybe Prelude.Text,
    -- | The type of encryption. Set to @KMS@ to use your own key for encryption.
    -- Set to @NONE@ for default encryption.
    PutEncryptionConfig -> EncryptionType
type' :: EncryptionType
  }
  deriving (PutEncryptionConfig -> PutEncryptionConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutEncryptionConfig -> PutEncryptionConfig -> Bool
$c/= :: PutEncryptionConfig -> PutEncryptionConfig -> Bool
== :: PutEncryptionConfig -> PutEncryptionConfig -> Bool
$c== :: PutEncryptionConfig -> PutEncryptionConfig -> Bool
Prelude.Eq, ReadPrec [PutEncryptionConfig]
ReadPrec PutEncryptionConfig
Int -> ReadS PutEncryptionConfig
ReadS [PutEncryptionConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutEncryptionConfig]
$creadListPrec :: ReadPrec [PutEncryptionConfig]
readPrec :: ReadPrec PutEncryptionConfig
$creadPrec :: ReadPrec PutEncryptionConfig
readList :: ReadS [PutEncryptionConfig]
$creadList :: ReadS [PutEncryptionConfig]
readsPrec :: Int -> ReadS PutEncryptionConfig
$creadsPrec :: Int -> ReadS PutEncryptionConfig
Prelude.Read, Int -> PutEncryptionConfig -> ShowS
[PutEncryptionConfig] -> ShowS
PutEncryptionConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutEncryptionConfig] -> ShowS
$cshowList :: [PutEncryptionConfig] -> ShowS
show :: PutEncryptionConfig -> String
$cshow :: PutEncryptionConfig -> String
showsPrec :: Int -> PutEncryptionConfig -> ShowS
$cshowsPrec :: Int -> PutEncryptionConfig -> ShowS
Prelude.Show, forall x. Rep PutEncryptionConfig x -> PutEncryptionConfig
forall x. PutEncryptionConfig -> Rep PutEncryptionConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutEncryptionConfig x -> PutEncryptionConfig
$cfrom :: forall x. PutEncryptionConfig -> Rep PutEncryptionConfig x
Prelude.Generic)

-- |
-- Create a value of 'PutEncryptionConfig' 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:
--
-- 'keyId', 'putEncryptionConfig_keyId' - An Amazon Web Services KMS key in one of the following formats:
--
-- -   __Alias__ - The name of the key. For example, @alias\/MyKey@.
--
-- -   __Key ID__ - The KMS key ID of the key. For example,
--     @ae4aa6d49-a4d8-9df9-a475-4ff6d7898456@. Amazon Web Services X-Ray
--     does not support asymmetric KMS keys.
--
-- -   __ARN__ - The full Amazon Resource Name of the key ID or alias. For
--     example,
--     @arn:aws:kms:us-east-2:123456789012:key\/ae4aa6d49-a4d8-9df9-a475-4ff6d7898456@.
--     Use this format to specify a key in a different account.
--
-- Omit this key if you set @Type@ to @NONE@.
--
-- 'type'', 'putEncryptionConfig_type' - The type of encryption. Set to @KMS@ to use your own key for encryption.
-- Set to @NONE@ for default encryption.
newPutEncryptionConfig ::
  -- | 'type''
  EncryptionType ->
  PutEncryptionConfig
newPutEncryptionConfig :: EncryptionType -> PutEncryptionConfig
newPutEncryptionConfig EncryptionType
pType_ =
  PutEncryptionConfig'
    { $sel:keyId:PutEncryptionConfig' :: Maybe Text
keyId = forall a. Maybe a
Prelude.Nothing,
      $sel:type':PutEncryptionConfig' :: EncryptionType
type' = EncryptionType
pType_
    }

-- | An Amazon Web Services KMS key in one of the following formats:
--
-- -   __Alias__ - The name of the key. For example, @alias\/MyKey@.
--
-- -   __Key ID__ - The KMS key ID of the key. For example,
--     @ae4aa6d49-a4d8-9df9-a475-4ff6d7898456@. Amazon Web Services X-Ray
--     does not support asymmetric KMS keys.
--
-- -   __ARN__ - The full Amazon Resource Name of the key ID or alias. For
--     example,
--     @arn:aws:kms:us-east-2:123456789012:key\/ae4aa6d49-a4d8-9df9-a475-4ff6d7898456@.
--     Use this format to specify a key in a different account.
--
-- Omit this key if you set @Type@ to @NONE@.
putEncryptionConfig_keyId :: Lens.Lens' PutEncryptionConfig (Prelude.Maybe Prelude.Text)
putEncryptionConfig_keyId :: Lens' PutEncryptionConfig (Maybe Text)
putEncryptionConfig_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEncryptionConfig' {Maybe Text
keyId :: Maybe Text
$sel:keyId:PutEncryptionConfig' :: PutEncryptionConfig -> Maybe Text
keyId} -> Maybe Text
keyId) (\s :: PutEncryptionConfig
s@PutEncryptionConfig' {} Maybe Text
a -> PutEncryptionConfig
s {$sel:keyId:PutEncryptionConfig' :: Maybe Text
keyId = Maybe Text
a} :: PutEncryptionConfig)

-- | The type of encryption. Set to @KMS@ to use your own key for encryption.
-- Set to @NONE@ for default encryption.
putEncryptionConfig_type :: Lens.Lens' PutEncryptionConfig EncryptionType
putEncryptionConfig_type :: Lens' PutEncryptionConfig EncryptionType
putEncryptionConfig_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEncryptionConfig' {EncryptionType
type' :: EncryptionType
$sel:type':PutEncryptionConfig' :: PutEncryptionConfig -> EncryptionType
type'} -> EncryptionType
type') (\s :: PutEncryptionConfig
s@PutEncryptionConfig' {} EncryptionType
a -> PutEncryptionConfig
s {$sel:type':PutEncryptionConfig' :: EncryptionType
type' = EncryptionType
a} :: PutEncryptionConfig)

instance Core.AWSRequest PutEncryptionConfig where
  type
    AWSResponse PutEncryptionConfig =
      PutEncryptionConfigResponse
  request :: (Service -> Service)
-> PutEncryptionConfig -> Request PutEncryptionConfig
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 PutEncryptionConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutEncryptionConfig)))
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 EncryptionConfig -> Int -> PutEncryptionConfigResponse
PutEncryptionConfigResponse'
            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
"EncryptionConfig")
            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 PutEncryptionConfig where
  hashWithSalt :: Int -> PutEncryptionConfig -> Int
hashWithSalt Int
_salt PutEncryptionConfig' {Maybe Text
EncryptionType
type' :: EncryptionType
keyId :: Maybe Text
$sel:type':PutEncryptionConfig' :: PutEncryptionConfig -> EncryptionType
$sel:keyId:PutEncryptionConfig' :: PutEncryptionConfig -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
keyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` EncryptionType
type'

instance Prelude.NFData PutEncryptionConfig where
  rnf :: PutEncryptionConfig -> ()
rnf PutEncryptionConfig' {Maybe Text
EncryptionType
type' :: EncryptionType
keyId :: Maybe Text
$sel:type':PutEncryptionConfig' :: PutEncryptionConfig -> EncryptionType
$sel:keyId:PutEncryptionConfig' :: PutEncryptionConfig -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
keyId seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf EncryptionType
type'

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

instance Data.ToJSON PutEncryptionConfig where
  toJSON :: PutEncryptionConfig -> Value
toJSON PutEncryptionConfig' {Maybe Text
EncryptionType
type' :: EncryptionType
keyId :: Maybe Text
$sel:type':PutEncryptionConfig' :: PutEncryptionConfig -> EncryptionType
$sel:keyId:PutEncryptionConfig' :: PutEncryptionConfig -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"KeyId" 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
keyId,
            forall a. a -> Maybe a
Prelude.Just (Key
"Type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= EncryptionType
type')
          ]
      )

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

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

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

-- |
-- Create a value of 'PutEncryptionConfigResponse' 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:
--
-- 'encryptionConfig', 'putEncryptionConfigResponse_encryptionConfig' - The new encryption configuration.
--
-- 'httpStatus', 'putEncryptionConfigResponse_httpStatus' - The response's http status code.
newPutEncryptionConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutEncryptionConfigResponse
newPutEncryptionConfigResponse :: Int -> PutEncryptionConfigResponse
newPutEncryptionConfigResponse Int
pHttpStatus_ =
  PutEncryptionConfigResponse'
    { $sel:encryptionConfig:PutEncryptionConfigResponse' :: Maybe EncryptionConfig
encryptionConfig =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutEncryptionConfigResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The new encryption configuration.
putEncryptionConfigResponse_encryptionConfig :: Lens.Lens' PutEncryptionConfigResponse (Prelude.Maybe EncryptionConfig)
putEncryptionConfigResponse_encryptionConfig :: Lens' PutEncryptionConfigResponse (Maybe EncryptionConfig)
putEncryptionConfigResponse_encryptionConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEncryptionConfigResponse' {Maybe EncryptionConfig
encryptionConfig :: Maybe EncryptionConfig
$sel:encryptionConfig:PutEncryptionConfigResponse' :: PutEncryptionConfigResponse -> Maybe EncryptionConfig
encryptionConfig} -> Maybe EncryptionConfig
encryptionConfig) (\s :: PutEncryptionConfigResponse
s@PutEncryptionConfigResponse' {} Maybe EncryptionConfig
a -> PutEncryptionConfigResponse
s {$sel:encryptionConfig:PutEncryptionConfigResponse' :: Maybe EncryptionConfig
encryptionConfig = Maybe EncryptionConfig
a} :: PutEncryptionConfigResponse)

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

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