{-# 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.Kinesis.StopStreamEncryption
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disables server-side encryption for a specified stream.
--
-- When invoking this API, it is recommended you use the @StreamARN@ input
-- parameter rather than the @StreamName@ input parameter.
--
-- Stopping encryption is an asynchronous operation. Upon receiving the
-- request, Kinesis Data Streams returns immediately and sets the status of
-- the stream to @UPDATING@. After the update is complete, Kinesis Data
-- Streams sets the status of the stream back to @ACTIVE@. Stopping
-- encryption normally takes a few seconds to complete, but it can take
-- minutes. You can continue to read and write data to your stream while
-- its status is @UPDATING@. Once the status of the stream is @ACTIVE@,
-- records written to the stream are no longer encrypted by Kinesis Data
-- Streams.
--
-- API Limits: You can successfully disable server-side encryption 25 times
-- in a rolling 24-hour period.
--
-- Note: It can take up to 5 seconds after the stream is in an @ACTIVE@
-- status before all records written to the stream are no longer subject to
-- encryption. After you disabled encryption, you can verify that
-- encryption is not applied by inspecting the API response from
-- @PutRecord@ or @PutRecords@.
module Amazonka.Kinesis.StopStreamEncryption
  ( -- * Creating a Request
    StopStreamEncryption (..),
    newStopStreamEncryption,

    -- * Request Lenses
    stopStreamEncryption_streamARN,
    stopStreamEncryption_streamName,
    stopStreamEncryption_encryptionType,
    stopStreamEncryption_keyId,

    -- * Destructuring the Response
    StopStreamEncryptionResponse (..),
    newStopStreamEncryptionResponse,
  )
where

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

-- | /See:/ 'newStopStreamEncryption' smart constructor.
data StopStreamEncryption = StopStreamEncryption'
  { -- | The ARN of the stream.
    StopStreamEncryption -> Maybe Text
streamARN :: Prelude.Maybe Prelude.Text,
    -- | The name of the stream on which to stop encrypting records.
    StopStreamEncryption -> Maybe Text
streamName :: Prelude.Maybe Prelude.Text,
    -- | The encryption type. The only valid value is @KMS@.
    StopStreamEncryption -> EncryptionType
encryptionType :: EncryptionType,
    -- | The GUID for the customer-managed Amazon Web Services KMS key to use for
    -- encryption. This value can be a globally unique identifier, a fully
    -- specified Amazon Resource Name (ARN) to either an alias or a key, or an
    -- alias name prefixed by \"alias\/\".You can also use a master key owned
    -- by Kinesis Data Streams by specifying the alias @aws\/kinesis@.
    --
    -- -   Key ARN example:
    --     @arn:aws:kms:us-east-1:123456789012:key\/12345678-1234-1234-1234-123456789012@
    --
    -- -   Alias ARN example:
    --     @arn:aws:kms:us-east-1:123456789012:alias\/MyAliasName@
    --
    -- -   Globally unique key ID example:
    --     @12345678-1234-1234-1234-123456789012@
    --
    -- -   Alias name example: @alias\/MyAliasName@
    --
    -- -   Master key owned by Kinesis Data Streams: @alias\/aws\/kinesis@
    StopStreamEncryption -> Text
keyId :: Prelude.Text
  }
  deriving (StopStreamEncryption -> StopStreamEncryption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopStreamEncryption -> StopStreamEncryption -> Bool
$c/= :: StopStreamEncryption -> StopStreamEncryption -> Bool
== :: StopStreamEncryption -> StopStreamEncryption -> Bool
$c== :: StopStreamEncryption -> StopStreamEncryption -> Bool
Prelude.Eq, ReadPrec [StopStreamEncryption]
ReadPrec StopStreamEncryption
Int -> ReadS StopStreamEncryption
ReadS [StopStreamEncryption]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopStreamEncryption]
$creadListPrec :: ReadPrec [StopStreamEncryption]
readPrec :: ReadPrec StopStreamEncryption
$creadPrec :: ReadPrec StopStreamEncryption
readList :: ReadS [StopStreamEncryption]
$creadList :: ReadS [StopStreamEncryption]
readsPrec :: Int -> ReadS StopStreamEncryption
$creadsPrec :: Int -> ReadS StopStreamEncryption
Prelude.Read, Int -> StopStreamEncryption -> ShowS
[StopStreamEncryption] -> ShowS
StopStreamEncryption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopStreamEncryption] -> ShowS
$cshowList :: [StopStreamEncryption] -> ShowS
show :: StopStreamEncryption -> String
$cshow :: StopStreamEncryption -> String
showsPrec :: Int -> StopStreamEncryption -> ShowS
$cshowsPrec :: Int -> StopStreamEncryption -> ShowS
Prelude.Show, forall x. Rep StopStreamEncryption x -> StopStreamEncryption
forall x. StopStreamEncryption -> Rep StopStreamEncryption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopStreamEncryption x -> StopStreamEncryption
$cfrom :: forall x. StopStreamEncryption -> Rep StopStreamEncryption x
Prelude.Generic)

-- |
-- Create a value of 'StopStreamEncryption' 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:
--
-- 'streamARN', 'stopStreamEncryption_streamARN' - The ARN of the stream.
--
-- 'streamName', 'stopStreamEncryption_streamName' - The name of the stream on which to stop encrypting records.
--
-- 'encryptionType', 'stopStreamEncryption_encryptionType' - The encryption type. The only valid value is @KMS@.
--
-- 'keyId', 'stopStreamEncryption_keyId' - The GUID for the customer-managed Amazon Web Services KMS key to use for
-- encryption. This value can be a globally unique identifier, a fully
-- specified Amazon Resource Name (ARN) to either an alias or a key, or an
-- alias name prefixed by \"alias\/\".You can also use a master key owned
-- by Kinesis Data Streams by specifying the alias @aws\/kinesis@.
--
-- -   Key ARN example:
--     @arn:aws:kms:us-east-1:123456789012:key\/12345678-1234-1234-1234-123456789012@
--
-- -   Alias ARN example:
--     @arn:aws:kms:us-east-1:123456789012:alias\/MyAliasName@
--
-- -   Globally unique key ID example:
--     @12345678-1234-1234-1234-123456789012@
--
-- -   Alias name example: @alias\/MyAliasName@
--
-- -   Master key owned by Kinesis Data Streams: @alias\/aws\/kinesis@
newStopStreamEncryption ::
  -- | 'encryptionType'
  EncryptionType ->
  -- | 'keyId'
  Prelude.Text ->
  StopStreamEncryption
newStopStreamEncryption :: EncryptionType -> Text -> StopStreamEncryption
newStopStreamEncryption EncryptionType
pEncryptionType_ Text
pKeyId_ =
  StopStreamEncryption'
    { $sel:streamARN:StopStreamEncryption' :: Maybe Text
streamARN = forall a. Maybe a
Prelude.Nothing,
      $sel:streamName:StopStreamEncryption' :: Maybe Text
streamName = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionType:StopStreamEncryption' :: EncryptionType
encryptionType = EncryptionType
pEncryptionType_,
      $sel:keyId:StopStreamEncryption' :: Text
keyId = Text
pKeyId_
    }

-- | The ARN of the stream.
stopStreamEncryption_streamARN :: Lens.Lens' StopStreamEncryption (Prelude.Maybe Prelude.Text)
stopStreamEncryption_streamARN :: Lens' StopStreamEncryption (Maybe Text)
stopStreamEncryption_streamARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopStreamEncryption' {Maybe Text
streamARN :: Maybe Text
$sel:streamARN:StopStreamEncryption' :: StopStreamEncryption -> Maybe Text
streamARN} -> Maybe Text
streamARN) (\s :: StopStreamEncryption
s@StopStreamEncryption' {} Maybe Text
a -> StopStreamEncryption
s {$sel:streamARN:StopStreamEncryption' :: Maybe Text
streamARN = Maybe Text
a} :: StopStreamEncryption)

-- | The name of the stream on which to stop encrypting records.
stopStreamEncryption_streamName :: Lens.Lens' StopStreamEncryption (Prelude.Maybe Prelude.Text)
stopStreamEncryption_streamName :: Lens' StopStreamEncryption (Maybe Text)
stopStreamEncryption_streamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopStreamEncryption' {Maybe Text
streamName :: Maybe Text
$sel:streamName:StopStreamEncryption' :: StopStreamEncryption -> Maybe Text
streamName} -> Maybe Text
streamName) (\s :: StopStreamEncryption
s@StopStreamEncryption' {} Maybe Text
a -> StopStreamEncryption
s {$sel:streamName:StopStreamEncryption' :: Maybe Text
streamName = Maybe Text
a} :: StopStreamEncryption)

-- | The encryption type. The only valid value is @KMS@.
stopStreamEncryption_encryptionType :: Lens.Lens' StopStreamEncryption EncryptionType
stopStreamEncryption_encryptionType :: Lens' StopStreamEncryption EncryptionType
stopStreamEncryption_encryptionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopStreamEncryption' {EncryptionType
encryptionType :: EncryptionType
$sel:encryptionType:StopStreamEncryption' :: StopStreamEncryption -> EncryptionType
encryptionType} -> EncryptionType
encryptionType) (\s :: StopStreamEncryption
s@StopStreamEncryption' {} EncryptionType
a -> StopStreamEncryption
s {$sel:encryptionType:StopStreamEncryption' :: EncryptionType
encryptionType = EncryptionType
a} :: StopStreamEncryption)

-- | The GUID for the customer-managed Amazon Web Services KMS key to use for
-- encryption. This value can be a globally unique identifier, a fully
-- specified Amazon Resource Name (ARN) to either an alias or a key, or an
-- alias name prefixed by \"alias\/\".You can also use a master key owned
-- by Kinesis Data Streams by specifying the alias @aws\/kinesis@.
--
-- -   Key ARN example:
--     @arn:aws:kms:us-east-1:123456789012:key\/12345678-1234-1234-1234-123456789012@
--
-- -   Alias ARN example:
--     @arn:aws:kms:us-east-1:123456789012:alias\/MyAliasName@
--
-- -   Globally unique key ID example:
--     @12345678-1234-1234-1234-123456789012@
--
-- -   Alias name example: @alias\/MyAliasName@
--
-- -   Master key owned by Kinesis Data Streams: @alias\/aws\/kinesis@
stopStreamEncryption_keyId :: Lens.Lens' StopStreamEncryption Prelude.Text
stopStreamEncryption_keyId :: Lens' StopStreamEncryption Text
stopStreamEncryption_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopStreamEncryption' {Text
keyId :: Text
$sel:keyId:StopStreamEncryption' :: StopStreamEncryption -> Text
keyId} -> Text
keyId) (\s :: StopStreamEncryption
s@StopStreamEncryption' {} Text
a -> StopStreamEncryption
s {$sel:keyId:StopStreamEncryption' :: Text
keyId = Text
a} :: StopStreamEncryption)

instance Core.AWSRequest StopStreamEncryption where
  type
    AWSResponse StopStreamEncryption =
      StopStreamEncryptionResponse
  request :: (Service -> Service)
-> StopStreamEncryption -> Request StopStreamEncryption
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 StopStreamEncryption
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StopStreamEncryption)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull StopStreamEncryptionResponse
StopStreamEncryptionResponse'

instance Prelude.Hashable StopStreamEncryption where
  hashWithSalt :: Int -> StopStreamEncryption -> Int
hashWithSalt Int
_salt StopStreamEncryption' {Maybe Text
Text
EncryptionType
keyId :: Text
encryptionType :: EncryptionType
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:keyId:StopStreamEncryption' :: StopStreamEncryption -> Text
$sel:encryptionType:StopStreamEncryption' :: StopStreamEncryption -> EncryptionType
$sel:streamName:StopStreamEncryption' :: StopStreamEncryption -> Maybe Text
$sel:streamARN:StopStreamEncryption' :: StopStreamEncryption -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
streamARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
streamName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` EncryptionType
encryptionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyId

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

instance Data.ToHeaders StopStreamEncryption where
  toHeaders :: StopStreamEncryption -> [Header]
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 -> [Header]
Data.=# ( ByteString
"Kinesis_20131202.StopStreamEncryption" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

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

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

-- | /See:/ 'newStopStreamEncryptionResponse' smart constructor.
data StopStreamEncryptionResponse = StopStreamEncryptionResponse'
  {
  }
  deriving (StopStreamEncryptionResponse
-> StopStreamEncryptionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopStreamEncryptionResponse
-> StopStreamEncryptionResponse -> Bool
$c/= :: StopStreamEncryptionResponse
-> StopStreamEncryptionResponse -> Bool
== :: StopStreamEncryptionResponse
-> StopStreamEncryptionResponse -> Bool
$c== :: StopStreamEncryptionResponse
-> StopStreamEncryptionResponse -> Bool
Prelude.Eq, ReadPrec [StopStreamEncryptionResponse]
ReadPrec StopStreamEncryptionResponse
Int -> ReadS StopStreamEncryptionResponse
ReadS [StopStreamEncryptionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopStreamEncryptionResponse]
$creadListPrec :: ReadPrec [StopStreamEncryptionResponse]
readPrec :: ReadPrec StopStreamEncryptionResponse
$creadPrec :: ReadPrec StopStreamEncryptionResponse
readList :: ReadS [StopStreamEncryptionResponse]
$creadList :: ReadS [StopStreamEncryptionResponse]
readsPrec :: Int -> ReadS StopStreamEncryptionResponse
$creadsPrec :: Int -> ReadS StopStreamEncryptionResponse
Prelude.Read, Int -> StopStreamEncryptionResponse -> ShowS
[StopStreamEncryptionResponse] -> ShowS
StopStreamEncryptionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopStreamEncryptionResponse] -> ShowS
$cshowList :: [StopStreamEncryptionResponse] -> ShowS
show :: StopStreamEncryptionResponse -> String
$cshow :: StopStreamEncryptionResponse -> String
showsPrec :: Int -> StopStreamEncryptionResponse -> ShowS
$cshowsPrec :: Int -> StopStreamEncryptionResponse -> ShowS
Prelude.Show, forall x.
Rep StopStreamEncryptionResponse x -> StopStreamEncryptionResponse
forall x.
StopStreamEncryptionResponse -> Rep StopStreamEncryptionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StopStreamEncryptionResponse x -> StopStreamEncryptionResponse
$cfrom :: forall x.
StopStreamEncryptionResponse -> Rep StopStreamEncryptionResponse x
Prelude.Generic)

-- |
-- Create a value of 'StopStreamEncryptionResponse' 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.
newStopStreamEncryptionResponse ::
  StopStreamEncryptionResponse
newStopStreamEncryptionResponse :: StopStreamEncryptionResponse
newStopStreamEncryptionResponse =
  StopStreamEncryptionResponse
StopStreamEncryptionResponse'

instance Prelude.NFData StopStreamEncryptionResponse where
  rnf :: StopStreamEncryptionResponse -> ()
rnf StopStreamEncryptionResponse
_ = ()