{-# 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.KinesisAnalyticsV2.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)
--
-- Adds an external destination to your SQL-based Kinesis Data Analytics
-- application.
--
-- If you want Kinesis Data Analytics to deliver data from an
-- in-application stream within your application to an external destination
-- (such as an Kinesis data stream, a Kinesis Data Firehose delivery
-- stream, or an Amazon 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.
--
-- Any configuration update, including adding a streaming source using this
-- operation, results in a new version of the application. You can use the
-- DescribeApplication operation to find the current application version.
module Amazonka.KinesisAnalyticsV2.AddApplicationOutput
  ( -- * Creating a Request
    AddApplicationOutput (..),
    newAddApplicationOutput,

    -- * Request Lenses
    addApplicationOutput_applicationName,
    addApplicationOutput_currentApplicationVersionId,
    addApplicationOutput_output,

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

    -- * Response Lenses
    addApplicationOutputResponse_applicationARN,
    addApplicationOutputResponse_applicationVersionId,
    addApplicationOutputResponse_outputDescriptions,
    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.KinesisAnalyticsV2.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'
  { -- | The name of the application to which you want to add the output
    -- configuration.
    AddApplicationOutput -> Text
applicationName :: Prelude.Text,
    -- | The version of the application to which you want to add the output
    -- configuration. You can use the 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, a Kinesis data stream, a Kinesis Data Firehose
    -- delivery stream, or an Amazon 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' - The name of the application to which you want to add the output
-- configuration.
--
-- 'currentApplicationVersionId', 'addApplicationOutput_currentApplicationVersionId' - The version of the application to which you want to add the output
-- configuration. You can use the 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, a Kinesis data stream, a Kinesis Data Firehose
-- delivery stream, or an Amazon 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_
      }

-- | The 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)

-- | The version of the application to which you want to add the output
-- configuration. You can use the 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, a Kinesis data stream, a Kinesis Data Firehose
-- delivery stream, or an Amazon 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 -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe Natural
-> Maybe [OutputDescription]
-> Int
-> AddApplicationOutputResponse
AddApplicationOutputResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ApplicationARN")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ApplicationVersionId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"OutputDescriptions"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => 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_20180523.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 application Amazon Resource Name (ARN).
    AddApplicationOutputResponse -> Maybe Text
applicationARN :: Prelude.Maybe Prelude.Text,
    -- | The updated application version ID. Kinesis Data Analytics increments
    -- this ID when the application is updated.
    AddApplicationOutputResponse -> Maybe Natural
applicationVersionId :: Prelude.Maybe Prelude.Natural,
    -- | Describes the application output configuration. For more information,
    -- see
    -- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/how-it-works-output.html Configuring Application Output>.
    AddApplicationOutputResponse -> Maybe [OutputDescription]
outputDescriptions :: Prelude.Maybe [OutputDescription],
    -- | 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:
--
-- 'applicationARN', 'addApplicationOutputResponse_applicationARN' - The application Amazon Resource Name (ARN).
--
-- 'applicationVersionId', 'addApplicationOutputResponse_applicationVersionId' - The updated application version ID. Kinesis Data Analytics increments
-- this ID when the application is updated.
--
-- 'outputDescriptions', 'addApplicationOutputResponse_outputDescriptions' - Describes the application output configuration. For more information,
-- see
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/how-it-works-output.html Configuring Application Output>.
--
-- 'httpStatus', 'addApplicationOutputResponse_httpStatus' - The response's http status code.
newAddApplicationOutputResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddApplicationOutputResponse
newAddApplicationOutputResponse :: Int -> AddApplicationOutputResponse
newAddApplicationOutputResponse Int
pHttpStatus_ =
  AddApplicationOutputResponse'
    { $sel:applicationARN:AddApplicationOutputResponse' :: Maybe Text
applicationARN =
        forall a. Maybe a
Prelude.Nothing,
      $sel:applicationVersionId:AddApplicationOutputResponse' :: Maybe Natural
applicationVersionId = forall a. Maybe a
Prelude.Nothing,
      $sel:outputDescriptions:AddApplicationOutputResponse' :: Maybe [OutputDescription]
outputDescriptions = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AddApplicationOutputResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The application Amazon Resource Name (ARN).
addApplicationOutputResponse_applicationARN :: Lens.Lens' AddApplicationOutputResponse (Prelude.Maybe Prelude.Text)
addApplicationOutputResponse_applicationARN :: Lens' AddApplicationOutputResponse (Maybe Text)
addApplicationOutputResponse_applicationARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddApplicationOutputResponse' {Maybe Text
applicationARN :: Maybe Text
$sel:applicationARN:AddApplicationOutputResponse' :: AddApplicationOutputResponse -> Maybe Text
applicationARN} -> Maybe Text
applicationARN) (\s :: AddApplicationOutputResponse
s@AddApplicationOutputResponse' {} Maybe Text
a -> AddApplicationOutputResponse
s {$sel:applicationARN:AddApplicationOutputResponse' :: Maybe Text
applicationARN = Maybe Text
a} :: AddApplicationOutputResponse)

-- | The updated application version ID. Kinesis Data Analytics increments
-- this ID when the application is updated.
addApplicationOutputResponse_applicationVersionId :: Lens.Lens' AddApplicationOutputResponse (Prelude.Maybe Prelude.Natural)
addApplicationOutputResponse_applicationVersionId :: Lens' AddApplicationOutputResponse (Maybe Natural)
addApplicationOutputResponse_applicationVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddApplicationOutputResponse' {Maybe Natural
applicationVersionId :: Maybe Natural
$sel:applicationVersionId:AddApplicationOutputResponse' :: AddApplicationOutputResponse -> Maybe Natural
applicationVersionId} -> Maybe Natural
applicationVersionId) (\s :: AddApplicationOutputResponse
s@AddApplicationOutputResponse' {} Maybe Natural
a -> AddApplicationOutputResponse
s {$sel:applicationVersionId:AddApplicationOutputResponse' :: Maybe Natural
applicationVersionId = Maybe Natural
a} :: AddApplicationOutputResponse)

-- | Describes the application output configuration. For more information,
-- see
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/dev/how-it-works-output.html Configuring Application Output>.
addApplicationOutputResponse_outputDescriptions :: Lens.Lens' AddApplicationOutputResponse (Prelude.Maybe [OutputDescription])
addApplicationOutputResponse_outputDescriptions :: Lens' AddApplicationOutputResponse (Maybe [OutputDescription])
addApplicationOutputResponse_outputDescriptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddApplicationOutputResponse' {Maybe [OutputDescription]
outputDescriptions :: Maybe [OutputDescription]
$sel:outputDescriptions:AddApplicationOutputResponse' :: AddApplicationOutputResponse -> Maybe [OutputDescription]
outputDescriptions} -> Maybe [OutputDescription]
outputDescriptions) (\s :: AddApplicationOutputResponse
s@AddApplicationOutputResponse' {} Maybe [OutputDescription]
a -> AddApplicationOutputResponse
s {$sel:outputDescriptions:AddApplicationOutputResponse' :: Maybe [OutputDescription]
outputDescriptions = Maybe [OutputDescription]
a} :: AddApplicationOutputResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | 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
Maybe Natural
Maybe [OutputDescription]
Maybe Text
httpStatus :: Int
outputDescriptions :: Maybe [OutputDescription]
applicationVersionId :: Maybe Natural
applicationARN :: Maybe Text
$sel:httpStatus:AddApplicationOutputResponse' :: AddApplicationOutputResponse -> Int
$sel:outputDescriptions:AddApplicationOutputResponse' :: AddApplicationOutputResponse -> Maybe [OutputDescription]
$sel:applicationVersionId:AddApplicationOutputResponse' :: AddApplicationOutputResponse -> Maybe Natural
$sel:applicationARN:AddApplicationOutputResponse' :: AddApplicationOutputResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
applicationVersionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [OutputDescription]
outputDescriptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus