{-# 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.UpdateApp
-- 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 a specified app.
--
-- __Required Permissions__: To use this action, an IAM user must have a
-- Deploy or 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.UpdateApp
  ( -- * Creating a Request
    UpdateApp (..),
    newUpdateApp,

    -- * Request Lenses
    updateApp_appSource,
    updateApp_attributes,
    updateApp_dataSources,
    updateApp_description,
    updateApp_domains,
    updateApp_enableSsl,
    updateApp_environment,
    updateApp_name,
    updateApp_sslConfiguration,
    updateApp_type,
    updateApp_appId,

    -- * Destructuring the Response
    UpdateAppResponse (..),
    newUpdateAppResponse,
  )
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:/ 'newUpdateApp' smart constructor.
data UpdateApp = UpdateApp'
  { -- | A @Source@ object that specifies the app repository.
    UpdateApp -> Maybe Source
appSource :: Prelude.Maybe Source,
    -- | One or more user-defined key\/value pairs to be added to the stack
    -- attributes.
    UpdateApp -> Maybe (HashMap AppAttributesKeys Text)
attributes :: Prelude.Maybe (Prelude.HashMap AppAttributesKeys Prelude.Text),
    -- | The app\'s data sources.
    UpdateApp -> Maybe [DataSource]
dataSources :: Prelude.Maybe [DataSource],
    -- | A description of the app.
    UpdateApp -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The app\'s virtual host settings, with multiple domains separated by
    -- commas. For example: @\'www.example.com, example.com\'@
    UpdateApp -> Maybe [Text]
domains :: Prelude.Maybe [Prelude.Text],
    -- | Whether SSL is enabled for the app.
    UpdateApp -> 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 instances.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 20 KB).\"
    --
    -- If you have specified one or more environment variables, you cannot
    -- modify the stack\'s Chef version.
    UpdateApp -> Maybe [EnvironmentVariable]
environment :: Prelude.Maybe [EnvironmentVariable],
    -- | The app name.
    UpdateApp -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | An @SslConfiguration@ object with the SSL configuration.
    UpdateApp -> Maybe SslConfiguration
sslConfiguration :: Prelude.Maybe SslConfiguration,
    -- | The app type.
    UpdateApp -> Maybe AppType
type' :: Prelude.Maybe AppType,
    -- | The app ID.
    UpdateApp -> Text
appId :: Prelude.Text
  }
  deriving (UpdateApp -> UpdateApp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateApp -> UpdateApp -> Bool
$c/= :: UpdateApp -> UpdateApp -> Bool
== :: UpdateApp -> UpdateApp -> Bool
$c== :: UpdateApp -> UpdateApp -> Bool
Prelude.Eq, ReadPrec [UpdateApp]
ReadPrec UpdateApp
Int -> ReadS UpdateApp
ReadS [UpdateApp]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateApp]
$creadListPrec :: ReadPrec [UpdateApp]
readPrec :: ReadPrec UpdateApp
$creadPrec :: ReadPrec UpdateApp
readList :: ReadS [UpdateApp]
$creadList :: ReadS [UpdateApp]
readsPrec :: Int -> ReadS UpdateApp
$creadsPrec :: Int -> ReadS UpdateApp
Prelude.Read, Int -> UpdateApp -> ShowS
[UpdateApp] -> ShowS
UpdateApp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateApp] -> ShowS
$cshowList :: [UpdateApp] -> ShowS
show :: UpdateApp -> String
$cshow :: UpdateApp -> String
showsPrec :: Int -> UpdateApp -> ShowS
$cshowsPrec :: Int -> UpdateApp -> ShowS
Prelude.Show, forall x. Rep UpdateApp x -> UpdateApp
forall x. UpdateApp -> Rep UpdateApp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateApp x -> UpdateApp
$cfrom :: forall x. UpdateApp -> Rep UpdateApp x
Prelude.Generic)

-- |
-- Create a value of 'UpdateApp' 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', 'updateApp_appSource' - A @Source@ object that specifies the app repository.
--
-- 'attributes', 'updateApp_attributes' - One or more user-defined key\/value pairs to be added to the stack
-- attributes.
--
-- 'dataSources', 'updateApp_dataSources' - The app\'s data sources.
--
-- 'description', 'updateApp_description' - A description of the app.
--
-- 'domains', 'updateApp_domains' - The app\'s virtual host settings, with multiple domains separated by
-- commas. For example: @\'www.example.com, example.com\'@
--
-- 'enableSsl', 'updateApp_enableSsl' - Whether SSL is enabled for the app.
--
-- 'environment', 'updateApp_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 instances.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 20 KB).\"
--
-- If you have specified one or more environment variables, you cannot
-- modify the stack\'s Chef version.
--
-- 'name', 'updateApp_name' - The app name.
--
-- 'sslConfiguration', 'updateApp_sslConfiguration' - An @SslConfiguration@ object with the SSL configuration.
--
-- 'type'', 'updateApp_type' - The app type.
--
-- 'appId', 'updateApp_appId' - The app ID.
newUpdateApp ::
  -- | 'appId'
  Prelude.Text ->
  UpdateApp
newUpdateApp :: Text -> UpdateApp
newUpdateApp Text
pAppId_ =
  UpdateApp'
    { $sel:appSource:UpdateApp' :: Maybe Source
appSource = forall a. Maybe a
Prelude.Nothing,
      $sel:attributes:UpdateApp' :: Maybe (HashMap AppAttributesKeys Text)
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:dataSources:UpdateApp' :: Maybe [DataSource]
dataSources = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateApp' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:domains:UpdateApp' :: Maybe [Text]
domains = forall a. Maybe a
Prelude.Nothing,
      $sel:enableSsl:UpdateApp' :: Maybe Bool
enableSsl = forall a. Maybe a
Prelude.Nothing,
      $sel:environment:UpdateApp' :: Maybe [EnvironmentVariable]
environment = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateApp' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:sslConfiguration:UpdateApp' :: Maybe SslConfiguration
sslConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:type':UpdateApp' :: Maybe AppType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:appId:UpdateApp' :: Text
appId = Text
pAppId_
    }

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

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

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

-- | 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 instances.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 20 KB).\"
--
-- If you have specified one or more environment variables, you cannot
-- modify the stack\'s Chef version.
updateApp_environment :: Lens.Lens' UpdateApp (Prelude.Maybe [EnvironmentVariable])
updateApp_environment :: Lens' UpdateApp (Maybe [EnvironmentVariable])
updateApp_environment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApp' {Maybe [EnvironmentVariable]
environment :: Maybe [EnvironmentVariable]
$sel:environment:UpdateApp' :: UpdateApp -> Maybe [EnvironmentVariable]
environment} -> Maybe [EnvironmentVariable]
environment) (\s :: UpdateApp
s@UpdateApp' {} Maybe [EnvironmentVariable]
a -> UpdateApp
s {$sel:environment:UpdateApp' :: Maybe [EnvironmentVariable]
environment = Maybe [EnvironmentVariable]
a} :: UpdateApp) 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 name.
updateApp_name :: Lens.Lens' UpdateApp (Prelude.Maybe Prelude.Text)
updateApp_name :: Lens' UpdateApp (Maybe Text)
updateApp_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApp' {Maybe Text
name :: Maybe Text
$sel:name:UpdateApp' :: UpdateApp -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateApp
s@UpdateApp' {} Maybe Text
a -> UpdateApp
s {$sel:name:UpdateApp' :: Maybe Text
name = Maybe Text
a} :: UpdateApp)

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

-- | The app type.
updateApp_type :: Lens.Lens' UpdateApp (Prelude.Maybe AppType)
updateApp_type :: Lens' UpdateApp (Maybe AppType)
updateApp_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApp' {Maybe AppType
type' :: Maybe AppType
$sel:type':UpdateApp' :: UpdateApp -> Maybe AppType
type'} -> Maybe AppType
type') (\s :: UpdateApp
s@UpdateApp' {} Maybe AppType
a -> UpdateApp
s {$sel:type':UpdateApp' :: Maybe AppType
type' = Maybe AppType
a} :: UpdateApp)

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

instance Core.AWSRequest UpdateApp where
  type AWSResponse UpdateApp = UpdateAppResponse
  request :: (Service -> Service) -> UpdateApp -> Request UpdateApp
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 UpdateApp
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateApp)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UpdateAppResponse
UpdateAppResponse'

instance Prelude.Hashable UpdateApp where
  hashWithSalt :: Int -> UpdateApp -> Int
hashWithSalt Int
_salt UpdateApp' {Maybe Bool
Maybe [Text]
Maybe [DataSource]
Maybe [EnvironmentVariable]
Maybe Text
Maybe (HashMap AppAttributesKeys Text)
Maybe AppType
Maybe Source
Maybe SslConfiguration
Text
appId :: Text
type' :: Maybe AppType
sslConfiguration :: Maybe SslConfiguration
name :: 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:appId:UpdateApp' :: UpdateApp -> Text
$sel:type':UpdateApp' :: UpdateApp -> Maybe AppType
$sel:sslConfiguration:UpdateApp' :: UpdateApp -> Maybe SslConfiguration
$sel:name:UpdateApp' :: UpdateApp -> Maybe Text
$sel:environment:UpdateApp' :: UpdateApp -> Maybe [EnvironmentVariable]
$sel:enableSsl:UpdateApp' :: UpdateApp -> Maybe Bool
$sel:domains:UpdateApp' :: UpdateApp -> Maybe [Text]
$sel:description:UpdateApp' :: UpdateApp -> Maybe Text
$sel:dataSources:UpdateApp' :: UpdateApp -> Maybe [DataSource]
$sel:attributes:UpdateApp' :: UpdateApp -> Maybe (HashMap AppAttributesKeys Text)
$sel:appSource:UpdateApp' :: UpdateApp -> 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
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SslConfiguration
sslConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AppType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
appId

instance Prelude.NFData UpdateApp where
  rnf :: UpdateApp -> ()
rnf UpdateApp' {Maybe Bool
Maybe [Text]
Maybe [DataSource]
Maybe [EnvironmentVariable]
Maybe Text
Maybe (HashMap AppAttributesKeys Text)
Maybe AppType
Maybe Source
Maybe SslConfiguration
Text
appId :: Text
type' :: Maybe AppType
sslConfiguration :: Maybe SslConfiguration
name :: 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:appId:UpdateApp' :: UpdateApp -> Text
$sel:type':UpdateApp' :: UpdateApp -> Maybe AppType
$sel:sslConfiguration:UpdateApp' :: UpdateApp -> Maybe SslConfiguration
$sel:name:UpdateApp' :: UpdateApp -> Maybe Text
$sel:environment:UpdateApp' :: UpdateApp -> Maybe [EnvironmentVariable]
$sel:enableSsl:UpdateApp' :: UpdateApp -> Maybe Bool
$sel:domains:UpdateApp' :: UpdateApp -> Maybe [Text]
$sel:description:UpdateApp' :: UpdateApp -> Maybe Text
$sel:dataSources:UpdateApp' :: UpdateApp -> Maybe [DataSource]
$sel:attributes:UpdateApp' :: UpdateApp -> Maybe (HashMap AppAttributesKeys Text)
$sel:appSource:UpdateApp' :: UpdateApp -> 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
name
      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 Maybe AppType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
appId

instance Data.ToHeaders UpdateApp where
  toHeaders :: UpdateApp -> [Header]
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 -> [Header]
Data.=# ( ByteString
"OpsWorks_20130218.UpdateApp" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateApp where
  toJSON :: UpdateApp -> Value
toJSON UpdateApp' {Maybe Bool
Maybe [Text]
Maybe [DataSource]
Maybe [EnvironmentVariable]
Maybe Text
Maybe (HashMap AppAttributesKeys Text)
Maybe AppType
Maybe Source
Maybe SslConfiguration
Text
appId :: Text
type' :: Maybe AppType
sslConfiguration :: Maybe SslConfiguration
name :: 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:appId:UpdateApp' :: UpdateApp -> Text
$sel:type':UpdateApp' :: UpdateApp -> Maybe AppType
$sel:sslConfiguration:UpdateApp' :: UpdateApp -> Maybe SslConfiguration
$sel:name:UpdateApp' :: UpdateApp -> Maybe Text
$sel:environment:UpdateApp' :: UpdateApp -> Maybe [EnvironmentVariable]
$sel:enableSsl:UpdateApp' :: UpdateApp -> Maybe Bool
$sel:domains:UpdateApp' :: UpdateApp -> Maybe [Text]
$sel:description:UpdateApp' :: UpdateApp -> Maybe Text
$sel:dataSources:UpdateApp' :: UpdateApp -> Maybe [DataSource]
$sel:attributes:UpdateApp' :: UpdateApp -> Maybe (HashMap AppAttributesKeys Text)
$sel:appSource:UpdateApp' :: UpdateApp -> 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
"Name" 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
name,
            (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,
            (Key
"Type" 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 AppType
type',
            forall a. a -> Maybe a
Prelude.Just (Key
"AppId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
appId)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateAppResponse' 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.
newUpdateAppResponse ::
  UpdateAppResponse
newUpdateAppResponse :: UpdateAppResponse
newUpdateAppResponse = UpdateAppResponse
UpdateAppResponse'

instance Prelude.NFData UpdateAppResponse where
  rnf :: UpdateAppResponse -> ()
rnf UpdateAppResponse
_ = ()