{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.KinesisAnalytics.Types.InputUpdate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.KinesisAnalytics.Types.InputUpdate where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.KinesisAnalytics.Types.InputParallelismUpdate
import Amazonka.KinesisAnalytics.Types.InputProcessingConfigurationUpdate
import Amazonka.KinesisAnalytics.Types.InputSchemaUpdate
import Amazonka.KinesisAnalytics.Types.KinesisFirehoseInputUpdate
import Amazonka.KinesisAnalytics.Types.KinesisStreamsInputUpdate
import qualified Amazonka.Prelude as Prelude

-- | Describes updates to a specific input configuration (identified by the
-- @InputId@ of an application).
--
-- /See:/ 'newInputUpdate' smart constructor.
data InputUpdate = InputUpdate'
  { -- | Describes the parallelism updates (the number in-application streams
    -- Amazon Kinesis Analytics creates for the specific streaming source).
    InputUpdate -> Maybe InputParallelismUpdate
inputParallelismUpdate :: Prelude.Maybe InputParallelismUpdate,
    -- | Describes updates for an input processing configuration.
    InputUpdate -> Maybe InputProcessingConfigurationUpdate
inputProcessingConfigurationUpdate :: Prelude.Maybe InputProcessingConfigurationUpdate,
    -- | Describes the data format on the streaming source, and how record
    -- elements on the streaming source map to columns of the in-application
    -- stream that is created.
    InputUpdate -> Maybe InputSchemaUpdate
inputSchemaUpdate :: Prelude.Maybe InputSchemaUpdate,
    -- | If an Amazon Kinesis Firehose delivery stream is the streaming source to
    -- be updated, provides an updated stream ARN and IAM role ARN.
    InputUpdate -> Maybe KinesisFirehoseInputUpdate
kinesisFirehoseInputUpdate :: Prelude.Maybe KinesisFirehoseInputUpdate,
    -- | If an Amazon Kinesis stream is the streaming source to be updated,
    -- provides an updated stream Amazon Resource Name (ARN) and IAM role ARN.
    InputUpdate -> Maybe KinesisStreamsInputUpdate
kinesisStreamsInputUpdate :: Prelude.Maybe KinesisStreamsInputUpdate,
    -- | Name prefix for in-application streams that Amazon Kinesis Analytics
    -- creates for the specific streaming source.
    InputUpdate -> Maybe Text
namePrefixUpdate :: Prelude.Maybe Prelude.Text,
    -- | Input ID of the application input to be updated.
    InputUpdate -> Text
inputId :: Prelude.Text
  }
  deriving (InputUpdate -> InputUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputUpdate -> InputUpdate -> Bool
$c/= :: InputUpdate -> InputUpdate -> Bool
== :: InputUpdate -> InputUpdate -> Bool
$c== :: InputUpdate -> InputUpdate -> Bool
Prelude.Eq, ReadPrec [InputUpdate]
ReadPrec InputUpdate
Int -> ReadS InputUpdate
ReadS [InputUpdate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InputUpdate]
$creadListPrec :: ReadPrec [InputUpdate]
readPrec :: ReadPrec InputUpdate
$creadPrec :: ReadPrec InputUpdate
readList :: ReadS [InputUpdate]
$creadList :: ReadS [InputUpdate]
readsPrec :: Int -> ReadS InputUpdate
$creadsPrec :: Int -> ReadS InputUpdate
Prelude.Read, Int -> InputUpdate -> ShowS
[InputUpdate] -> ShowS
InputUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputUpdate] -> ShowS
$cshowList :: [InputUpdate] -> ShowS
show :: InputUpdate -> String
$cshow :: InputUpdate -> String
showsPrec :: Int -> InputUpdate -> ShowS
$cshowsPrec :: Int -> InputUpdate -> ShowS
Prelude.Show, forall x. Rep InputUpdate x -> InputUpdate
forall x. InputUpdate -> Rep InputUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InputUpdate x -> InputUpdate
$cfrom :: forall x. InputUpdate -> Rep InputUpdate x
Prelude.Generic)

-- |
-- Create a value of 'InputUpdate' 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:
--
-- 'inputParallelismUpdate', 'inputUpdate_inputParallelismUpdate' - Describes the parallelism updates (the number in-application streams
-- Amazon Kinesis Analytics creates for the specific streaming source).
--
-- 'inputProcessingConfigurationUpdate', 'inputUpdate_inputProcessingConfigurationUpdate' - Describes updates for an input processing configuration.
--
-- 'inputSchemaUpdate', 'inputUpdate_inputSchemaUpdate' - Describes the data format on the streaming source, and how record
-- elements on the streaming source map to columns of the in-application
-- stream that is created.
--
-- 'kinesisFirehoseInputUpdate', 'inputUpdate_kinesisFirehoseInputUpdate' - If an Amazon Kinesis Firehose delivery stream is the streaming source to
-- be updated, provides an updated stream ARN and IAM role ARN.
--
-- 'kinesisStreamsInputUpdate', 'inputUpdate_kinesisStreamsInputUpdate' - If an Amazon Kinesis stream is the streaming source to be updated,
-- provides an updated stream Amazon Resource Name (ARN) and IAM role ARN.
--
-- 'namePrefixUpdate', 'inputUpdate_namePrefixUpdate' - Name prefix for in-application streams that Amazon Kinesis Analytics
-- creates for the specific streaming source.
--
-- 'inputId', 'inputUpdate_inputId' - Input ID of the application input to be updated.
newInputUpdate ::
  -- | 'inputId'
  Prelude.Text ->
  InputUpdate
newInputUpdate :: Text -> InputUpdate
newInputUpdate Text
pInputId_ =
  InputUpdate'
    { $sel:inputParallelismUpdate:InputUpdate' :: Maybe InputParallelismUpdate
inputParallelismUpdate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:inputProcessingConfigurationUpdate:InputUpdate' :: Maybe InputProcessingConfigurationUpdate
inputProcessingConfigurationUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:inputSchemaUpdate:InputUpdate' :: Maybe InputSchemaUpdate
inputSchemaUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:kinesisFirehoseInputUpdate:InputUpdate' :: Maybe KinesisFirehoseInputUpdate
kinesisFirehoseInputUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:kinesisStreamsInputUpdate:InputUpdate' :: Maybe KinesisStreamsInputUpdate
kinesisStreamsInputUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:namePrefixUpdate:InputUpdate' :: Maybe Text
namePrefixUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:inputId:InputUpdate' :: Text
inputId = Text
pInputId_
    }

-- | Describes the parallelism updates (the number in-application streams
-- Amazon Kinesis Analytics creates for the specific streaming source).
inputUpdate_inputParallelismUpdate :: Lens.Lens' InputUpdate (Prelude.Maybe InputParallelismUpdate)
inputUpdate_inputParallelismUpdate :: Lens' InputUpdate (Maybe InputParallelismUpdate)
inputUpdate_inputParallelismUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputUpdate' {Maybe InputParallelismUpdate
inputParallelismUpdate :: Maybe InputParallelismUpdate
$sel:inputParallelismUpdate:InputUpdate' :: InputUpdate -> Maybe InputParallelismUpdate
inputParallelismUpdate} -> Maybe InputParallelismUpdate
inputParallelismUpdate) (\s :: InputUpdate
s@InputUpdate' {} Maybe InputParallelismUpdate
a -> InputUpdate
s {$sel:inputParallelismUpdate:InputUpdate' :: Maybe InputParallelismUpdate
inputParallelismUpdate = Maybe InputParallelismUpdate
a} :: InputUpdate)

-- | Describes updates for an input processing configuration.
inputUpdate_inputProcessingConfigurationUpdate :: Lens.Lens' InputUpdate (Prelude.Maybe InputProcessingConfigurationUpdate)
inputUpdate_inputProcessingConfigurationUpdate :: Lens' InputUpdate (Maybe InputProcessingConfigurationUpdate)
inputUpdate_inputProcessingConfigurationUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputUpdate' {Maybe InputProcessingConfigurationUpdate
inputProcessingConfigurationUpdate :: Maybe InputProcessingConfigurationUpdate
$sel:inputProcessingConfigurationUpdate:InputUpdate' :: InputUpdate -> Maybe InputProcessingConfigurationUpdate
inputProcessingConfigurationUpdate} -> Maybe InputProcessingConfigurationUpdate
inputProcessingConfigurationUpdate) (\s :: InputUpdate
s@InputUpdate' {} Maybe InputProcessingConfigurationUpdate
a -> InputUpdate
s {$sel:inputProcessingConfigurationUpdate:InputUpdate' :: Maybe InputProcessingConfigurationUpdate
inputProcessingConfigurationUpdate = Maybe InputProcessingConfigurationUpdate
a} :: InputUpdate)

-- | Describes the data format on the streaming source, and how record
-- elements on the streaming source map to columns of the in-application
-- stream that is created.
inputUpdate_inputSchemaUpdate :: Lens.Lens' InputUpdate (Prelude.Maybe InputSchemaUpdate)
inputUpdate_inputSchemaUpdate :: Lens' InputUpdate (Maybe InputSchemaUpdate)
inputUpdate_inputSchemaUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputUpdate' {Maybe InputSchemaUpdate
inputSchemaUpdate :: Maybe InputSchemaUpdate
$sel:inputSchemaUpdate:InputUpdate' :: InputUpdate -> Maybe InputSchemaUpdate
inputSchemaUpdate} -> Maybe InputSchemaUpdate
inputSchemaUpdate) (\s :: InputUpdate
s@InputUpdate' {} Maybe InputSchemaUpdate
a -> InputUpdate
s {$sel:inputSchemaUpdate:InputUpdate' :: Maybe InputSchemaUpdate
inputSchemaUpdate = Maybe InputSchemaUpdate
a} :: InputUpdate)

-- | If an Amazon Kinesis Firehose delivery stream is the streaming source to
-- be updated, provides an updated stream ARN and IAM role ARN.
inputUpdate_kinesisFirehoseInputUpdate :: Lens.Lens' InputUpdate (Prelude.Maybe KinesisFirehoseInputUpdate)
inputUpdate_kinesisFirehoseInputUpdate :: Lens' InputUpdate (Maybe KinesisFirehoseInputUpdate)
inputUpdate_kinesisFirehoseInputUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputUpdate' {Maybe KinesisFirehoseInputUpdate
kinesisFirehoseInputUpdate :: Maybe KinesisFirehoseInputUpdate
$sel:kinesisFirehoseInputUpdate:InputUpdate' :: InputUpdate -> Maybe KinesisFirehoseInputUpdate
kinesisFirehoseInputUpdate} -> Maybe KinesisFirehoseInputUpdate
kinesisFirehoseInputUpdate) (\s :: InputUpdate
s@InputUpdate' {} Maybe KinesisFirehoseInputUpdate
a -> InputUpdate
s {$sel:kinesisFirehoseInputUpdate:InputUpdate' :: Maybe KinesisFirehoseInputUpdate
kinesisFirehoseInputUpdate = Maybe KinesisFirehoseInputUpdate
a} :: InputUpdate)

-- | If an Amazon Kinesis stream is the streaming source to be updated,
-- provides an updated stream Amazon Resource Name (ARN) and IAM role ARN.
inputUpdate_kinesisStreamsInputUpdate :: Lens.Lens' InputUpdate (Prelude.Maybe KinesisStreamsInputUpdate)
inputUpdate_kinesisStreamsInputUpdate :: Lens' InputUpdate (Maybe KinesisStreamsInputUpdate)
inputUpdate_kinesisStreamsInputUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputUpdate' {Maybe KinesisStreamsInputUpdate
kinesisStreamsInputUpdate :: Maybe KinesisStreamsInputUpdate
$sel:kinesisStreamsInputUpdate:InputUpdate' :: InputUpdate -> Maybe KinesisStreamsInputUpdate
kinesisStreamsInputUpdate} -> Maybe KinesisStreamsInputUpdate
kinesisStreamsInputUpdate) (\s :: InputUpdate
s@InputUpdate' {} Maybe KinesisStreamsInputUpdate
a -> InputUpdate
s {$sel:kinesisStreamsInputUpdate:InputUpdate' :: Maybe KinesisStreamsInputUpdate
kinesisStreamsInputUpdate = Maybe KinesisStreamsInputUpdate
a} :: InputUpdate)

-- | Name prefix for in-application streams that Amazon Kinesis Analytics
-- creates for the specific streaming source.
inputUpdate_namePrefixUpdate :: Lens.Lens' InputUpdate (Prelude.Maybe Prelude.Text)
inputUpdate_namePrefixUpdate :: Lens' InputUpdate (Maybe Text)
inputUpdate_namePrefixUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputUpdate' {Maybe Text
namePrefixUpdate :: Maybe Text
$sel:namePrefixUpdate:InputUpdate' :: InputUpdate -> Maybe Text
namePrefixUpdate} -> Maybe Text
namePrefixUpdate) (\s :: InputUpdate
s@InputUpdate' {} Maybe Text
a -> InputUpdate
s {$sel:namePrefixUpdate:InputUpdate' :: Maybe Text
namePrefixUpdate = Maybe Text
a} :: InputUpdate)

-- | Input ID of the application input to be updated.
inputUpdate_inputId :: Lens.Lens' InputUpdate Prelude.Text
inputUpdate_inputId :: Lens' InputUpdate Text
inputUpdate_inputId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputUpdate' {Text
inputId :: Text
$sel:inputId:InputUpdate' :: InputUpdate -> Text
inputId} -> Text
inputId) (\s :: InputUpdate
s@InputUpdate' {} Text
a -> InputUpdate
s {$sel:inputId:InputUpdate' :: Text
inputId = Text
a} :: InputUpdate)

instance Prelude.Hashable InputUpdate where
  hashWithSalt :: Int -> InputUpdate -> Int
hashWithSalt Int
_salt InputUpdate' {Maybe Text
Maybe InputParallelismUpdate
Maybe InputProcessingConfigurationUpdate
Maybe KinesisFirehoseInputUpdate
Maybe KinesisStreamsInputUpdate
Maybe InputSchemaUpdate
Text
inputId :: Text
namePrefixUpdate :: Maybe Text
kinesisStreamsInputUpdate :: Maybe KinesisStreamsInputUpdate
kinesisFirehoseInputUpdate :: Maybe KinesisFirehoseInputUpdate
inputSchemaUpdate :: Maybe InputSchemaUpdate
inputProcessingConfigurationUpdate :: Maybe InputProcessingConfigurationUpdate
inputParallelismUpdate :: Maybe InputParallelismUpdate
$sel:inputId:InputUpdate' :: InputUpdate -> Text
$sel:namePrefixUpdate:InputUpdate' :: InputUpdate -> Maybe Text
$sel:kinesisStreamsInputUpdate:InputUpdate' :: InputUpdate -> Maybe KinesisStreamsInputUpdate
$sel:kinesisFirehoseInputUpdate:InputUpdate' :: InputUpdate -> Maybe KinesisFirehoseInputUpdate
$sel:inputSchemaUpdate:InputUpdate' :: InputUpdate -> Maybe InputSchemaUpdate
$sel:inputProcessingConfigurationUpdate:InputUpdate' :: InputUpdate -> Maybe InputProcessingConfigurationUpdate
$sel:inputParallelismUpdate:InputUpdate' :: InputUpdate -> Maybe InputParallelismUpdate
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputParallelismUpdate
inputParallelismUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputProcessingConfigurationUpdate
inputProcessingConfigurationUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputSchemaUpdate
inputSchemaUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe KinesisFirehoseInputUpdate
kinesisFirehoseInputUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe KinesisStreamsInputUpdate
kinesisStreamsInputUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
namePrefixUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
inputId

instance Prelude.NFData InputUpdate where
  rnf :: InputUpdate -> ()
rnf InputUpdate' {Maybe Text
Maybe InputParallelismUpdate
Maybe InputProcessingConfigurationUpdate
Maybe KinesisFirehoseInputUpdate
Maybe KinesisStreamsInputUpdate
Maybe InputSchemaUpdate
Text
inputId :: Text
namePrefixUpdate :: Maybe Text
kinesisStreamsInputUpdate :: Maybe KinesisStreamsInputUpdate
kinesisFirehoseInputUpdate :: Maybe KinesisFirehoseInputUpdate
inputSchemaUpdate :: Maybe InputSchemaUpdate
inputProcessingConfigurationUpdate :: Maybe InputProcessingConfigurationUpdate
inputParallelismUpdate :: Maybe InputParallelismUpdate
$sel:inputId:InputUpdate' :: InputUpdate -> Text
$sel:namePrefixUpdate:InputUpdate' :: InputUpdate -> Maybe Text
$sel:kinesisStreamsInputUpdate:InputUpdate' :: InputUpdate -> Maybe KinesisStreamsInputUpdate
$sel:kinesisFirehoseInputUpdate:InputUpdate' :: InputUpdate -> Maybe KinesisFirehoseInputUpdate
$sel:inputSchemaUpdate:InputUpdate' :: InputUpdate -> Maybe InputSchemaUpdate
$sel:inputProcessingConfigurationUpdate:InputUpdate' :: InputUpdate -> Maybe InputProcessingConfigurationUpdate
$sel:inputParallelismUpdate:InputUpdate' :: InputUpdate -> Maybe InputParallelismUpdate
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe InputParallelismUpdate
inputParallelismUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputProcessingConfigurationUpdate
inputProcessingConfigurationUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputSchemaUpdate
inputSchemaUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe KinesisFirehoseInputUpdate
kinesisFirehoseInputUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe KinesisStreamsInputUpdate
kinesisStreamsInputUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
namePrefixUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
inputId

instance Data.ToJSON InputUpdate where
  toJSON :: InputUpdate -> Value
toJSON InputUpdate' {Maybe Text
Maybe InputParallelismUpdate
Maybe InputProcessingConfigurationUpdate
Maybe KinesisFirehoseInputUpdate
Maybe KinesisStreamsInputUpdate
Maybe InputSchemaUpdate
Text
inputId :: Text
namePrefixUpdate :: Maybe Text
kinesisStreamsInputUpdate :: Maybe KinesisStreamsInputUpdate
kinesisFirehoseInputUpdate :: Maybe KinesisFirehoseInputUpdate
inputSchemaUpdate :: Maybe InputSchemaUpdate
inputProcessingConfigurationUpdate :: Maybe InputProcessingConfigurationUpdate
inputParallelismUpdate :: Maybe InputParallelismUpdate
$sel:inputId:InputUpdate' :: InputUpdate -> Text
$sel:namePrefixUpdate:InputUpdate' :: InputUpdate -> Maybe Text
$sel:kinesisStreamsInputUpdate:InputUpdate' :: InputUpdate -> Maybe KinesisStreamsInputUpdate
$sel:kinesisFirehoseInputUpdate:InputUpdate' :: InputUpdate -> Maybe KinesisFirehoseInputUpdate
$sel:inputSchemaUpdate:InputUpdate' :: InputUpdate -> Maybe InputSchemaUpdate
$sel:inputProcessingConfigurationUpdate:InputUpdate' :: InputUpdate -> Maybe InputProcessingConfigurationUpdate
$sel:inputParallelismUpdate:InputUpdate' :: InputUpdate -> Maybe InputParallelismUpdate
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"InputParallelismUpdate" 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 InputParallelismUpdate
inputParallelismUpdate,
            (Key
"InputProcessingConfigurationUpdate" 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 InputProcessingConfigurationUpdate
inputProcessingConfigurationUpdate,
            (Key
"InputSchemaUpdate" 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 InputSchemaUpdate
inputSchemaUpdate,
            (Key
"KinesisFirehoseInputUpdate" 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 KinesisFirehoseInputUpdate
kinesisFirehoseInputUpdate,
            (Key
"KinesisStreamsInputUpdate" 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 KinesisStreamsInputUpdate
kinesisStreamsInputUpdate,
            (Key
"NamePrefixUpdate" 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
namePrefixUpdate,
            forall a. a -> Maybe a
Prelude.Just (Key
"InputId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
inputId)
          ]
      )