{-# 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.AddApplicationOutput
-- 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 an external destination to your Amazon Kinesis Analytics
-- application.
--
-- If you want Amazon Kinesis Analytics to deliver data from an
-- in-application stream within your application to an external destination
-- (such as an Amazon Kinesis stream, an Amazon Kinesis Firehose delivery
-- stream, or an AWS Lambda function), you add the relevant configuration
-- to your application using this operation. You can configure one or more
-- outputs for your application. Each output configuration maps an
-- in-application stream and an external destination.
--
-- You can use one of the output configurations to deliver data from your
-- in-application error stream to an external destination so that you can
-- analyze the errors. For more information, see
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/how-it-works-output.html Understanding Application Output (Destination)>.
--
-- 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.
--
-- For the limits on the number of application inputs and outputs you can
-- configure, see
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/limits.html Limits>.
--
-- This operation requires permissions to perform the
-- @kinesisanalytics:AddApplicationOutput@ action.
module Amazonka.KinesisAnalytics.AddApplicationOutput
  ( -- * Creating a Request
    AddApplicationOutput (..),
    newAddApplicationOutput,

    -- * Request Lenses
    addApplicationOutput_applicationName,
    addApplicationOutput_currentApplicationVersionId,
    addApplicationOutput_output,

    -- * Destructuring the Response
    AddApplicationOutputResponse (..),
    newAddApplicationOutputResponse,

    -- * Response Lenses
    addApplicationOutputResponse_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:/ 'newAddApplicationOutput' smart constructor.
data AddApplicationOutput = AddApplicationOutput'
  { -- | Name of the application to which you want to add the output
    -- configuration.
    AddApplicationOutput -> Text
applicationName :: Prelude.Text,
    -- | Version of the application to which you want to add the output
    -- configuration. You can use the
    -- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/API_DescribeApplication.html DescribeApplication>
    -- operation to get the current application version. If the version
    -- specified is not the current version, the
    -- @ConcurrentModificationException@ is returned.
    AddApplicationOutput -> Natural
currentApplicationVersionId :: Prelude.Natural,
    -- | An array of objects, each describing one output configuration. In the
    -- output configuration, you specify the name of an in-application stream,
    -- a destination (that is, an Amazon Kinesis stream, an Amazon Kinesis
    -- Firehose delivery stream, or an AWS Lambda function), and record the
    -- formation to use when writing to the destination.
    AddApplicationOutput -> Output
output :: Output
  }
  deriving (AddApplicationOutput -> AddApplicationOutput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddApplicationOutput -> AddApplicationOutput -> Bool
$c/= :: AddApplicationOutput -> AddApplicationOutput -> Bool
== :: AddApplicationOutput -> AddApplicationOutput -> Bool
$c== :: AddApplicationOutput -> AddApplicationOutput -> Bool
Prelude.Eq, ReadPrec [AddApplicationOutput]
ReadPrec AddApplicationOutput
Int -> ReadS AddApplicationOutput
ReadS [AddApplicationOutput]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddApplicationOutput]
$creadListPrec :: ReadPrec [AddApplicationOutput]
readPrec :: ReadPrec AddApplicationOutput
$creadPrec :: ReadPrec AddApplicationOutput
readList :: ReadS [AddApplicationOutput]
$creadList :: ReadS [AddApplicationOutput]
readsPrec :: Int -> ReadS AddApplicationOutput
$creadsPrec :: Int -> ReadS AddApplicationOutput
Prelude.Read, Int -> AddApplicationOutput -> ShowS
[AddApplicationOutput] -> ShowS
AddApplicationOutput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddApplicationOutput] -> ShowS
$cshowList :: [AddApplicationOutput] -> ShowS
show :: AddApplicationOutput -> String
$cshow :: AddApplicationOutput -> String
showsPrec :: Int -> AddApplicationOutput -> ShowS
$cshowsPrec :: Int -> AddApplicationOutput -> ShowS
Prelude.Show, forall x. Rep AddApplicationOutput x -> AddApplicationOutput
forall x. AddApplicationOutput -> Rep AddApplicationOutput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddApplicationOutput x -> AddApplicationOutput
$cfrom :: forall x. AddApplicationOutput -> Rep AddApplicationOutput x
Prelude.Generic)

-- |
-- Create a value of 'AddApplicationOutput' 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', 'addApplicationOutput_applicationName' - Name of the application to which you want to add the output
-- configuration.
--
-- 'currentApplicationVersionId', 'addApplicationOutput_currentApplicationVersionId' - Version of the application to which you want to add the output
-- configuration. You can use the
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/API_DescribeApplication.html DescribeApplication>
-- operation to get the current application version. If the version
-- specified is not the current version, the
-- @ConcurrentModificationException@ is returned.
--
-- 'output', 'addApplicationOutput_output' - An array of objects, each describing one output configuration. In the
-- output configuration, you specify the name of an in-application stream,
-- a destination (that is, an Amazon Kinesis stream, an Amazon Kinesis
-- Firehose delivery stream, or an AWS Lambda function), and record the
-- formation to use when writing to the destination.
newAddApplicationOutput ::
  -- | 'applicationName'
  Prelude.Text ->
  -- | 'currentApplicationVersionId'
  Prelude.Natural ->
  -- | 'output'
  Output ->
  AddApplicationOutput
newAddApplicationOutput :: Text -> Natural -> Output -> AddApplicationOutput
newAddApplicationOutput
  Text
pApplicationName_
  Natural
pCurrentApplicationVersionId_
  Output
pOutput_ =
    AddApplicationOutput'
      { $sel:applicationName:AddApplicationOutput' :: Text
applicationName =
          Text
pApplicationName_,
        $sel:currentApplicationVersionId:AddApplicationOutput' :: Natural
currentApplicationVersionId =
          Natural
pCurrentApplicationVersionId_,
        $sel:output:AddApplicationOutput' :: Output
output = Output
pOutput_
      }

-- | Name of the application to which you want to add the output
-- configuration.
addApplicationOutput_applicationName :: Lens.Lens' AddApplicationOutput Prelude.Text
addApplicationOutput_applicationName :: Lens' AddApplicationOutput Text
addApplicationOutput_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddApplicationOutput' {Text
applicationName :: Text
$sel:applicationName:AddApplicationOutput' :: AddApplicationOutput -> Text
applicationName} -> Text
applicationName) (\s :: AddApplicationOutput
s@AddApplicationOutput' {} Text
a -> AddApplicationOutput
s {$sel:applicationName:AddApplicationOutput' :: Text
applicationName = Text
a} :: AddApplicationOutput)

-- | Version of the application to which you want to add the output
-- configuration. You can use the
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/API_DescribeApplication.html DescribeApplication>
-- operation to get the current application version. If the version
-- specified is not the current version, the
-- @ConcurrentModificationException@ is returned.
addApplicationOutput_currentApplicationVersionId :: Lens.Lens' AddApplicationOutput Prelude.Natural
addApplicationOutput_currentApplicationVersionId :: Lens' AddApplicationOutput Natural
addApplicationOutput_currentApplicationVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddApplicationOutput' {Natural
currentApplicationVersionId :: Natural
$sel:currentApplicationVersionId:AddApplicationOutput' :: AddApplicationOutput -> Natural
currentApplicationVersionId} -> Natural
currentApplicationVersionId) (\s :: AddApplicationOutput
s@AddApplicationOutput' {} Natural
a -> AddApplicationOutput
s {$sel:currentApplicationVersionId:AddApplicationOutput' :: Natural
currentApplicationVersionId = Natural
a} :: AddApplicationOutput)

-- | An array of objects, each describing one output configuration. In the
-- output configuration, you specify the name of an in-application stream,
-- a destination (that is, an Amazon Kinesis stream, an Amazon Kinesis
-- Firehose delivery stream, or an AWS Lambda function), and record the
-- formation to use when writing to the destination.
addApplicationOutput_output :: Lens.Lens' AddApplicationOutput Output
addApplicationOutput_output :: Lens' AddApplicationOutput Output
addApplicationOutput_output = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddApplicationOutput' {Output
output :: Output
$sel:output:AddApplicationOutput' :: AddApplicationOutput -> Output
output} -> Output
output) (\s :: AddApplicationOutput
s@AddApplicationOutput' {} Output
a -> AddApplicationOutput
s {$sel:output:AddApplicationOutput' :: Output
output = Output
a} :: AddApplicationOutput)

instance Core.AWSRequest AddApplicationOutput where
  type
    AWSResponse AddApplicationOutput =
      AddApplicationOutputResponse
  request :: (Service -> Service)
-> AddApplicationOutput -> Request AddApplicationOutput
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 AddApplicationOutput
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AddApplicationOutput)))
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 -> AddApplicationOutputResponse
AddApplicationOutputResponse'
            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 AddApplicationOutput where
  hashWithSalt :: Int -> AddApplicationOutput -> Int
hashWithSalt Int
_salt AddApplicationOutput' {Natural
Text
Output
output :: Output
currentApplicationVersionId :: Natural
applicationName :: Text
$sel:output:AddApplicationOutput' :: AddApplicationOutput -> Output
$sel:currentApplicationVersionId:AddApplicationOutput' :: AddApplicationOutput -> Natural
$sel:applicationName:AddApplicationOutput' :: AddApplicationOutput -> 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` Output
output

instance Prelude.NFData AddApplicationOutput where
  rnf :: AddApplicationOutput -> ()
rnf AddApplicationOutput' {Natural
Text
Output
output :: Output
currentApplicationVersionId :: Natural
applicationName :: Text
$sel:output:AddApplicationOutput' :: AddApplicationOutput -> Output
$sel:currentApplicationVersionId:AddApplicationOutput' :: AddApplicationOutput -> Natural
$sel:applicationName:AddApplicationOutput' :: AddApplicationOutput -> 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 Output
output

instance Data.ToHeaders AddApplicationOutput where
  toHeaders :: AddApplicationOutput -> 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.AddApplicationOutput" ::
                          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 AddApplicationOutput where
  toJSON :: AddApplicationOutput -> Value
toJSON AddApplicationOutput' {Natural
Text
Output
output :: Output
currentApplicationVersionId :: Natural
applicationName :: Text
$sel:output:AddApplicationOutput' :: AddApplicationOutput -> Output
$sel:currentApplicationVersionId:AddApplicationOutput' :: AddApplicationOutput -> Natural
$sel:applicationName:AddApplicationOutput' :: AddApplicationOutput -> 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
"Output" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Output
output)
          ]
      )

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

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

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

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

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

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