{-# 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.UpdateApplication
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an existing Kinesis Data Analytics application. Using this
-- operation, you can update application code, input configuration, and
-- output configuration.
--
-- Kinesis Data Analytics updates the @ApplicationVersionId@ each time you
-- update your application.
--
-- You cannot update the @RuntimeEnvironment@ of an existing application.
-- If you need to update an application\'s @RuntimeEnvironment@, you must
-- delete the application and create it again.
module Amazonka.KinesisAnalyticsV2.UpdateApplication
  ( -- * Creating a Request
    UpdateApplication (..),
    newUpdateApplication,

    -- * Request Lenses
    updateApplication_applicationConfigurationUpdate,
    updateApplication_cloudWatchLoggingOptionUpdates,
    updateApplication_conditionalToken,
    updateApplication_currentApplicationVersionId,
    updateApplication_runConfigurationUpdate,
    updateApplication_serviceExecutionRoleUpdate,
    updateApplication_applicationName,

    -- * Destructuring the Response
    UpdateApplicationResponse (..),
    newUpdateApplicationResponse,

    -- * Response Lenses
    updateApplicationResponse_httpStatus,
    updateApplicationResponse_applicationDetail,
  )
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:/ 'newUpdateApplication' smart constructor.
data UpdateApplication = UpdateApplication'
  { -- | Describes application configuration updates.
    UpdateApplication -> Maybe ApplicationConfigurationUpdate
applicationConfigurationUpdate :: Prelude.Maybe ApplicationConfigurationUpdate,
    -- | Describes application Amazon CloudWatch logging option updates. You can
    -- only update existing CloudWatch logging options with this action. To add
    -- a new CloudWatch logging option, use
    -- AddApplicationCloudWatchLoggingOption.
    UpdateApplication -> Maybe [CloudWatchLoggingOptionUpdate]
cloudWatchLoggingOptionUpdates :: Prelude.Maybe [CloudWatchLoggingOptionUpdate],
    -- | A value you use to implement strong concurrency for application updates.
    -- You must provide the @CurrentApplicationVersionId@ or the
    -- @ConditionalToken@. You get the application\'s current
    -- @ConditionalToken@ using DescribeApplication. For better concurrency
    -- support, use the @ConditionalToken@ parameter instead of
    -- @CurrentApplicationVersionId@.
    UpdateApplication -> Maybe Text
conditionalToken :: Prelude.Maybe Prelude.Text,
    -- | The current application version ID. You must provide the
    -- @CurrentApplicationVersionId@ or the @ConditionalToken@.You can retrieve
    -- the application version ID using DescribeApplication. For better
    -- concurrency support, use the @ConditionalToken@ parameter instead of
    -- @CurrentApplicationVersionId@.
    UpdateApplication -> Maybe Natural
currentApplicationVersionId :: Prelude.Maybe Prelude.Natural,
    -- | Describes updates to the application\'s starting parameters.
    UpdateApplication -> Maybe RunConfigurationUpdate
runConfigurationUpdate :: Prelude.Maybe RunConfigurationUpdate,
    -- | Describes updates to the service execution role.
    UpdateApplication -> Maybe Text
serviceExecutionRoleUpdate :: Prelude.Maybe Prelude.Text,
    -- | The name of the application to update.
    UpdateApplication -> Text
applicationName :: Prelude.Text
  }
  deriving (UpdateApplication -> UpdateApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateApplication -> UpdateApplication -> Bool
$c/= :: UpdateApplication -> UpdateApplication -> Bool
== :: UpdateApplication -> UpdateApplication -> Bool
$c== :: UpdateApplication -> UpdateApplication -> Bool
Prelude.Eq, ReadPrec [UpdateApplication]
ReadPrec UpdateApplication
Int -> ReadS UpdateApplication
ReadS [UpdateApplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateApplication]
$creadListPrec :: ReadPrec [UpdateApplication]
readPrec :: ReadPrec UpdateApplication
$creadPrec :: ReadPrec UpdateApplication
readList :: ReadS [UpdateApplication]
$creadList :: ReadS [UpdateApplication]
readsPrec :: Int -> ReadS UpdateApplication
$creadsPrec :: Int -> ReadS UpdateApplication
Prelude.Read, Int -> UpdateApplication -> ShowS
[UpdateApplication] -> ShowS
UpdateApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateApplication] -> ShowS
$cshowList :: [UpdateApplication] -> ShowS
show :: UpdateApplication -> String
$cshow :: UpdateApplication -> String
showsPrec :: Int -> UpdateApplication -> ShowS
$cshowsPrec :: Int -> UpdateApplication -> ShowS
Prelude.Show, forall x. Rep UpdateApplication x -> UpdateApplication
forall x. UpdateApplication -> Rep UpdateApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateApplication x -> UpdateApplication
$cfrom :: forall x. UpdateApplication -> Rep UpdateApplication x
Prelude.Generic)

-- |
-- Create a value of 'UpdateApplication' 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:
--
-- 'applicationConfigurationUpdate', 'updateApplication_applicationConfigurationUpdate' - Describes application configuration updates.
--
-- 'cloudWatchLoggingOptionUpdates', 'updateApplication_cloudWatchLoggingOptionUpdates' - Describes application Amazon CloudWatch logging option updates. You can
-- only update existing CloudWatch logging options with this action. To add
-- a new CloudWatch logging option, use
-- AddApplicationCloudWatchLoggingOption.
--
-- 'conditionalToken', 'updateApplication_conditionalToken' - A value you use to implement strong concurrency for application updates.
-- You must provide the @CurrentApplicationVersionId@ or the
-- @ConditionalToken@. You get the application\'s current
-- @ConditionalToken@ using DescribeApplication. For better concurrency
-- support, use the @ConditionalToken@ parameter instead of
-- @CurrentApplicationVersionId@.
--
-- 'currentApplicationVersionId', 'updateApplication_currentApplicationVersionId' - The current application version ID. You must provide the
-- @CurrentApplicationVersionId@ or the @ConditionalToken@.You can retrieve
-- the application version ID using DescribeApplication. For better
-- concurrency support, use the @ConditionalToken@ parameter instead of
-- @CurrentApplicationVersionId@.
--
-- 'runConfigurationUpdate', 'updateApplication_runConfigurationUpdate' - Describes updates to the application\'s starting parameters.
--
-- 'serviceExecutionRoleUpdate', 'updateApplication_serviceExecutionRoleUpdate' - Describes updates to the service execution role.
--
-- 'applicationName', 'updateApplication_applicationName' - The name of the application to update.
newUpdateApplication ::
  -- | 'applicationName'
  Prelude.Text ->
  UpdateApplication
newUpdateApplication :: Text -> UpdateApplication
newUpdateApplication Text
pApplicationName_ =
  UpdateApplication'
    { $sel:applicationConfigurationUpdate:UpdateApplication' :: Maybe ApplicationConfigurationUpdate
applicationConfigurationUpdate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:cloudWatchLoggingOptionUpdates:UpdateApplication' :: Maybe [CloudWatchLoggingOptionUpdate]
cloudWatchLoggingOptionUpdates = forall a. Maybe a
Prelude.Nothing,
      $sel:conditionalToken:UpdateApplication' :: Maybe Text
conditionalToken = forall a. Maybe a
Prelude.Nothing,
      $sel:currentApplicationVersionId:UpdateApplication' :: Maybe Natural
currentApplicationVersionId = forall a. Maybe a
Prelude.Nothing,
      $sel:runConfigurationUpdate:UpdateApplication' :: Maybe RunConfigurationUpdate
runConfigurationUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceExecutionRoleUpdate:UpdateApplication' :: Maybe Text
serviceExecutionRoleUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:applicationName:UpdateApplication' :: Text
applicationName = Text
pApplicationName_
    }

-- | Describes application configuration updates.
updateApplication_applicationConfigurationUpdate :: Lens.Lens' UpdateApplication (Prelude.Maybe ApplicationConfigurationUpdate)
updateApplication_applicationConfigurationUpdate :: Lens' UpdateApplication (Maybe ApplicationConfigurationUpdate)
updateApplication_applicationConfigurationUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplication' {Maybe ApplicationConfigurationUpdate
applicationConfigurationUpdate :: Maybe ApplicationConfigurationUpdate
$sel:applicationConfigurationUpdate:UpdateApplication' :: UpdateApplication -> Maybe ApplicationConfigurationUpdate
applicationConfigurationUpdate} -> Maybe ApplicationConfigurationUpdate
applicationConfigurationUpdate) (\s :: UpdateApplication
s@UpdateApplication' {} Maybe ApplicationConfigurationUpdate
a -> UpdateApplication
s {$sel:applicationConfigurationUpdate:UpdateApplication' :: Maybe ApplicationConfigurationUpdate
applicationConfigurationUpdate = Maybe ApplicationConfigurationUpdate
a} :: UpdateApplication)

-- | Describes application Amazon CloudWatch logging option updates. You can
-- only update existing CloudWatch logging options with this action. To add
-- a new CloudWatch logging option, use
-- AddApplicationCloudWatchLoggingOption.
updateApplication_cloudWatchLoggingOptionUpdates :: Lens.Lens' UpdateApplication (Prelude.Maybe [CloudWatchLoggingOptionUpdate])
updateApplication_cloudWatchLoggingOptionUpdates :: Lens' UpdateApplication (Maybe [CloudWatchLoggingOptionUpdate])
updateApplication_cloudWatchLoggingOptionUpdates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplication' {Maybe [CloudWatchLoggingOptionUpdate]
cloudWatchLoggingOptionUpdates :: Maybe [CloudWatchLoggingOptionUpdate]
$sel:cloudWatchLoggingOptionUpdates:UpdateApplication' :: UpdateApplication -> Maybe [CloudWatchLoggingOptionUpdate]
cloudWatchLoggingOptionUpdates} -> Maybe [CloudWatchLoggingOptionUpdate]
cloudWatchLoggingOptionUpdates) (\s :: UpdateApplication
s@UpdateApplication' {} Maybe [CloudWatchLoggingOptionUpdate]
a -> UpdateApplication
s {$sel:cloudWatchLoggingOptionUpdates:UpdateApplication' :: Maybe [CloudWatchLoggingOptionUpdate]
cloudWatchLoggingOptionUpdates = Maybe [CloudWatchLoggingOptionUpdate]
a} :: UpdateApplication) 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

-- | A value you use to implement strong concurrency for application updates.
-- You must provide the @CurrentApplicationVersionId@ or the
-- @ConditionalToken@. You get the application\'s current
-- @ConditionalToken@ using DescribeApplication. For better concurrency
-- support, use the @ConditionalToken@ parameter instead of
-- @CurrentApplicationVersionId@.
updateApplication_conditionalToken :: Lens.Lens' UpdateApplication (Prelude.Maybe Prelude.Text)
updateApplication_conditionalToken :: Lens' UpdateApplication (Maybe Text)
updateApplication_conditionalToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplication' {Maybe Text
conditionalToken :: Maybe Text
$sel:conditionalToken:UpdateApplication' :: UpdateApplication -> Maybe Text
conditionalToken} -> Maybe Text
conditionalToken) (\s :: UpdateApplication
s@UpdateApplication' {} Maybe Text
a -> UpdateApplication
s {$sel:conditionalToken:UpdateApplication' :: Maybe Text
conditionalToken = Maybe Text
a} :: UpdateApplication)

-- | The current application version ID. You must provide the
-- @CurrentApplicationVersionId@ or the @ConditionalToken@.You can retrieve
-- the application version ID using DescribeApplication. For better
-- concurrency support, use the @ConditionalToken@ parameter instead of
-- @CurrentApplicationVersionId@.
updateApplication_currentApplicationVersionId :: Lens.Lens' UpdateApplication (Prelude.Maybe Prelude.Natural)
updateApplication_currentApplicationVersionId :: Lens' UpdateApplication (Maybe Natural)
updateApplication_currentApplicationVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplication' {Maybe Natural
currentApplicationVersionId :: Maybe Natural
$sel:currentApplicationVersionId:UpdateApplication' :: UpdateApplication -> Maybe Natural
currentApplicationVersionId} -> Maybe Natural
currentApplicationVersionId) (\s :: UpdateApplication
s@UpdateApplication' {} Maybe Natural
a -> UpdateApplication
s {$sel:currentApplicationVersionId:UpdateApplication' :: Maybe Natural
currentApplicationVersionId = Maybe Natural
a} :: UpdateApplication)

-- | Describes updates to the application\'s starting parameters.
updateApplication_runConfigurationUpdate :: Lens.Lens' UpdateApplication (Prelude.Maybe RunConfigurationUpdate)
updateApplication_runConfigurationUpdate :: Lens' UpdateApplication (Maybe RunConfigurationUpdate)
updateApplication_runConfigurationUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplication' {Maybe RunConfigurationUpdate
runConfigurationUpdate :: Maybe RunConfigurationUpdate
$sel:runConfigurationUpdate:UpdateApplication' :: UpdateApplication -> Maybe RunConfigurationUpdate
runConfigurationUpdate} -> Maybe RunConfigurationUpdate
runConfigurationUpdate) (\s :: UpdateApplication
s@UpdateApplication' {} Maybe RunConfigurationUpdate
a -> UpdateApplication
s {$sel:runConfigurationUpdate:UpdateApplication' :: Maybe RunConfigurationUpdate
runConfigurationUpdate = Maybe RunConfigurationUpdate
a} :: UpdateApplication)

-- | Describes updates to the service execution role.
updateApplication_serviceExecutionRoleUpdate :: Lens.Lens' UpdateApplication (Prelude.Maybe Prelude.Text)
updateApplication_serviceExecutionRoleUpdate :: Lens' UpdateApplication (Maybe Text)
updateApplication_serviceExecutionRoleUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplication' {Maybe Text
serviceExecutionRoleUpdate :: Maybe Text
$sel:serviceExecutionRoleUpdate:UpdateApplication' :: UpdateApplication -> Maybe Text
serviceExecutionRoleUpdate} -> Maybe Text
serviceExecutionRoleUpdate) (\s :: UpdateApplication
s@UpdateApplication' {} Maybe Text
a -> UpdateApplication
s {$sel:serviceExecutionRoleUpdate:UpdateApplication' :: Maybe Text
serviceExecutionRoleUpdate = Maybe Text
a} :: UpdateApplication)

-- | The name of the application to update.
updateApplication_applicationName :: Lens.Lens' UpdateApplication Prelude.Text
updateApplication_applicationName :: Lens' UpdateApplication Text
updateApplication_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplication' {Text
applicationName :: Text
$sel:applicationName:UpdateApplication' :: UpdateApplication -> Text
applicationName} -> Text
applicationName) (\s :: UpdateApplication
s@UpdateApplication' {} Text
a -> UpdateApplication
s {$sel:applicationName:UpdateApplication' :: Text
applicationName = Text
a} :: UpdateApplication)

instance Core.AWSRequest UpdateApplication where
  type
    AWSResponse UpdateApplication =
      UpdateApplicationResponse
  request :: (Service -> Service)
-> UpdateApplication -> Request UpdateApplication
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 UpdateApplication
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateApplication)))
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 ->
          Int -> ApplicationDetail -> UpdateApplicationResponse
UpdateApplicationResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ApplicationDetail")
      )

instance Prelude.Hashable UpdateApplication where
  hashWithSalt :: Int -> UpdateApplication -> Int
hashWithSalt Int
_salt UpdateApplication' {Maybe Natural
Maybe [CloudWatchLoggingOptionUpdate]
Maybe Text
Maybe RunConfigurationUpdate
Maybe ApplicationConfigurationUpdate
Text
applicationName :: Text
serviceExecutionRoleUpdate :: Maybe Text
runConfigurationUpdate :: Maybe RunConfigurationUpdate
currentApplicationVersionId :: Maybe Natural
conditionalToken :: Maybe Text
cloudWatchLoggingOptionUpdates :: Maybe [CloudWatchLoggingOptionUpdate]
applicationConfigurationUpdate :: Maybe ApplicationConfigurationUpdate
$sel:applicationName:UpdateApplication' :: UpdateApplication -> Text
$sel:serviceExecutionRoleUpdate:UpdateApplication' :: UpdateApplication -> Maybe Text
$sel:runConfigurationUpdate:UpdateApplication' :: UpdateApplication -> Maybe RunConfigurationUpdate
$sel:currentApplicationVersionId:UpdateApplication' :: UpdateApplication -> Maybe Natural
$sel:conditionalToken:UpdateApplication' :: UpdateApplication -> Maybe Text
$sel:cloudWatchLoggingOptionUpdates:UpdateApplication' :: UpdateApplication -> Maybe [CloudWatchLoggingOptionUpdate]
$sel:applicationConfigurationUpdate:UpdateApplication' :: UpdateApplication -> Maybe ApplicationConfigurationUpdate
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ApplicationConfigurationUpdate
applicationConfigurationUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CloudWatchLoggingOptionUpdate]
cloudWatchLoggingOptionUpdates
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
conditionalToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
currentApplicationVersionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RunConfigurationUpdate
runConfigurationUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceExecutionRoleUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationName

instance Prelude.NFData UpdateApplication where
  rnf :: UpdateApplication -> ()
rnf UpdateApplication' {Maybe Natural
Maybe [CloudWatchLoggingOptionUpdate]
Maybe Text
Maybe RunConfigurationUpdate
Maybe ApplicationConfigurationUpdate
Text
applicationName :: Text
serviceExecutionRoleUpdate :: Maybe Text
runConfigurationUpdate :: Maybe RunConfigurationUpdate
currentApplicationVersionId :: Maybe Natural
conditionalToken :: Maybe Text
cloudWatchLoggingOptionUpdates :: Maybe [CloudWatchLoggingOptionUpdate]
applicationConfigurationUpdate :: Maybe ApplicationConfigurationUpdate
$sel:applicationName:UpdateApplication' :: UpdateApplication -> Text
$sel:serviceExecutionRoleUpdate:UpdateApplication' :: UpdateApplication -> Maybe Text
$sel:runConfigurationUpdate:UpdateApplication' :: UpdateApplication -> Maybe RunConfigurationUpdate
$sel:currentApplicationVersionId:UpdateApplication' :: UpdateApplication -> Maybe Natural
$sel:conditionalToken:UpdateApplication' :: UpdateApplication -> Maybe Text
$sel:cloudWatchLoggingOptionUpdates:UpdateApplication' :: UpdateApplication -> Maybe [CloudWatchLoggingOptionUpdate]
$sel:applicationConfigurationUpdate:UpdateApplication' :: UpdateApplication -> Maybe ApplicationConfigurationUpdate
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ApplicationConfigurationUpdate
applicationConfigurationUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [CloudWatchLoggingOptionUpdate]
cloudWatchLoggingOptionUpdates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
conditionalToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
currentApplicationVersionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RunConfigurationUpdate
runConfigurationUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceExecutionRoleUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationName

instance Data.ToHeaders UpdateApplication where
  toHeaders :: UpdateApplication -> 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.UpdateApplication" ::
                          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 UpdateApplication where
  toJSON :: UpdateApplication -> Value
toJSON UpdateApplication' {Maybe Natural
Maybe [CloudWatchLoggingOptionUpdate]
Maybe Text
Maybe RunConfigurationUpdate
Maybe ApplicationConfigurationUpdate
Text
applicationName :: Text
serviceExecutionRoleUpdate :: Maybe Text
runConfigurationUpdate :: Maybe RunConfigurationUpdate
currentApplicationVersionId :: Maybe Natural
conditionalToken :: Maybe Text
cloudWatchLoggingOptionUpdates :: Maybe [CloudWatchLoggingOptionUpdate]
applicationConfigurationUpdate :: Maybe ApplicationConfigurationUpdate
$sel:applicationName:UpdateApplication' :: UpdateApplication -> Text
$sel:serviceExecutionRoleUpdate:UpdateApplication' :: UpdateApplication -> Maybe Text
$sel:runConfigurationUpdate:UpdateApplication' :: UpdateApplication -> Maybe RunConfigurationUpdate
$sel:currentApplicationVersionId:UpdateApplication' :: UpdateApplication -> Maybe Natural
$sel:conditionalToken:UpdateApplication' :: UpdateApplication -> Maybe Text
$sel:cloudWatchLoggingOptionUpdates:UpdateApplication' :: UpdateApplication -> Maybe [CloudWatchLoggingOptionUpdate]
$sel:applicationConfigurationUpdate:UpdateApplication' :: UpdateApplication -> Maybe ApplicationConfigurationUpdate
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ApplicationConfigurationUpdate" 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 ApplicationConfigurationUpdate
applicationConfigurationUpdate,
            (Key
"CloudWatchLoggingOptionUpdates" 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 [CloudWatchLoggingOptionUpdate]
cloudWatchLoggingOptionUpdates,
            (Key
"ConditionalToken" 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
conditionalToken,
            (Key
"CurrentApplicationVersionId" 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 Natural
currentApplicationVersionId,
            (Key
"RunConfigurationUpdate" 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 RunConfigurationUpdate
runConfigurationUpdate,
            (Key
"ServiceExecutionRoleUpdate" 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
serviceExecutionRoleUpdate,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ApplicationName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
applicationName)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateApplicationResponse' 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', 'updateApplicationResponse_httpStatus' - The response's http status code.
--
-- 'applicationDetail', 'updateApplicationResponse_applicationDetail' - Describes application updates.
newUpdateApplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'applicationDetail'
  ApplicationDetail ->
  UpdateApplicationResponse
newUpdateApplicationResponse :: Int -> ApplicationDetail -> UpdateApplicationResponse
newUpdateApplicationResponse
  Int
pHttpStatus_
  ApplicationDetail
pApplicationDetail_ =
    UpdateApplicationResponse'
      { $sel:httpStatus:UpdateApplicationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:applicationDetail:UpdateApplicationResponse' :: ApplicationDetail
applicationDetail = ApplicationDetail
pApplicationDetail_
      }

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

-- | Describes application updates.
updateApplicationResponse_applicationDetail :: Lens.Lens' UpdateApplicationResponse ApplicationDetail
updateApplicationResponse_applicationDetail :: Lens' UpdateApplicationResponse ApplicationDetail
updateApplicationResponse_applicationDetail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplicationResponse' {ApplicationDetail
applicationDetail :: ApplicationDetail
$sel:applicationDetail:UpdateApplicationResponse' :: UpdateApplicationResponse -> ApplicationDetail
applicationDetail} -> ApplicationDetail
applicationDetail) (\s :: UpdateApplicationResponse
s@UpdateApplicationResponse' {} ApplicationDetail
a -> UpdateApplicationResponse
s {$sel:applicationDetail:UpdateApplicationResponse' :: ApplicationDetail
applicationDetail = ApplicationDetail
a} :: UpdateApplicationResponse)

instance Prelude.NFData UpdateApplicationResponse where
  rnf :: UpdateApplicationResponse -> ()
rnf UpdateApplicationResponse' {Int
ApplicationDetail
applicationDetail :: ApplicationDetail
httpStatus :: Int
$sel:applicationDetail:UpdateApplicationResponse' :: UpdateApplicationResponse -> ApplicationDetail
$sel:httpStatus:UpdateApplicationResponse' :: UpdateApplicationResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ApplicationDetail
applicationDetail