{-# 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.StartStreamEncryption
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enables or updates server-side encryption using an Amazon Web Services
-- KMS key for a specified stream.
--
-- Starting 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@. Updating or
-- applying 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@, encryption begins for records written to the stream.
--
-- API Limits: You can successfully apply a new Amazon Web Services KMS key
-- for 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 encrypted. After you
-- enable encryption, you can verify that encryption is applied by
-- inspecting the API response from @PutRecord@ or @PutRecords@.
--
-- When invoking this API, it is recommended you use the @StreamARN@ input
-- parameter rather than the @StreamName@ input parameter.
module Amazonka.Kinesis.StartStreamEncryption
  ( -- * Creating a Request
    StartStreamEncryption (..),
    newStartStreamEncryption,

    -- * Request Lenses
    startStreamEncryption_streamARN,
    startStreamEncryption_streamName,
    startStreamEncryption_encryptionType,
    startStreamEncryption_keyId,

    -- * Destructuring the Response
    StartStreamEncryptionResponse (..),
    newStartStreamEncryptionResponse,
  )
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:/ 'newStartStreamEncryption' smart constructor.
data StartStreamEncryption = StartStreamEncryption'
  { -- | The ARN of the stream.
    StartStreamEncryption -> Maybe Text
streamARN :: Prelude.Maybe Prelude.Text,
    -- | The name of the stream for which to start encrypting records.
    StartStreamEncryption -> Maybe Text
streamName :: Prelude.Maybe Prelude.Text,
    -- | The encryption type to use. The only valid value is @KMS@.
    StartStreamEncryption -> 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@
    StartStreamEncryption -> Text
keyId :: Prelude.Text
  }
  deriving (StartStreamEncryption -> StartStreamEncryption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartStreamEncryption -> StartStreamEncryption -> Bool
$c/= :: StartStreamEncryption -> StartStreamEncryption -> Bool
== :: StartStreamEncryption -> StartStreamEncryption -> Bool
$c== :: StartStreamEncryption -> StartStreamEncryption -> Bool
Prelude.Eq, ReadPrec [StartStreamEncryption]
ReadPrec StartStreamEncryption
Int -> ReadS StartStreamEncryption
ReadS [StartStreamEncryption]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartStreamEncryption]
$creadListPrec :: ReadPrec [StartStreamEncryption]
readPrec :: ReadPrec StartStreamEncryption
$creadPrec :: ReadPrec StartStreamEncryption
readList :: ReadS [StartStreamEncryption]
$creadList :: ReadS [StartStreamEncryption]
readsPrec :: Int -> ReadS StartStreamEncryption
$creadsPrec :: Int -> ReadS StartStreamEncryption
Prelude.Read, Int -> StartStreamEncryption -> ShowS
[StartStreamEncryption] -> ShowS
StartStreamEncryption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartStreamEncryption] -> ShowS
$cshowList :: [StartStreamEncryption] -> ShowS
show :: StartStreamEncryption -> String
$cshow :: StartStreamEncryption -> String
showsPrec :: Int -> StartStreamEncryption -> ShowS
$cshowsPrec :: Int -> StartStreamEncryption -> ShowS
Prelude.Show, forall x. Rep StartStreamEncryption x -> StartStreamEncryption
forall x. StartStreamEncryption -> Rep StartStreamEncryption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartStreamEncryption x -> StartStreamEncryption
$cfrom :: forall x. StartStreamEncryption -> Rep StartStreamEncryption x
Prelude.Generic)

-- |
-- Create a value of 'StartStreamEncryption' 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', 'startStreamEncryption_streamARN' - The ARN of the stream.
--
-- 'streamName', 'startStreamEncryption_streamName' - The name of the stream for which to start encrypting records.
--
-- 'encryptionType', 'startStreamEncryption_encryptionType' - The encryption type to use. The only valid value is @KMS@.
--
-- 'keyId', 'startStreamEncryption_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@
newStartStreamEncryption ::
  -- | 'encryptionType'
  EncryptionType ->
  -- | 'keyId'
  Prelude.Text ->
  StartStreamEncryption
newStartStreamEncryption :: EncryptionType -> Text -> StartStreamEncryption
newStartStreamEncryption EncryptionType
pEncryptionType_ Text
pKeyId_ =
  StartStreamEncryption'
    { $sel:streamARN:StartStreamEncryption' :: Maybe Text
streamARN = forall a. Maybe a
Prelude.Nothing,
      $sel:streamName:StartStreamEncryption' :: Maybe Text
streamName = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionType:StartStreamEncryption' :: EncryptionType
encryptionType = EncryptionType
pEncryptionType_,
      $sel:keyId:StartStreamEncryption' :: Text
keyId = Text
pKeyId_
    }

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

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

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

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

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

instance Prelude.Hashable StartStreamEncryption where
  hashWithSalt :: Int -> StartStreamEncryption -> Int
hashWithSalt Int
_salt StartStreamEncryption' {Maybe Text
Text
EncryptionType
keyId :: Text
encryptionType :: EncryptionType
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:keyId:StartStreamEncryption' :: StartStreamEncryption -> Text
$sel:encryptionType:StartStreamEncryption' :: StartStreamEncryption -> EncryptionType
$sel:streamName:StartStreamEncryption' :: StartStreamEncryption -> Maybe Text
$sel:streamARN:StartStreamEncryption' :: StartStreamEncryption -> 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 StartStreamEncryption where
  rnf :: StartStreamEncryption -> ()
rnf StartStreamEncryption' {Maybe Text
Text
EncryptionType
keyId :: Text
encryptionType :: EncryptionType
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:keyId:StartStreamEncryption' :: StartStreamEncryption -> Text
$sel:encryptionType:StartStreamEncryption' :: StartStreamEncryption -> EncryptionType
$sel:streamName:StartStreamEncryption' :: StartStreamEncryption -> Maybe Text
$sel:streamARN:StartStreamEncryption' :: StartStreamEncryption -> 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 StartStreamEncryption where
  toHeaders :: StartStreamEncryption -> [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.StartStreamEncryption" ::
                          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 StartStreamEncryption where
  toJSON :: StartStreamEncryption -> Value
toJSON StartStreamEncryption' {Maybe Text
Text
EncryptionType
keyId :: Text
encryptionType :: EncryptionType
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:keyId:StartStreamEncryption' :: StartStreamEncryption -> Text
$sel:encryptionType:StartStreamEncryption' :: StartStreamEncryption -> EncryptionType
$sel:streamName:StartStreamEncryption' :: StartStreamEncryption -> Maybe Text
$sel:streamARN:StartStreamEncryption' :: StartStreamEncryption -> 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 StartStreamEncryption where
  toPath :: StartStreamEncryption -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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