{-# 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.KinesisAnalytics.AddApplicationInput
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This documentation is for version 1 of the Amazon Kinesis Data Analytics
-- API, which only supports SQL applications. Version 2 of the API supports
-- SQL and Java applications. For more information about version 2, see
-- </kinesisanalytics/latest/apiv2/Welcome.html Amazon Kinesis Data Analytics API V2 Documentation>.
--
-- Adds a streaming source to your Amazon Kinesis application. For
-- conceptual information, see
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/how-it-works-input.html Configuring Application Input>.
--
-- You can add a streaming source either when you create an application or
-- you can use this operation to add a streaming source after you create an
-- application. For more information, see
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/API_CreateApplication.html CreateApplication>.
--
-- Any configuration update, including adding a streaming source using this
-- operation, results in a new version of the application. You can use the
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/API_DescribeApplication.html DescribeApplication>
-- operation to find the current application version.
--
-- This operation requires permissions to perform the
-- @kinesisanalytics:AddApplicationInput@ action.
module Amazonka.KinesisAnalytics.AddApplicationInput
  ( -- * Creating a Request
    AddApplicationInput (..),
    newAddApplicationInput,

    -- * Request Lenses
    addApplicationInput_applicationName,
    addApplicationInput_currentApplicationVersionId,
    addApplicationInput_input,

    -- * Destructuring the Response
    AddApplicationInputResponse (..),
    newAddApplicationInputResponse,

    -- * Response Lenses
    addApplicationInputResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newAddApplicationInput' smart constructor.
data AddApplicationInput = AddApplicationInput'
  { -- | Name of your existing Amazon Kinesis Analytics application to which you
    -- want to add the streaming source.
    AddApplicationInput -> Text
applicationName :: Prelude.Text,
    -- | Current version of your Amazon Kinesis Analytics application. You can
    -- use the
    -- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/API_DescribeApplication.html DescribeApplication>
    -- operation to find the current application version.
    AddApplicationInput -> Natural
currentApplicationVersionId :: Prelude.Natural,
    -- | The
    -- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/API_Input.html Input>
    -- to add.
    AddApplicationInput -> Input
input :: Input
  }
  deriving (AddApplicationInput -> AddApplicationInput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddApplicationInput -> AddApplicationInput -> Bool
$c/= :: AddApplicationInput -> AddApplicationInput -> Bool
== :: AddApplicationInput -> AddApplicationInput -> Bool
$c== :: AddApplicationInput -> AddApplicationInput -> Bool
Prelude.Eq, ReadPrec [AddApplicationInput]
ReadPrec AddApplicationInput
Int -> ReadS AddApplicationInput
ReadS [AddApplicationInput]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddApplicationInput]
$creadListPrec :: ReadPrec [AddApplicationInput]
readPrec :: ReadPrec AddApplicationInput
$creadPrec :: ReadPrec AddApplicationInput
readList :: ReadS [AddApplicationInput]
$creadList :: ReadS [AddApplicationInput]
readsPrec :: Int -> ReadS AddApplicationInput
$creadsPrec :: Int -> ReadS AddApplicationInput
Prelude.Read, Int -> AddApplicationInput -> ShowS
[AddApplicationInput] -> ShowS
AddApplicationInput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddApplicationInput] -> ShowS
$cshowList :: [AddApplicationInput] -> ShowS
show :: AddApplicationInput -> String
$cshow :: AddApplicationInput -> String
showsPrec :: Int -> AddApplicationInput -> ShowS
$cshowsPrec :: Int -> AddApplicationInput -> ShowS
Prelude.Show, forall x. Rep AddApplicationInput x -> AddApplicationInput
forall x. AddApplicationInput -> Rep AddApplicationInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddApplicationInput x -> AddApplicationInput
$cfrom :: forall x. AddApplicationInput -> Rep AddApplicationInput x
Prelude.Generic)

-- |
-- Create a value of 'AddApplicationInput' 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:
--
-- 'applicationName', 'addApplicationInput_applicationName' - Name of your existing Amazon Kinesis Analytics application to which you
-- want to add the streaming source.
--
-- 'currentApplicationVersionId', 'addApplicationInput_currentApplicationVersionId' - Current version of your Amazon Kinesis Analytics application. You can
-- use the
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/API_DescribeApplication.html DescribeApplication>
-- operation to find the current application version.
--
-- 'input', 'addApplicationInput_input' - The
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/API_Input.html Input>
-- to add.
newAddApplicationInput ::
  -- | 'applicationName'
  Prelude.Text ->
  -- | 'currentApplicationVersionId'
  Prelude.Natural ->
  -- | 'input'
  Input ->
  AddApplicationInput
newAddApplicationInput :: Text -> Natural -> Input -> AddApplicationInput
newAddApplicationInput
  Text
pApplicationName_
  Natural
pCurrentApplicationVersionId_
  Input
pInput_ =
    AddApplicationInput'
      { $sel:applicationName:AddApplicationInput' :: Text
applicationName =
          Text
pApplicationName_,
        $sel:currentApplicationVersionId:AddApplicationInput' :: Natural
currentApplicationVersionId =
          Natural
pCurrentApplicationVersionId_,
        $sel:input:AddApplicationInput' :: Input
input = Input
pInput_
      }

-- | Name of your existing Amazon Kinesis Analytics application to which you
-- want to add the streaming source.
addApplicationInput_applicationName :: Lens.Lens' AddApplicationInput Prelude.Text
addApplicationInput_applicationName :: Lens' AddApplicationInput Text
addApplicationInput_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddApplicationInput' {Text
applicationName :: Text
$sel:applicationName:AddApplicationInput' :: AddApplicationInput -> Text
applicationName} -> Text
applicationName) (\s :: AddApplicationInput
s@AddApplicationInput' {} Text
a -> AddApplicationInput
s {$sel:applicationName:AddApplicationInput' :: Text
applicationName = Text
a} :: AddApplicationInput)

-- | Current version of your Amazon Kinesis Analytics application. You can
-- use the
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/API_DescribeApplication.html DescribeApplication>
-- operation to find the current application version.
addApplicationInput_currentApplicationVersionId :: Lens.Lens' AddApplicationInput Prelude.Natural
addApplicationInput_currentApplicationVersionId :: Lens' AddApplicationInput Natural
addApplicationInput_currentApplicationVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddApplicationInput' {Natural
currentApplicationVersionId :: Natural
$sel:currentApplicationVersionId:AddApplicationInput' :: AddApplicationInput -> Natural
currentApplicationVersionId} -> Natural
currentApplicationVersionId) (\s :: AddApplicationInput
s@AddApplicationInput' {} Natural
a -> AddApplicationInput
s {$sel:currentApplicationVersionId:AddApplicationInput' :: Natural
currentApplicationVersionId = Natural
a} :: AddApplicationInput)

-- | The
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/API_Input.html Input>
-- to add.
addApplicationInput_input :: Lens.Lens' AddApplicationInput Input
addApplicationInput_input :: Lens' AddApplicationInput Input
addApplicationInput_input = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddApplicationInput' {Input
input :: Input
$sel:input:AddApplicationInput' :: AddApplicationInput -> Input
input} -> Input
input) (\s :: AddApplicationInput
s@AddApplicationInput' {} Input
a -> AddApplicationInput
s {$sel:input:AddApplicationInput' :: Input
input = Input
a} :: AddApplicationInput)

instance Core.AWSRequest AddApplicationInput where
  type
    AWSResponse AddApplicationInput =
      AddApplicationInputResponse
  request :: (Service -> Service)
-> AddApplicationInput -> Request AddApplicationInput
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 AddApplicationInput
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AddApplicationInput)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AddApplicationInputResponse
AddApplicationInputResponse'
            forall (f :: * -> *) a b. Functor 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 AddApplicationInput where
  hashWithSalt :: Int -> AddApplicationInput -> Int
hashWithSalt Int
_salt AddApplicationInput' {Natural
Text
Input
input :: Input
currentApplicationVersionId :: Natural
applicationName :: Text
$sel:input:AddApplicationInput' :: AddApplicationInput -> Input
$sel:currentApplicationVersionId:AddApplicationInput' :: AddApplicationInput -> Natural
$sel:applicationName:AddApplicationInput' :: AddApplicationInput -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
currentApplicationVersionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Input
input

instance Prelude.NFData AddApplicationInput where
  rnf :: AddApplicationInput -> ()
rnf AddApplicationInput' {Natural
Text
Input
input :: Input
currentApplicationVersionId :: Natural
applicationName :: Text
$sel:input:AddApplicationInput' :: AddApplicationInput -> Input
$sel:currentApplicationVersionId:AddApplicationInput' :: AddApplicationInput -> Natural
$sel:applicationName:AddApplicationInput' :: AddApplicationInput -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
applicationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
currentApplicationVersionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Input
input

instance Data.ToHeaders AddApplicationInput where
  toHeaders :: AddApplicationInput -> 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
"KinesisAnalytics_20150814.AddApplicationInput" ::
                          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 AddApplicationInput where
  toJSON :: AddApplicationInput -> Value
toJSON AddApplicationInput' {Natural
Text
Input
input :: Input
currentApplicationVersionId :: Natural
applicationName :: Text
$sel:input:AddApplicationInput' :: AddApplicationInput -> Input
$sel:currentApplicationVersionId:AddApplicationInput' :: AddApplicationInput -> Natural
$sel:applicationName:AddApplicationInput' :: AddApplicationInput -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"ApplicationName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
applicationName),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"CurrentApplicationVersionId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
currentApplicationVersionId
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"Input" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Input
input)
          ]
      )

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

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

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

-- |
-- Create a value of 'AddApplicationInputResponse' 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:
--
-- 'httpStatus', 'addApplicationInputResponse_httpStatus' - The response's http status code.
newAddApplicationInputResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddApplicationInputResponse
newAddApplicationInputResponse :: Int -> AddApplicationInputResponse
newAddApplicationInputResponse Int
pHttpStatus_ =
  AddApplicationInputResponse'
    { $sel:httpStatus:AddApplicationInputResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData AddApplicationInputResponse where
  rnf :: AddApplicationInputResponse -> ()
rnf AddApplicationInputResponse' {Int
httpStatus :: Int
$sel:httpStatus:AddApplicationInputResponse' :: AddApplicationInputResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus