{-# 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.AppConfig.CreateEnvironment
-- 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 environment. For each application, you define one or more
-- environments. An environment is a deployment group of AppConfig targets,
-- such as applications in a @Beta@ or @Production@ environment. You can
-- also define environments for application subcomponents such as the
-- @Web@, @Mobile@ and @Back-end@ components for your application. You can
-- configure Amazon CloudWatch alarms for each environment. The system
-- monitors alarms during a configuration deployment. If an alarm is
-- triggered, the system rolls back the configuration.
module Amazonka.AppConfig.CreateEnvironment
  ( -- * Creating a Request
    CreateEnvironment (..),
    newCreateEnvironment,

    -- * Request Lenses
    createEnvironment_description,
    createEnvironment_monitors,
    createEnvironment_tags,
    createEnvironment_applicationId,
    createEnvironment_name,

    -- * Destructuring the Response
    Environment (..),
    newEnvironment,

    -- * Response Lenses
    environment_applicationId,
    environment_description,
    environment_id,
    environment_monitors,
    environment_name,
    environment_state,
  )
where

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

-- | /See:/ 'newCreateEnvironment' smart constructor.
data CreateEnvironment = CreateEnvironment'
  { -- | A description of the environment.
    CreateEnvironment -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Amazon CloudWatch alarms to monitor during the deployment process.
    CreateEnvironment -> Maybe [Monitor]
monitors :: Prelude.Maybe [Monitor],
    -- | Metadata to assign to the environment. Tags help organize and categorize
    -- your AppConfig resources. Each tag consists of a key and an optional
    -- value, both of which you define.
    CreateEnvironment -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The application ID.
    CreateEnvironment -> Text
applicationId :: Prelude.Text,
    -- | A name for the environment.
    CreateEnvironment -> Text
name :: Prelude.Text
  }
  deriving (CreateEnvironment -> CreateEnvironment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEnvironment -> CreateEnvironment -> Bool
$c/= :: CreateEnvironment -> CreateEnvironment -> Bool
== :: CreateEnvironment -> CreateEnvironment -> Bool
$c== :: CreateEnvironment -> CreateEnvironment -> Bool
Prelude.Eq, ReadPrec [CreateEnvironment]
ReadPrec CreateEnvironment
Int -> ReadS CreateEnvironment
ReadS [CreateEnvironment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateEnvironment]
$creadListPrec :: ReadPrec [CreateEnvironment]
readPrec :: ReadPrec CreateEnvironment
$creadPrec :: ReadPrec CreateEnvironment
readList :: ReadS [CreateEnvironment]
$creadList :: ReadS [CreateEnvironment]
readsPrec :: Int -> ReadS CreateEnvironment
$creadsPrec :: Int -> ReadS CreateEnvironment
Prelude.Read, Int -> CreateEnvironment -> ShowS
[CreateEnvironment] -> ShowS
CreateEnvironment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEnvironment] -> ShowS
$cshowList :: [CreateEnvironment] -> ShowS
show :: CreateEnvironment -> String
$cshow :: CreateEnvironment -> String
showsPrec :: Int -> CreateEnvironment -> ShowS
$cshowsPrec :: Int -> CreateEnvironment -> ShowS
Prelude.Show, forall x. Rep CreateEnvironment x -> CreateEnvironment
forall x. CreateEnvironment -> Rep CreateEnvironment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateEnvironment x -> CreateEnvironment
$cfrom :: forall x. CreateEnvironment -> Rep CreateEnvironment x
Prelude.Generic)

-- |
-- Create a value of 'CreateEnvironment' 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:
--
-- 'description', 'createEnvironment_description' - A description of the environment.
--
-- 'monitors', 'createEnvironment_monitors' - Amazon CloudWatch alarms to monitor during the deployment process.
--
-- 'tags', 'createEnvironment_tags' - Metadata to assign to the environment. Tags help organize and categorize
-- your AppConfig resources. Each tag consists of a key and an optional
-- value, both of which you define.
--
-- 'applicationId', 'createEnvironment_applicationId' - The application ID.
--
-- 'name', 'createEnvironment_name' - A name for the environment.
newCreateEnvironment ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  CreateEnvironment
newCreateEnvironment :: Text -> Text -> CreateEnvironment
newCreateEnvironment Text
pApplicationId_ Text
pName_ =
  CreateEnvironment'
    { $sel:description:CreateEnvironment' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:monitors:CreateEnvironment' :: Maybe [Monitor]
monitors = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateEnvironment' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:applicationId:CreateEnvironment' :: Text
applicationId = Text
pApplicationId_,
      $sel:name:CreateEnvironment' :: Text
name = Text
pName_
    }

-- | A description of the environment.
createEnvironment_description :: Lens.Lens' CreateEnvironment (Prelude.Maybe Prelude.Text)
createEnvironment_description :: Lens' CreateEnvironment (Maybe Text)
createEnvironment_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {Maybe Text
description :: Maybe Text
$sel:description:CreateEnvironment' :: CreateEnvironment -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateEnvironment
s@CreateEnvironment' {} Maybe Text
a -> CreateEnvironment
s {$sel:description:CreateEnvironment' :: Maybe Text
description = Maybe Text
a} :: CreateEnvironment)

-- | Amazon CloudWatch alarms to monitor during the deployment process.
createEnvironment_monitors :: Lens.Lens' CreateEnvironment (Prelude.Maybe [Monitor])
createEnvironment_monitors :: Lens' CreateEnvironment (Maybe [Monitor])
createEnvironment_monitors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {Maybe [Monitor]
monitors :: Maybe [Monitor]
$sel:monitors:CreateEnvironment' :: CreateEnvironment -> Maybe [Monitor]
monitors} -> Maybe [Monitor]
monitors) (\s :: CreateEnvironment
s@CreateEnvironment' {} Maybe [Monitor]
a -> CreateEnvironment
s {$sel:monitors:CreateEnvironment' :: Maybe [Monitor]
monitors = Maybe [Monitor]
a} :: CreateEnvironment) 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

-- | Metadata to assign to the environment. Tags help organize and categorize
-- your AppConfig resources. Each tag consists of a key and an optional
-- value, both of which you define.
createEnvironment_tags :: Lens.Lens' CreateEnvironment (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createEnvironment_tags :: Lens' CreateEnvironment (Maybe (HashMap Text Text))
createEnvironment_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateEnvironment' :: CreateEnvironment -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateEnvironment
s@CreateEnvironment' {} Maybe (HashMap Text Text)
a -> CreateEnvironment
s {$sel:tags:CreateEnvironment' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateEnvironment) 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 application ID.
createEnvironment_applicationId :: Lens.Lens' CreateEnvironment Prelude.Text
createEnvironment_applicationId :: Lens' CreateEnvironment Text
createEnvironment_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {Text
applicationId :: Text
$sel:applicationId:CreateEnvironment' :: CreateEnvironment -> Text
applicationId} -> Text
applicationId) (\s :: CreateEnvironment
s@CreateEnvironment' {} Text
a -> CreateEnvironment
s {$sel:applicationId:CreateEnvironment' :: Text
applicationId = Text
a} :: CreateEnvironment)

-- | A name for the environment.
createEnvironment_name :: Lens.Lens' CreateEnvironment Prelude.Text
createEnvironment_name :: Lens' CreateEnvironment Text
createEnvironment_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {Text
name :: Text
$sel:name:CreateEnvironment' :: CreateEnvironment -> Text
name} -> Text
name) (\s :: CreateEnvironment
s@CreateEnvironment' {} Text
a -> CreateEnvironment
s {$sel:name:CreateEnvironment' :: Text
name = Text
a} :: CreateEnvironment)

instance Core.AWSRequest CreateEnvironment where
  type AWSResponse CreateEnvironment = Environment
  request :: (Service -> Service)
-> CreateEnvironment -> Request CreateEnvironment
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 CreateEnvironment
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateEnvironment)))
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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable CreateEnvironment where
  hashWithSalt :: Int -> CreateEnvironment -> Int
hashWithSalt Int
_salt CreateEnvironment' {Maybe [Monitor]
Maybe Text
Maybe (HashMap Text Text)
Text
name :: Text
applicationId :: Text
tags :: Maybe (HashMap Text Text)
monitors :: Maybe [Monitor]
description :: Maybe Text
$sel:name:CreateEnvironment' :: CreateEnvironment -> Text
$sel:applicationId:CreateEnvironment' :: CreateEnvironment -> Text
$sel:tags:CreateEnvironment' :: CreateEnvironment -> Maybe (HashMap Text Text)
$sel:monitors:CreateEnvironment' :: CreateEnvironment -> Maybe [Monitor]
$sel:description:CreateEnvironment' :: CreateEnvironment -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Monitor]
monitors
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateEnvironment where
  rnf :: CreateEnvironment -> ()
rnf CreateEnvironment' {Maybe [Monitor]
Maybe Text
Maybe (HashMap Text Text)
Text
name :: Text
applicationId :: Text
tags :: Maybe (HashMap Text Text)
monitors :: Maybe [Monitor]
description :: Maybe Text
$sel:name:CreateEnvironment' :: CreateEnvironment -> Text
$sel:applicationId:CreateEnvironment' :: CreateEnvironment -> Text
$sel:tags:CreateEnvironment' :: CreateEnvironment -> Maybe (HashMap Text Text)
$sel:monitors:CreateEnvironment' :: CreateEnvironment -> Maybe [Monitor]
$sel:description:CreateEnvironment' :: CreateEnvironment -> Maybe Text
..} =
    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 [Monitor]
monitors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders CreateEnvironment where
  toHeaders :: CreateEnvironment -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateEnvironment where
  toJSON :: CreateEnvironment -> Value
toJSON CreateEnvironment' {Maybe [Monitor]
Maybe Text
Maybe (HashMap Text Text)
Text
name :: Text
applicationId :: Text
tags :: Maybe (HashMap Text Text)
monitors :: Maybe [Monitor]
description :: Maybe Text
$sel:name:CreateEnvironment' :: CreateEnvironment -> Text
$sel:applicationId:CreateEnvironment' :: CreateEnvironment -> Text
$sel:tags:CreateEnvironment' :: CreateEnvironment -> Maybe (HashMap Text Text)
$sel:monitors:CreateEnvironment' :: CreateEnvironment -> Maybe [Monitor]
$sel:description:CreateEnvironment' :: CreateEnvironment -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"Monitors" 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 [Monitor]
monitors,
            (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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

instance Data.ToPath CreateEnvironment where
  toPath :: CreateEnvironment -> ByteString
toPath CreateEnvironment' {Maybe [Monitor]
Maybe Text
Maybe (HashMap Text Text)
Text
name :: Text
applicationId :: Text
tags :: Maybe (HashMap Text Text)
monitors :: Maybe [Monitor]
description :: Maybe Text
$sel:name:CreateEnvironment' :: CreateEnvironment -> Text
$sel:applicationId:CreateEnvironment' :: CreateEnvironment -> Text
$sel:tags:CreateEnvironment' :: CreateEnvironment -> Maybe (HashMap Text Text)
$sel:monitors:CreateEnvironment' :: CreateEnvironment -> Maybe [Monitor]
$sel:description:CreateEnvironment' :: CreateEnvironment -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/applications/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/environments"
      ]

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