{-# 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.OpsWorks.CreateApp
-- 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 an app for a specified stack. For more information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingapps-creating.html Creating Apps>.
--
-- __Required Permissions__: To use this action, an IAM user must have a
-- Manage permissions level for the stack, or an attached policy that
-- explicitly grants permissions. For more information on user permissions,
-- see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/opsworks-security-users.html Managing User Permissions>.
module Amazonka.OpsWorks.CreateApp
  ( -- * Creating a Request
    CreateApp (..),
    newCreateApp,

    -- * Request Lenses
    createApp_appSource,
    createApp_attributes,
    createApp_dataSources,
    createApp_description,
    createApp_domains,
    createApp_enableSsl,
    createApp_environment,
    createApp_shortname,
    createApp_sslConfiguration,
    createApp_stackId,
    createApp_name,
    createApp_type,

    -- * Destructuring the Response
    CreateAppResponse (..),
    newCreateAppResponse,

    -- * Response Lenses
    createAppResponse_appId,
    createAppResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.OpsWorks.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateApp' smart constructor.
data CreateApp = CreateApp'
  { -- | A @Source@ object that specifies the app repository.
    CreateApp -> Maybe Source
appSource :: Prelude.Maybe Source,
    -- | One or more user-defined key\/value pairs to be added to the stack
    -- attributes.
    CreateApp -> Maybe (HashMap AppAttributesKeys Text)
attributes :: Prelude.Maybe (Prelude.HashMap AppAttributesKeys Prelude.Text),
    -- | The app\'s data source.
    CreateApp -> Maybe [DataSource]
dataSources :: Prelude.Maybe [DataSource],
    -- | A description of the app.
    CreateApp -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The app virtual host settings, with multiple domains separated by
    -- commas. For example: @\'www.example.com, example.com\'@
    CreateApp -> Maybe [Text]
domains :: Prelude.Maybe [Prelude.Text],
    -- | Whether to enable SSL for the app.
    CreateApp -> Maybe Bool
enableSsl :: Prelude.Maybe Prelude.Bool,
    -- | An array of @EnvironmentVariable@ objects that specify environment
    -- variables to be associated with the app. After you deploy the app, these
    -- variables are defined on the associated app server instance. For more
    -- information, see
    -- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingapps-creating.html#workingapps-creating-environment Environment Variables>.
    --
    -- There is no specific limit on the number of environment variables.
    -- However, the size of the associated data structure - which includes the
    -- variables\' names, values, and protected flag values - cannot exceed 20
    -- KB. This limit should accommodate most if not all use cases. Exceeding
    -- it will cause an exception with the message, \"Environment: is too large
    -- (maximum is 20KB).\"
    --
    -- If you have specified one or more environment variables, you cannot
    -- modify the stack\'s Chef version.
    CreateApp -> Maybe [EnvironmentVariable]
environment :: Prelude.Maybe [EnvironmentVariable],
    -- | The app\'s short name.
    CreateApp -> Maybe Text
shortname :: Prelude.Maybe Prelude.Text,
    -- | An @SslConfiguration@ object with the SSL configuration.
    CreateApp -> Maybe SslConfiguration
sslConfiguration :: Prelude.Maybe SslConfiguration,
    -- | The stack ID.
    CreateApp -> Text
stackId :: Prelude.Text,
    -- | The app name.
    CreateApp -> Text
name :: Prelude.Text,
    -- | The app type. Each supported type is associated with a particular layer.
    -- For example, PHP applications are associated with a PHP layer. AWS
    -- OpsWorks Stacks deploys an application to those instances that are
    -- members of the corresponding layer. If your app isn\'t one of the
    -- standard types, or you prefer to implement your own Deploy recipes,
    -- specify @other@.
    CreateApp -> AppType
type' :: AppType
  }
  deriving (CreateApp -> CreateApp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateApp -> CreateApp -> Bool
$c/= :: CreateApp -> CreateApp -> Bool
== :: CreateApp -> CreateApp -> Bool
$c== :: CreateApp -> CreateApp -> Bool
Prelude.Eq, ReadPrec [CreateApp]
ReadPrec CreateApp
Int -> ReadS CreateApp
ReadS [CreateApp]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateApp]
$creadListPrec :: ReadPrec [CreateApp]
readPrec :: ReadPrec CreateApp
$creadPrec :: ReadPrec CreateApp
readList :: ReadS [CreateApp]
$creadList :: ReadS [CreateApp]
readsPrec :: Int -> ReadS CreateApp
$creadsPrec :: Int -> ReadS CreateApp
Prelude.Read, Int -> CreateApp -> ShowS
[CreateApp] -> ShowS
CreateApp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateApp] -> ShowS
$cshowList :: [CreateApp] -> ShowS
show :: CreateApp -> String
$cshow :: CreateApp -> String
showsPrec :: Int -> CreateApp -> ShowS
$cshowsPrec :: Int -> CreateApp -> ShowS
Prelude.Show, forall x. Rep CreateApp x -> CreateApp
forall x. CreateApp -> Rep CreateApp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateApp x -> CreateApp
$cfrom :: forall x. CreateApp -> Rep CreateApp x
Prelude.Generic)

-- |
-- Create a value of 'CreateApp' 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:
--
-- 'appSource', 'createApp_appSource' - A @Source@ object that specifies the app repository.
--
-- 'attributes', 'createApp_attributes' - One or more user-defined key\/value pairs to be added to the stack
-- attributes.
--
-- 'dataSources', 'createApp_dataSources' - The app\'s data source.
--
-- 'description', 'createApp_description' - A description of the app.
--
-- 'domains', 'createApp_domains' - The app virtual host settings, with multiple domains separated by
-- commas. For example: @\'www.example.com, example.com\'@
--
-- 'enableSsl', 'createApp_enableSsl' - Whether to enable SSL for the app.
--
-- 'environment', 'createApp_environment' - An array of @EnvironmentVariable@ objects that specify environment
-- variables to be associated with the app. After you deploy the app, these
-- variables are defined on the associated app server instance. For more
-- information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingapps-creating.html#workingapps-creating-environment Environment Variables>.
--
-- There is no specific limit on the number of environment variables.
-- However, the size of the associated data structure - which includes the
-- variables\' names, values, and protected flag values - cannot exceed 20
-- KB. This limit should accommodate most if not all use cases. Exceeding
-- it will cause an exception with the message, \"Environment: is too large
-- (maximum is 20KB).\"
--
-- If you have specified one or more environment variables, you cannot
-- modify the stack\'s Chef version.
--
-- 'shortname', 'createApp_shortname' - The app\'s short name.
--
-- 'sslConfiguration', 'createApp_sslConfiguration' - An @SslConfiguration@ object with the SSL configuration.
--
-- 'stackId', 'createApp_stackId' - The stack ID.
--
-- 'name', 'createApp_name' - The app name.
--
-- 'type'', 'createApp_type' - The app type. Each supported type is associated with a particular layer.
-- For example, PHP applications are associated with a PHP layer. AWS
-- OpsWorks Stacks deploys an application to those instances that are
-- members of the corresponding layer. If your app isn\'t one of the
-- standard types, or you prefer to implement your own Deploy recipes,
-- specify @other@.
newCreateApp ::
  -- | 'stackId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'type''
  AppType ->
  CreateApp
newCreateApp :: Text -> Text -> AppType -> CreateApp
newCreateApp Text
pStackId_ Text
pName_ AppType
pType_ =
  CreateApp'
    { $sel:appSource:CreateApp' :: Maybe Source
appSource = forall a. Maybe a
Prelude.Nothing,
      $sel:attributes:CreateApp' :: Maybe (HashMap AppAttributesKeys Text)
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:dataSources:CreateApp' :: Maybe [DataSource]
dataSources = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateApp' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:domains:CreateApp' :: Maybe [Text]
domains = forall a. Maybe a
Prelude.Nothing,
      $sel:enableSsl:CreateApp' :: Maybe Bool
enableSsl = forall a. Maybe a
Prelude.Nothing,
      $sel:environment:CreateApp' :: Maybe [EnvironmentVariable]
environment = forall a. Maybe a
Prelude.Nothing,
      $sel:shortname:CreateApp' :: Maybe Text
shortname = forall a. Maybe a
Prelude.Nothing,
      $sel:sslConfiguration:CreateApp' :: Maybe SslConfiguration
sslConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:stackId:CreateApp' :: Text
stackId = Text
pStackId_,
      $sel:name:CreateApp' :: Text
name = Text
pName_,
      $sel:type':CreateApp' :: AppType
type' = AppType
pType_
    }

-- | A @Source@ object that specifies the app repository.
createApp_appSource :: Lens.Lens' CreateApp (Prelude.Maybe Source)
createApp_appSource :: Lens' CreateApp (Maybe Source)
createApp_appSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApp' {Maybe Source
appSource :: Maybe Source
$sel:appSource:CreateApp' :: CreateApp -> Maybe Source
appSource} -> Maybe Source
appSource) (\s :: CreateApp
s@CreateApp' {} Maybe Source
a -> CreateApp
s {$sel:appSource:CreateApp' :: Maybe Source
appSource = Maybe Source
a} :: CreateApp)

-- | One or more user-defined key\/value pairs to be added to the stack
-- attributes.
createApp_attributes :: Lens.Lens' CreateApp (Prelude.Maybe (Prelude.HashMap AppAttributesKeys Prelude.Text))
createApp_attributes :: Lens' CreateApp (Maybe (HashMap AppAttributesKeys Text))
createApp_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApp' {Maybe (HashMap AppAttributesKeys Text)
attributes :: Maybe (HashMap AppAttributesKeys Text)
$sel:attributes:CreateApp' :: CreateApp -> Maybe (HashMap AppAttributesKeys Text)
attributes} -> Maybe (HashMap AppAttributesKeys Text)
attributes) (\s :: CreateApp
s@CreateApp' {} Maybe (HashMap AppAttributesKeys Text)
a -> CreateApp
s {$sel:attributes:CreateApp' :: Maybe (HashMap AppAttributesKeys Text)
attributes = Maybe (HashMap AppAttributesKeys Text)
a} :: CreateApp) 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 app\'s data source.
createApp_dataSources :: Lens.Lens' CreateApp (Prelude.Maybe [DataSource])
createApp_dataSources :: Lens' CreateApp (Maybe [DataSource])
createApp_dataSources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApp' {Maybe [DataSource]
dataSources :: Maybe [DataSource]
$sel:dataSources:CreateApp' :: CreateApp -> Maybe [DataSource]
dataSources} -> Maybe [DataSource]
dataSources) (\s :: CreateApp
s@CreateApp' {} Maybe [DataSource]
a -> CreateApp
s {$sel:dataSources:CreateApp' :: Maybe [DataSource]
dataSources = Maybe [DataSource]
a} :: CreateApp) 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 description of the app.
createApp_description :: Lens.Lens' CreateApp (Prelude.Maybe Prelude.Text)
createApp_description :: Lens' CreateApp (Maybe Text)
createApp_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApp' {Maybe Text
description :: Maybe Text
$sel:description:CreateApp' :: CreateApp -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateApp
s@CreateApp' {} Maybe Text
a -> CreateApp
s {$sel:description:CreateApp' :: Maybe Text
description = Maybe Text
a} :: CreateApp)

-- | The app virtual host settings, with multiple domains separated by
-- commas. For example: @\'www.example.com, example.com\'@
createApp_domains :: Lens.Lens' CreateApp (Prelude.Maybe [Prelude.Text])
createApp_domains :: Lens' CreateApp (Maybe [Text])
createApp_domains = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApp' {Maybe [Text]
domains :: Maybe [Text]
$sel:domains:CreateApp' :: CreateApp -> Maybe [Text]
domains} -> Maybe [Text]
domains) (\s :: CreateApp
s@CreateApp' {} Maybe [Text]
a -> CreateApp
s {$sel:domains:CreateApp' :: Maybe [Text]
domains = Maybe [Text]
a} :: CreateApp) 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

-- | Whether to enable SSL for the app.
createApp_enableSsl :: Lens.Lens' CreateApp (Prelude.Maybe Prelude.Bool)
createApp_enableSsl :: Lens' CreateApp (Maybe Bool)
createApp_enableSsl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApp' {Maybe Bool
enableSsl :: Maybe Bool
$sel:enableSsl:CreateApp' :: CreateApp -> Maybe Bool
enableSsl} -> Maybe Bool
enableSsl) (\s :: CreateApp
s@CreateApp' {} Maybe Bool
a -> CreateApp
s {$sel:enableSsl:CreateApp' :: Maybe Bool
enableSsl = Maybe Bool
a} :: CreateApp)

-- | An array of @EnvironmentVariable@ objects that specify environment
-- variables to be associated with the app. After you deploy the app, these
-- variables are defined on the associated app server instance. For more
-- information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingapps-creating.html#workingapps-creating-environment Environment Variables>.
--
-- There is no specific limit on the number of environment variables.
-- However, the size of the associated data structure - which includes the
-- variables\' names, values, and protected flag values - cannot exceed 20
-- KB. This limit should accommodate most if not all use cases. Exceeding
-- it will cause an exception with the message, \"Environment: is too large
-- (maximum is 20KB).\"
--
-- If you have specified one or more environment variables, you cannot
-- modify the stack\'s Chef version.
createApp_environment :: Lens.Lens' CreateApp (Prelude.Maybe [EnvironmentVariable])
createApp_environment :: Lens' CreateApp (Maybe [EnvironmentVariable])
createApp_environment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApp' {Maybe [EnvironmentVariable]
environment :: Maybe [EnvironmentVariable]
$sel:environment:CreateApp' :: CreateApp -> Maybe [EnvironmentVariable]
environment} -> Maybe [EnvironmentVariable]
environment) (\s :: CreateApp
s@CreateApp' {} Maybe [EnvironmentVariable]
a -> CreateApp
s {$sel:environment:CreateApp' :: Maybe [EnvironmentVariable]
environment = Maybe [EnvironmentVariable]
a} :: CreateApp) 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 app\'s short name.
createApp_shortname :: Lens.Lens' CreateApp (Prelude.Maybe Prelude.Text)
createApp_shortname :: Lens' CreateApp (Maybe Text)
createApp_shortname = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApp' {Maybe Text
shortname :: Maybe Text
$sel:shortname:CreateApp' :: CreateApp -> Maybe Text
shortname} -> Maybe Text
shortname) (\s :: CreateApp
s@CreateApp' {} Maybe Text
a -> CreateApp
s {$sel:shortname:CreateApp' :: Maybe Text
shortname = Maybe Text
a} :: CreateApp)

-- | An @SslConfiguration@ object with the SSL configuration.
createApp_sslConfiguration :: Lens.Lens' CreateApp (Prelude.Maybe SslConfiguration)
createApp_sslConfiguration :: Lens' CreateApp (Maybe SslConfiguration)
createApp_sslConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApp' {Maybe SslConfiguration
sslConfiguration :: Maybe SslConfiguration
$sel:sslConfiguration:CreateApp' :: CreateApp -> Maybe SslConfiguration
sslConfiguration} -> Maybe SslConfiguration
sslConfiguration) (\s :: CreateApp
s@CreateApp' {} Maybe SslConfiguration
a -> CreateApp
s {$sel:sslConfiguration:CreateApp' :: Maybe SslConfiguration
sslConfiguration = Maybe SslConfiguration
a} :: CreateApp)

-- | The stack ID.
createApp_stackId :: Lens.Lens' CreateApp Prelude.Text
createApp_stackId :: Lens' CreateApp Text
createApp_stackId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApp' {Text
stackId :: Text
$sel:stackId:CreateApp' :: CreateApp -> Text
stackId} -> Text
stackId) (\s :: CreateApp
s@CreateApp' {} Text
a -> CreateApp
s {$sel:stackId:CreateApp' :: Text
stackId = Text
a} :: CreateApp)

-- | The app name.
createApp_name :: Lens.Lens' CreateApp Prelude.Text
createApp_name :: Lens' CreateApp Text
createApp_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApp' {Text
name :: Text
$sel:name:CreateApp' :: CreateApp -> Text
name} -> Text
name) (\s :: CreateApp
s@CreateApp' {} Text
a -> CreateApp
s {$sel:name:CreateApp' :: Text
name = Text
a} :: CreateApp)

-- | The app type. Each supported type is associated with a particular layer.
-- For example, PHP applications are associated with a PHP layer. AWS
-- OpsWorks Stacks deploys an application to those instances that are
-- members of the corresponding layer. If your app isn\'t one of the
-- standard types, or you prefer to implement your own Deploy recipes,
-- specify @other@.
createApp_type :: Lens.Lens' CreateApp AppType
createApp_type :: Lens' CreateApp AppType
createApp_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApp' {AppType
type' :: AppType
$sel:type':CreateApp' :: CreateApp -> AppType
type'} -> AppType
type') (\s :: CreateApp
s@CreateApp' {} AppType
a -> CreateApp
s {$sel:type':CreateApp' :: AppType
type' = AppType
a} :: CreateApp)

instance Core.AWSRequest CreateApp where
  type AWSResponse CreateApp = CreateAppResponse
  request :: (Service -> Service) -> CreateApp -> Request CreateApp
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 CreateApp
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateApp)))
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 -> Int -> CreateAppResponse
CreateAppResponse'
            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
"AppId")
            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 CreateApp where
  hashWithSalt :: Int -> CreateApp -> Int
hashWithSalt Int
_salt CreateApp' {Maybe Bool
Maybe [Text]
Maybe [DataSource]
Maybe [EnvironmentVariable]
Maybe Text
Maybe (HashMap AppAttributesKeys Text)
Maybe Source
Maybe SslConfiguration
Text
AppType
type' :: AppType
name :: Text
stackId :: Text
sslConfiguration :: Maybe SslConfiguration
shortname :: Maybe Text
environment :: Maybe [EnvironmentVariable]
enableSsl :: Maybe Bool
domains :: Maybe [Text]
description :: Maybe Text
dataSources :: Maybe [DataSource]
attributes :: Maybe (HashMap AppAttributesKeys Text)
appSource :: Maybe Source
$sel:type':CreateApp' :: CreateApp -> AppType
$sel:name:CreateApp' :: CreateApp -> Text
$sel:stackId:CreateApp' :: CreateApp -> Text
$sel:sslConfiguration:CreateApp' :: CreateApp -> Maybe SslConfiguration
$sel:shortname:CreateApp' :: CreateApp -> Maybe Text
$sel:environment:CreateApp' :: CreateApp -> Maybe [EnvironmentVariable]
$sel:enableSsl:CreateApp' :: CreateApp -> Maybe Bool
$sel:domains:CreateApp' :: CreateApp -> Maybe [Text]
$sel:description:CreateApp' :: CreateApp -> Maybe Text
$sel:dataSources:CreateApp' :: CreateApp -> Maybe [DataSource]
$sel:attributes:CreateApp' :: CreateApp -> Maybe (HashMap AppAttributesKeys Text)
$sel:appSource:CreateApp' :: CreateApp -> Maybe Source
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Source
appSource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap AppAttributesKeys Text)
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DataSource]
dataSources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
domains
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableSsl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [EnvironmentVariable]
environment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
shortname
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SslConfiguration
sslConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AppType
type'

instance Prelude.NFData CreateApp where
  rnf :: CreateApp -> ()
rnf CreateApp' {Maybe Bool
Maybe [Text]
Maybe [DataSource]
Maybe [EnvironmentVariable]
Maybe Text
Maybe (HashMap AppAttributesKeys Text)
Maybe Source
Maybe SslConfiguration
Text
AppType
type' :: AppType
name :: Text
stackId :: Text
sslConfiguration :: Maybe SslConfiguration
shortname :: Maybe Text
environment :: Maybe [EnvironmentVariable]
enableSsl :: Maybe Bool
domains :: Maybe [Text]
description :: Maybe Text
dataSources :: Maybe [DataSource]
attributes :: Maybe (HashMap AppAttributesKeys Text)
appSource :: Maybe Source
$sel:type':CreateApp' :: CreateApp -> AppType
$sel:name:CreateApp' :: CreateApp -> Text
$sel:stackId:CreateApp' :: CreateApp -> Text
$sel:sslConfiguration:CreateApp' :: CreateApp -> Maybe SslConfiguration
$sel:shortname:CreateApp' :: CreateApp -> Maybe Text
$sel:environment:CreateApp' :: CreateApp -> Maybe [EnvironmentVariable]
$sel:enableSsl:CreateApp' :: CreateApp -> Maybe Bool
$sel:domains:CreateApp' :: CreateApp -> Maybe [Text]
$sel:description:CreateApp' :: CreateApp -> Maybe Text
$sel:dataSources:CreateApp' :: CreateApp -> Maybe [DataSource]
$sel:attributes:CreateApp' :: CreateApp -> Maybe (HashMap AppAttributesKeys Text)
$sel:appSource:CreateApp' :: CreateApp -> Maybe Source
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Source
appSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap AppAttributesKeys Text)
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [DataSource]
dataSources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
domains
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableSsl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [EnvironmentVariable]
environment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
shortname
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SslConfiguration
sslConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stackId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AppType
type'

instance Data.ToHeaders CreateApp where
  toHeaders :: CreateApp -> 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
"OpsWorks_20130218.CreateApp" ::
                          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 CreateApp where
  toJSON :: CreateApp -> Value
toJSON CreateApp' {Maybe Bool
Maybe [Text]
Maybe [DataSource]
Maybe [EnvironmentVariable]
Maybe Text
Maybe (HashMap AppAttributesKeys Text)
Maybe Source
Maybe SslConfiguration
Text
AppType
type' :: AppType
name :: Text
stackId :: Text
sslConfiguration :: Maybe SslConfiguration
shortname :: Maybe Text
environment :: Maybe [EnvironmentVariable]
enableSsl :: Maybe Bool
domains :: Maybe [Text]
description :: Maybe Text
dataSources :: Maybe [DataSource]
attributes :: Maybe (HashMap AppAttributesKeys Text)
appSource :: Maybe Source
$sel:type':CreateApp' :: CreateApp -> AppType
$sel:name:CreateApp' :: CreateApp -> Text
$sel:stackId:CreateApp' :: CreateApp -> Text
$sel:sslConfiguration:CreateApp' :: CreateApp -> Maybe SslConfiguration
$sel:shortname:CreateApp' :: CreateApp -> Maybe Text
$sel:environment:CreateApp' :: CreateApp -> Maybe [EnvironmentVariable]
$sel:enableSsl:CreateApp' :: CreateApp -> Maybe Bool
$sel:domains:CreateApp' :: CreateApp -> Maybe [Text]
$sel:description:CreateApp' :: CreateApp -> Maybe Text
$sel:dataSources:CreateApp' :: CreateApp -> Maybe [DataSource]
$sel:attributes:CreateApp' :: CreateApp -> Maybe (HashMap AppAttributesKeys Text)
$sel:appSource:CreateApp' :: CreateApp -> Maybe Source
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AppSource" 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 Source
appSource,
            (Key
"Attributes" 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 (HashMap AppAttributesKeys Text)
attributes,
            (Key
"DataSources" 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 [DataSource]
dataSources,
            (Key
"Description" 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
description,
            (Key
"Domains" 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]
domains,
            (Key
"EnableSsl" 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 Bool
enableSsl,
            (Key
"Environment" 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 [EnvironmentVariable]
environment,
            (Key
"Shortname" 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
shortname,
            (Key
"SslConfiguration" 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 SslConfiguration
sslConfiguration,
            forall a. a -> Maybe a
Prelude.Just (Key
"StackId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stackId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"Type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AppType
type')
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateAppResponse' 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:
--
-- 'appId', 'createAppResponse_appId' - The app ID.
--
-- 'httpStatus', 'createAppResponse_httpStatus' - The response's http status code.
newCreateAppResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateAppResponse
newCreateAppResponse :: Int -> CreateAppResponse
newCreateAppResponse Int
pHttpStatus_ =
  CreateAppResponse'
    { $sel:appId:CreateAppResponse' :: Maybe Text
appId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateAppResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The app ID.
createAppResponse_appId :: Lens.Lens' CreateAppResponse (Prelude.Maybe Prelude.Text)
createAppResponse_appId :: Lens' CreateAppResponse (Maybe Text)
createAppResponse_appId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAppResponse' {Maybe Text
appId :: Maybe Text
$sel:appId:CreateAppResponse' :: CreateAppResponse -> Maybe Text
appId} -> Maybe Text
appId) (\s :: CreateAppResponse
s@CreateAppResponse' {} Maybe Text
a -> CreateAppResponse
s {$sel:appId:CreateAppResponse' :: Maybe Text
appId = Maybe Text
a} :: CreateAppResponse)

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

instance Prelude.NFData CreateAppResponse where
  rnf :: CreateAppResponse -> ()
rnf CreateAppResponse' {Int
Maybe Text
httpStatus :: Int
appId :: Maybe Text
$sel:httpStatus:CreateAppResponse' :: CreateAppResponse -> Int
$sel:appId:CreateAppResponse' :: CreateAppResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
appId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus