{-# 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.CreateApplication
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a Kinesis Data Analytics application. For information about
-- creating a Kinesis Data Analytics application, see
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/java/getting-started.html Creating an Application>.
module Amazonka.KinesisAnalyticsV2.CreateApplication
  ( -- * Creating a Request
    CreateApplication (..),
    newCreateApplication,

    -- * Request Lenses
    createApplication_applicationConfiguration,
    createApplication_applicationDescription,
    createApplication_applicationMode,
    createApplication_cloudWatchLoggingOptions,
    createApplication_tags,
    createApplication_applicationName,
    createApplication_runtimeEnvironment,
    createApplication_serviceExecutionRole,

    -- * Destructuring the Response
    CreateApplicationResponse (..),
    newCreateApplicationResponse,

    -- * Response Lenses
    createApplicationResponse_httpStatus,
    createApplicationResponse_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:/ 'newCreateApplication' smart constructor.
data CreateApplication = CreateApplication'
  { -- | Use this parameter to configure the application.
    CreateApplication -> Maybe ApplicationConfiguration
applicationConfiguration :: Prelude.Maybe ApplicationConfiguration,
    -- | A summary description of the application.
    CreateApplication -> Maybe Text
applicationDescription :: Prelude.Maybe Prelude.Text,
    -- | Use the @STREAMING@ mode to create a Kinesis Data Analytics For Flink
    -- application. To create a Kinesis Data Analytics Studio notebook, use the
    -- @INTERACTIVE@ mode.
    CreateApplication -> Maybe ApplicationMode
applicationMode :: Prelude.Maybe ApplicationMode,
    -- | Use this parameter to configure an Amazon CloudWatch log stream to
    -- monitor application configuration errors.
    CreateApplication -> Maybe [CloudWatchLoggingOption]
cloudWatchLoggingOptions :: Prelude.Maybe [CloudWatchLoggingOption],
    -- | A list of one or more tags to assign to the application. A tag is a
    -- key-value pair that identifies an application. Note that the maximum
    -- number of application tags includes system tags. The maximum number of
    -- user-defined application tags is 50. For more information, see
    -- <https://docs.aws.amazon.com/kinesisanalytics/latest/java/how-tagging.html Using Tagging>.
    CreateApplication -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The name of your application (for example, @sample-app@).
    CreateApplication -> Text
applicationName :: Prelude.Text,
    -- | The runtime environment for the application.
    CreateApplication -> RuntimeEnvironment
runtimeEnvironment :: RuntimeEnvironment,
    -- | The IAM role used by the application to access Kinesis data streams,
    -- Kinesis Data Firehose delivery streams, Amazon S3 objects, and other
    -- external resources.
    CreateApplication -> Text
serviceExecutionRole :: Prelude.Text
  }
  deriving (CreateApplication -> CreateApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateApplication -> CreateApplication -> Bool
$c/= :: CreateApplication -> CreateApplication -> Bool
== :: CreateApplication -> CreateApplication -> Bool
$c== :: CreateApplication -> CreateApplication -> Bool
Prelude.Eq, ReadPrec [CreateApplication]
ReadPrec CreateApplication
Int -> ReadS CreateApplication
ReadS [CreateApplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateApplication]
$creadListPrec :: ReadPrec [CreateApplication]
readPrec :: ReadPrec CreateApplication
$creadPrec :: ReadPrec CreateApplication
readList :: ReadS [CreateApplication]
$creadList :: ReadS [CreateApplication]
readsPrec :: Int -> ReadS CreateApplication
$creadsPrec :: Int -> ReadS CreateApplication
Prelude.Read, Int -> CreateApplication -> ShowS
[CreateApplication] -> ShowS
CreateApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateApplication] -> ShowS
$cshowList :: [CreateApplication] -> ShowS
show :: CreateApplication -> String
$cshow :: CreateApplication -> String
showsPrec :: Int -> CreateApplication -> ShowS
$cshowsPrec :: Int -> CreateApplication -> ShowS
Prelude.Show, forall x. Rep CreateApplication x -> CreateApplication
forall x. CreateApplication -> Rep CreateApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateApplication x -> CreateApplication
$cfrom :: forall x. CreateApplication -> Rep CreateApplication x
Prelude.Generic)

-- |
-- Create a value of 'CreateApplication' 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:
--
-- 'applicationConfiguration', 'createApplication_applicationConfiguration' - Use this parameter to configure the application.
--
-- 'applicationDescription', 'createApplication_applicationDescription' - A summary description of the application.
--
-- 'applicationMode', 'createApplication_applicationMode' - Use the @STREAMING@ mode to create a Kinesis Data Analytics For Flink
-- application. To create a Kinesis Data Analytics Studio notebook, use the
-- @INTERACTIVE@ mode.
--
-- 'cloudWatchLoggingOptions', 'createApplication_cloudWatchLoggingOptions' - Use this parameter to configure an Amazon CloudWatch log stream to
-- monitor application configuration errors.
--
-- 'tags', 'createApplication_tags' - A list of one or more tags to assign to the application. A tag is a
-- key-value pair that identifies an application. Note that the maximum
-- number of application tags includes system tags. The maximum number of
-- user-defined application tags is 50. For more information, see
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/java/how-tagging.html Using Tagging>.
--
-- 'applicationName', 'createApplication_applicationName' - The name of your application (for example, @sample-app@).
--
-- 'runtimeEnvironment', 'createApplication_runtimeEnvironment' - The runtime environment for the application.
--
-- 'serviceExecutionRole', 'createApplication_serviceExecutionRole' - The IAM role used by the application to access Kinesis data streams,
-- Kinesis Data Firehose delivery streams, Amazon S3 objects, and other
-- external resources.
newCreateApplication ::
  -- | 'applicationName'
  Prelude.Text ->
  -- | 'runtimeEnvironment'
  RuntimeEnvironment ->
  -- | 'serviceExecutionRole'
  Prelude.Text ->
  CreateApplication
newCreateApplication :: Text -> RuntimeEnvironment -> Text -> CreateApplication
newCreateApplication
  Text
pApplicationName_
  RuntimeEnvironment
pRuntimeEnvironment_
  Text
pServiceExecutionRole_ =
    CreateApplication'
      { $sel:applicationConfiguration:CreateApplication' :: Maybe ApplicationConfiguration
applicationConfiguration =
          forall a. Maybe a
Prelude.Nothing,
        $sel:applicationDescription:CreateApplication' :: Maybe Text
applicationDescription = forall a. Maybe a
Prelude.Nothing,
        $sel:applicationMode:CreateApplication' :: Maybe ApplicationMode
applicationMode = forall a. Maybe a
Prelude.Nothing,
        $sel:cloudWatchLoggingOptions:CreateApplication' :: Maybe [CloudWatchLoggingOption]
cloudWatchLoggingOptions = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateApplication' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:applicationName:CreateApplication' :: Text
applicationName = Text
pApplicationName_,
        $sel:runtimeEnvironment:CreateApplication' :: RuntimeEnvironment
runtimeEnvironment = RuntimeEnvironment
pRuntimeEnvironment_,
        $sel:serviceExecutionRole:CreateApplication' :: Text
serviceExecutionRole = Text
pServiceExecutionRole_
      }

-- | Use this parameter to configure the application.
createApplication_applicationConfiguration :: Lens.Lens' CreateApplication (Prelude.Maybe ApplicationConfiguration)
createApplication_applicationConfiguration :: Lens' CreateApplication (Maybe ApplicationConfiguration)
createApplication_applicationConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe ApplicationConfiguration
applicationConfiguration :: Maybe ApplicationConfiguration
$sel:applicationConfiguration:CreateApplication' :: CreateApplication -> Maybe ApplicationConfiguration
applicationConfiguration} -> Maybe ApplicationConfiguration
applicationConfiguration) (\s :: CreateApplication
s@CreateApplication' {} Maybe ApplicationConfiguration
a -> CreateApplication
s {$sel:applicationConfiguration:CreateApplication' :: Maybe ApplicationConfiguration
applicationConfiguration = Maybe ApplicationConfiguration
a} :: CreateApplication)

-- | A summary description of the application.
createApplication_applicationDescription :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_applicationDescription :: Lens' CreateApplication (Maybe Text)
createApplication_applicationDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
applicationDescription :: Maybe Text
$sel:applicationDescription:CreateApplication' :: CreateApplication -> Maybe Text
applicationDescription} -> Maybe Text
applicationDescription) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:applicationDescription:CreateApplication' :: Maybe Text
applicationDescription = Maybe Text
a} :: CreateApplication)

-- | Use the @STREAMING@ mode to create a Kinesis Data Analytics For Flink
-- application. To create a Kinesis Data Analytics Studio notebook, use the
-- @INTERACTIVE@ mode.
createApplication_applicationMode :: Lens.Lens' CreateApplication (Prelude.Maybe ApplicationMode)
createApplication_applicationMode :: Lens' CreateApplication (Maybe ApplicationMode)
createApplication_applicationMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe ApplicationMode
applicationMode :: Maybe ApplicationMode
$sel:applicationMode:CreateApplication' :: CreateApplication -> Maybe ApplicationMode
applicationMode} -> Maybe ApplicationMode
applicationMode) (\s :: CreateApplication
s@CreateApplication' {} Maybe ApplicationMode
a -> CreateApplication
s {$sel:applicationMode:CreateApplication' :: Maybe ApplicationMode
applicationMode = Maybe ApplicationMode
a} :: CreateApplication)

-- | Use this parameter to configure an Amazon CloudWatch log stream to
-- monitor application configuration errors.
createApplication_cloudWatchLoggingOptions :: Lens.Lens' CreateApplication (Prelude.Maybe [CloudWatchLoggingOption])
createApplication_cloudWatchLoggingOptions :: Lens' CreateApplication (Maybe [CloudWatchLoggingOption])
createApplication_cloudWatchLoggingOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe [CloudWatchLoggingOption]
cloudWatchLoggingOptions :: Maybe [CloudWatchLoggingOption]
$sel:cloudWatchLoggingOptions:CreateApplication' :: CreateApplication -> Maybe [CloudWatchLoggingOption]
cloudWatchLoggingOptions} -> Maybe [CloudWatchLoggingOption]
cloudWatchLoggingOptions) (\s :: CreateApplication
s@CreateApplication' {} Maybe [CloudWatchLoggingOption]
a -> CreateApplication
s {$sel:cloudWatchLoggingOptions:CreateApplication' :: Maybe [CloudWatchLoggingOption]
cloudWatchLoggingOptions = Maybe [CloudWatchLoggingOption]
a} :: CreateApplication) 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 list of one or more tags to assign to the application. A tag is a
-- key-value pair that identifies an application. Note that the maximum
-- number of application tags includes system tags. The maximum number of
-- user-defined application tags is 50. For more information, see
-- <https://docs.aws.amazon.com/kinesisanalytics/latest/java/how-tagging.html Using Tagging>.
createApplication_tags :: Lens.Lens' CreateApplication (Prelude.Maybe (Prelude.NonEmpty Tag))
createApplication_tags :: Lens' CreateApplication (Maybe (NonEmpty Tag))
createApplication_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateApplication' :: CreateApplication -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateApplication
s@CreateApplication' {} Maybe (NonEmpty Tag)
a -> CreateApplication
s {$sel:tags:CreateApplication' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateApplication) 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 name of your application (for example, @sample-app@).
createApplication_applicationName :: Lens.Lens' CreateApplication Prelude.Text
createApplication_applicationName :: Lens' CreateApplication Text
createApplication_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Text
applicationName :: Text
$sel:applicationName:CreateApplication' :: CreateApplication -> Text
applicationName} -> Text
applicationName) (\s :: CreateApplication
s@CreateApplication' {} Text
a -> CreateApplication
s {$sel:applicationName:CreateApplication' :: Text
applicationName = Text
a} :: CreateApplication)

-- | The runtime environment for the application.
createApplication_runtimeEnvironment :: Lens.Lens' CreateApplication RuntimeEnvironment
createApplication_runtimeEnvironment :: Lens' CreateApplication RuntimeEnvironment
createApplication_runtimeEnvironment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {RuntimeEnvironment
runtimeEnvironment :: RuntimeEnvironment
$sel:runtimeEnvironment:CreateApplication' :: CreateApplication -> RuntimeEnvironment
runtimeEnvironment} -> RuntimeEnvironment
runtimeEnvironment) (\s :: CreateApplication
s@CreateApplication' {} RuntimeEnvironment
a -> CreateApplication
s {$sel:runtimeEnvironment:CreateApplication' :: RuntimeEnvironment
runtimeEnvironment = RuntimeEnvironment
a} :: CreateApplication)

-- | The IAM role used by the application to access Kinesis data streams,
-- Kinesis Data Firehose delivery streams, Amazon S3 objects, and other
-- external resources.
createApplication_serviceExecutionRole :: Lens.Lens' CreateApplication Prelude.Text
createApplication_serviceExecutionRole :: Lens' CreateApplication Text
createApplication_serviceExecutionRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Text
serviceExecutionRole :: Text
$sel:serviceExecutionRole:CreateApplication' :: CreateApplication -> Text
serviceExecutionRole} -> Text
serviceExecutionRole) (\s :: CreateApplication
s@CreateApplication' {} Text
a -> CreateApplication
s {$sel:serviceExecutionRole:CreateApplication' :: Text
serviceExecutionRole = Text
a} :: CreateApplication)

instance Core.AWSRequest CreateApplication where
  type
    AWSResponse CreateApplication =
      CreateApplicationResponse
  request :: (Service -> Service)
-> CreateApplication -> Request CreateApplication
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 CreateApplication
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateApplication)))
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 -> CreateApplicationResponse
CreateApplicationResponse'
            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 CreateApplication where
  hashWithSalt :: Int -> CreateApplication -> Int
hashWithSalt Int
_salt CreateApplication' {Maybe [CloudWatchLoggingOption]
Maybe (NonEmpty Tag)
Maybe Text
Maybe ApplicationMode
Maybe ApplicationConfiguration
Text
RuntimeEnvironment
serviceExecutionRole :: Text
runtimeEnvironment :: RuntimeEnvironment
applicationName :: Text
tags :: Maybe (NonEmpty Tag)
cloudWatchLoggingOptions :: Maybe [CloudWatchLoggingOption]
applicationMode :: Maybe ApplicationMode
applicationDescription :: Maybe Text
applicationConfiguration :: Maybe ApplicationConfiguration
$sel:serviceExecutionRole:CreateApplication' :: CreateApplication -> Text
$sel:runtimeEnvironment:CreateApplication' :: CreateApplication -> RuntimeEnvironment
$sel:applicationName:CreateApplication' :: CreateApplication -> Text
$sel:tags:CreateApplication' :: CreateApplication -> Maybe (NonEmpty Tag)
$sel:cloudWatchLoggingOptions:CreateApplication' :: CreateApplication -> Maybe [CloudWatchLoggingOption]
$sel:applicationMode:CreateApplication' :: CreateApplication -> Maybe ApplicationMode
$sel:applicationDescription:CreateApplication' :: CreateApplication -> Maybe Text
$sel:applicationConfiguration:CreateApplication' :: CreateApplication -> Maybe ApplicationConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ApplicationConfiguration
applicationConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
applicationDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ApplicationMode
applicationMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CloudWatchLoggingOption]
cloudWatchLoggingOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RuntimeEnvironment
runtimeEnvironment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceExecutionRole

instance Prelude.NFData CreateApplication where
  rnf :: CreateApplication -> ()
rnf CreateApplication' {Maybe [CloudWatchLoggingOption]
Maybe (NonEmpty Tag)
Maybe Text
Maybe ApplicationMode
Maybe ApplicationConfiguration
Text
RuntimeEnvironment
serviceExecutionRole :: Text
runtimeEnvironment :: RuntimeEnvironment
applicationName :: Text
tags :: Maybe (NonEmpty Tag)
cloudWatchLoggingOptions :: Maybe [CloudWatchLoggingOption]
applicationMode :: Maybe ApplicationMode
applicationDescription :: Maybe Text
applicationConfiguration :: Maybe ApplicationConfiguration
$sel:serviceExecutionRole:CreateApplication' :: CreateApplication -> Text
$sel:runtimeEnvironment:CreateApplication' :: CreateApplication -> RuntimeEnvironment
$sel:applicationName:CreateApplication' :: CreateApplication -> Text
$sel:tags:CreateApplication' :: CreateApplication -> Maybe (NonEmpty Tag)
$sel:cloudWatchLoggingOptions:CreateApplication' :: CreateApplication -> Maybe [CloudWatchLoggingOption]
$sel:applicationMode:CreateApplication' :: CreateApplication -> Maybe ApplicationMode
$sel:applicationDescription:CreateApplication' :: CreateApplication -> Maybe Text
$sel:applicationConfiguration:CreateApplication' :: CreateApplication -> Maybe ApplicationConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ApplicationConfiguration
applicationConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ApplicationMode
applicationMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [CloudWatchLoggingOption]
cloudWatchLoggingOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 RuntimeEnvironment
runtimeEnvironment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serviceExecutionRole

instance Data.ToHeaders CreateApplication where
  toHeaders :: CreateApplication -> 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.CreateApplication" ::
                          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 CreateApplication where
  toJSON :: CreateApplication -> Value
toJSON CreateApplication' {Maybe [CloudWatchLoggingOption]
Maybe (NonEmpty Tag)
Maybe Text
Maybe ApplicationMode
Maybe ApplicationConfiguration
Text
RuntimeEnvironment
serviceExecutionRole :: Text
runtimeEnvironment :: RuntimeEnvironment
applicationName :: Text
tags :: Maybe (NonEmpty Tag)
cloudWatchLoggingOptions :: Maybe [CloudWatchLoggingOption]
applicationMode :: Maybe ApplicationMode
applicationDescription :: Maybe Text
applicationConfiguration :: Maybe ApplicationConfiguration
$sel:serviceExecutionRole:CreateApplication' :: CreateApplication -> Text
$sel:runtimeEnvironment:CreateApplication' :: CreateApplication -> RuntimeEnvironment
$sel:applicationName:CreateApplication' :: CreateApplication -> Text
$sel:tags:CreateApplication' :: CreateApplication -> Maybe (NonEmpty Tag)
$sel:cloudWatchLoggingOptions:CreateApplication' :: CreateApplication -> Maybe [CloudWatchLoggingOption]
$sel:applicationMode:CreateApplication' :: CreateApplication -> Maybe ApplicationMode
$sel:applicationDescription:CreateApplication' :: CreateApplication -> Maybe Text
$sel:applicationConfiguration:CreateApplication' :: CreateApplication -> Maybe ApplicationConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ApplicationConfiguration" 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 ApplicationConfiguration
applicationConfiguration,
            (Key
"ApplicationDescription" 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
applicationDescription,
            (Key
"ApplicationMode" 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 ApplicationMode
applicationMode,
            (Key
"CloudWatchLoggingOptions" 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 [CloudWatchLoggingOption]
cloudWatchLoggingOptions,
            (Key
"Tags" 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 (NonEmpty Tag)
tags,
            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
"RuntimeEnvironment" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= RuntimeEnvironment
runtimeEnvironment),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ServiceExecutionRole"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serviceExecutionRole
              )
          ]
      )

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

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

-- | /See:/ 'newCreateApplicationResponse' smart constructor.
data CreateApplicationResponse = CreateApplicationResponse'
  { -- | The response's http status code.
    CreateApplicationResponse -> Int
httpStatus :: Prelude.Int,
    -- | In response to your @CreateApplication@ request, Kinesis Data Analytics
    -- returns a response with details of the application it created.
    CreateApplicationResponse -> ApplicationDetail
applicationDetail :: ApplicationDetail
  }
  deriving (CreateApplicationResponse -> CreateApplicationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateApplicationResponse -> CreateApplicationResponse -> Bool
$c/= :: CreateApplicationResponse -> CreateApplicationResponse -> Bool
== :: CreateApplicationResponse -> CreateApplicationResponse -> Bool
$c== :: CreateApplicationResponse -> CreateApplicationResponse -> Bool
Prelude.Eq, ReadPrec [CreateApplicationResponse]
ReadPrec CreateApplicationResponse
Int -> ReadS CreateApplicationResponse
ReadS [CreateApplicationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateApplicationResponse]
$creadListPrec :: ReadPrec [CreateApplicationResponse]
readPrec :: ReadPrec CreateApplicationResponse
$creadPrec :: ReadPrec CreateApplicationResponse
readList :: ReadS [CreateApplicationResponse]
$creadList :: ReadS [CreateApplicationResponse]
readsPrec :: Int -> ReadS CreateApplicationResponse
$creadsPrec :: Int -> ReadS CreateApplicationResponse
Prelude.Read, Int -> CreateApplicationResponse -> ShowS
[CreateApplicationResponse] -> ShowS
CreateApplicationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateApplicationResponse] -> ShowS
$cshowList :: [CreateApplicationResponse] -> ShowS
show :: CreateApplicationResponse -> String
$cshow :: CreateApplicationResponse -> String
showsPrec :: Int -> CreateApplicationResponse -> ShowS
$cshowsPrec :: Int -> CreateApplicationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateApplicationResponse x -> CreateApplicationResponse
forall x.
CreateApplicationResponse -> Rep CreateApplicationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateApplicationResponse x -> CreateApplicationResponse
$cfrom :: forall x.
CreateApplicationResponse -> Rep CreateApplicationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateApplicationResponse' 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', 'createApplicationResponse_httpStatus' - The response's http status code.
--
-- 'applicationDetail', 'createApplicationResponse_applicationDetail' - In response to your @CreateApplication@ request, Kinesis Data Analytics
-- returns a response with details of the application it created.
newCreateApplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'applicationDetail'
  ApplicationDetail ->
  CreateApplicationResponse
newCreateApplicationResponse :: Int -> ApplicationDetail -> CreateApplicationResponse
newCreateApplicationResponse
  Int
pHttpStatus_
  ApplicationDetail
pApplicationDetail_ =
    CreateApplicationResponse'
      { $sel:httpStatus:CreateApplicationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:applicationDetail:CreateApplicationResponse' :: ApplicationDetail
applicationDetail = ApplicationDetail
pApplicationDetail_
      }

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

-- | In response to your @CreateApplication@ request, Kinesis Data Analytics
-- returns a response with details of the application it created.
createApplicationResponse_applicationDetail :: Lens.Lens' CreateApplicationResponse ApplicationDetail
createApplicationResponse_applicationDetail :: Lens' CreateApplicationResponse ApplicationDetail
createApplicationResponse_applicationDetail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {ApplicationDetail
applicationDetail :: ApplicationDetail
$sel:applicationDetail:CreateApplicationResponse' :: CreateApplicationResponse -> ApplicationDetail
applicationDetail} -> ApplicationDetail
applicationDetail) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} ApplicationDetail
a -> CreateApplicationResponse
s {$sel:applicationDetail:CreateApplicationResponse' :: ApplicationDetail
applicationDetail = ApplicationDetail
a} :: CreateApplicationResponse)

instance Prelude.NFData CreateApplicationResponse where
  rnf :: CreateApplicationResponse -> ()
rnf CreateApplicationResponse' {Int
ApplicationDetail
applicationDetail :: ApplicationDetail
httpStatus :: Int
$sel:applicationDetail:CreateApplicationResponse' :: CreateApplicationResponse -> ApplicationDetail
$sel:httpStatus:CreateApplicationResponse' :: CreateApplicationResponse -> 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