{-# 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.CreateExtension
-- 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 AppConfig extension. An extension augments your ability to
-- inject logic or behavior at different points during the AppConfig
-- workflow of creating or deploying a configuration.
--
-- You can create your own extensions or use the Amazon Web
-- Services-authored extensions provided by AppConfig. For most use-cases,
-- to create your own extension, you must create an Lambda function to
-- perform any computation and processing defined in the extension. For
-- more information about extensions, see
-- <https://docs.aws.amazon.com/appconfig/latest/userguide/working-with-appconfig-extensions.html Working with AppConfig extensions>
-- in the /AppConfig User Guide/.
module Amazonka.AppConfig.CreateExtension
  ( -- * Creating a Request
    CreateExtension (..),
    newCreateExtension,

    -- * Request Lenses
    createExtension_description,
    createExtension_latestVersionNumber,
    createExtension_parameters,
    createExtension_tags,
    createExtension_name,
    createExtension_actions,

    -- * Destructuring the Response
    Extension (..),
    newExtension,

    -- * Response Lenses
    extension_actions,
    extension_arn,
    extension_description,
    extension_id,
    extension_name,
    extension_parameters,
    extension_versionNumber,
  )
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:/ 'newCreateExtension' smart constructor.
data CreateExtension = CreateExtension'
  { -- | Information about the extension.
    CreateExtension -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | You can omit this field when you create an extension. When you create a
    -- new version, specify the most recent current version number. For
    -- example, you create version 3, enter 2 for this field.
    CreateExtension -> Maybe Int
latestVersionNumber :: Prelude.Maybe Prelude.Int,
    -- | The parameters accepted by the extension. You specify parameter values
    -- when you associate the extension to an AppConfig resource by using the
    -- @CreateExtensionAssociation@ API action. For Lambda extension actions,
    -- these parameters are included in the Lambda request object.
    CreateExtension -> Maybe (HashMap Text Parameter)
parameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Parameter),
    -- | Adds one or more tags for the specified extension. Tags are metadata
    -- that help you categorize resources in different ways, for example, by
    -- purpose, owner, or environment. Each tag consists of a key and an
    -- optional value, both of which you define.
    CreateExtension -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A name for the extension. Each extension name in your account must be
    -- unique. Extension versions use the same name.
    CreateExtension -> Text
name :: Prelude.Text,
    -- | The actions defined in the extension.
    CreateExtension -> HashMap ActionPoint (NonEmpty Action)
actions :: Prelude.HashMap ActionPoint (Prelude.NonEmpty Action)
  }
  deriving (CreateExtension -> CreateExtension -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateExtension -> CreateExtension -> Bool
$c/= :: CreateExtension -> CreateExtension -> Bool
== :: CreateExtension -> CreateExtension -> Bool
$c== :: CreateExtension -> CreateExtension -> Bool
Prelude.Eq, ReadPrec [CreateExtension]
ReadPrec CreateExtension
Int -> ReadS CreateExtension
ReadS [CreateExtension]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateExtension]
$creadListPrec :: ReadPrec [CreateExtension]
readPrec :: ReadPrec CreateExtension
$creadPrec :: ReadPrec CreateExtension
readList :: ReadS [CreateExtension]
$creadList :: ReadS [CreateExtension]
readsPrec :: Int -> ReadS CreateExtension
$creadsPrec :: Int -> ReadS CreateExtension
Prelude.Read, Int -> CreateExtension -> ShowS
[CreateExtension] -> ShowS
CreateExtension -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateExtension] -> ShowS
$cshowList :: [CreateExtension] -> ShowS
show :: CreateExtension -> String
$cshow :: CreateExtension -> String
showsPrec :: Int -> CreateExtension -> ShowS
$cshowsPrec :: Int -> CreateExtension -> ShowS
Prelude.Show, forall x. Rep CreateExtension x -> CreateExtension
forall x. CreateExtension -> Rep CreateExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateExtension x -> CreateExtension
$cfrom :: forall x. CreateExtension -> Rep CreateExtension x
Prelude.Generic)

-- |
-- Create a value of 'CreateExtension' 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', 'createExtension_description' - Information about the extension.
--
-- 'latestVersionNumber', 'createExtension_latestVersionNumber' - You can omit this field when you create an extension. When you create a
-- new version, specify the most recent current version number. For
-- example, you create version 3, enter 2 for this field.
--
-- 'parameters', 'createExtension_parameters' - The parameters accepted by the extension. You specify parameter values
-- when you associate the extension to an AppConfig resource by using the
-- @CreateExtensionAssociation@ API action. For Lambda extension actions,
-- these parameters are included in the Lambda request object.
--
-- 'tags', 'createExtension_tags' - Adds one or more tags for the specified extension. Tags are metadata
-- that help you categorize resources in different ways, for example, by
-- purpose, owner, or environment. Each tag consists of a key and an
-- optional value, both of which you define.
--
-- 'name', 'createExtension_name' - A name for the extension. Each extension name in your account must be
-- unique. Extension versions use the same name.
--
-- 'actions', 'createExtension_actions' - The actions defined in the extension.
newCreateExtension ::
  -- | 'name'
  Prelude.Text ->
  CreateExtension
newCreateExtension :: Text -> CreateExtension
newCreateExtension Text
pName_ =
  CreateExtension'
    { $sel:description:CreateExtension' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:latestVersionNumber:CreateExtension' :: Maybe Int
latestVersionNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:parameters:CreateExtension' :: Maybe (HashMap Text Parameter)
parameters = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateExtension' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateExtension' :: Text
name = Text
pName_,
      $sel:actions:CreateExtension' :: HashMap ActionPoint (NonEmpty Action)
actions = forall a. Monoid a => a
Prelude.mempty
    }

-- | Information about the extension.
createExtension_description :: Lens.Lens' CreateExtension (Prelude.Maybe Prelude.Text)
createExtension_description :: Lens' CreateExtension (Maybe Text)
createExtension_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExtension' {Maybe Text
description :: Maybe Text
$sel:description:CreateExtension' :: CreateExtension -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateExtension
s@CreateExtension' {} Maybe Text
a -> CreateExtension
s {$sel:description:CreateExtension' :: Maybe Text
description = Maybe Text
a} :: CreateExtension)

-- | You can omit this field when you create an extension. When you create a
-- new version, specify the most recent current version number. For
-- example, you create version 3, enter 2 for this field.
createExtension_latestVersionNumber :: Lens.Lens' CreateExtension (Prelude.Maybe Prelude.Int)
createExtension_latestVersionNumber :: Lens' CreateExtension (Maybe Int)
createExtension_latestVersionNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExtension' {Maybe Int
latestVersionNumber :: Maybe Int
$sel:latestVersionNumber:CreateExtension' :: CreateExtension -> Maybe Int
latestVersionNumber} -> Maybe Int
latestVersionNumber) (\s :: CreateExtension
s@CreateExtension' {} Maybe Int
a -> CreateExtension
s {$sel:latestVersionNumber:CreateExtension' :: Maybe Int
latestVersionNumber = Maybe Int
a} :: CreateExtension)

-- | The parameters accepted by the extension. You specify parameter values
-- when you associate the extension to an AppConfig resource by using the
-- @CreateExtensionAssociation@ API action. For Lambda extension actions,
-- these parameters are included in the Lambda request object.
createExtension_parameters :: Lens.Lens' CreateExtension (Prelude.Maybe (Prelude.HashMap Prelude.Text Parameter))
createExtension_parameters :: Lens' CreateExtension (Maybe (HashMap Text Parameter))
createExtension_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExtension' {Maybe (HashMap Text Parameter)
parameters :: Maybe (HashMap Text Parameter)
$sel:parameters:CreateExtension' :: CreateExtension -> Maybe (HashMap Text Parameter)
parameters} -> Maybe (HashMap Text Parameter)
parameters) (\s :: CreateExtension
s@CreateExtension' {} Maybe (HashMap Text Parameter)
a -> CreateExtension
s {$sel:parameters:CreateExtension' :: Maybe (HashMap Text Parameter)
parameters = Maybe (HashMap Text Parameter)
a} :: CreateExtension) 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

-- | Adds one or more tags for the specified extension. Tags are metadata
-- that help you categorize resources in different ways, for example, by
-- purpose, owner, or environment. Each tag consists of a key and an
-- optional value, both of which you define.
createExtension_tags :: Lens.Lens' CreateExtension (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createExtension_tags :: Lens' CreateExtension (Maybe (HashMap Text Text))
createExtension_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExtension' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateExtension' :: CreateExtension -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateExtension
s@CreateExtension' {} Maybe (HashMap Text Text)
a -> CreateExtension
s {$sel:tags:CreateExtension' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateExtension) 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 name for the extension. Each extension name in your account must be
-- unique. Extension versions use the same name.
createExtension_name :: Lens.Lens' CreateExtension Prelude.Text
createExtension_name :: Lens' CreateExtension Text
createExtension_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExtension' {Text
name :: Text
$sel:name:CreateExtension' :: CreateExtension -> Text
name} -> Text
name) (\s :: CreateExtension
s@CreateExtension' {} Text
a -> CreateExtension
s {$sel:name:CreateExtension' :: Text
name = Text
a} :: CreateExtension)

-- | The actions defined in the extension.
createExtension_actions :: Lens.Lens' CreateExtension (Prelude.HashMap ActionPoint (Prelude.NonEmpty Action))
createExtension_actions :: Lens' CreateExtension (HashMap ActionPoint (NonEmpty Action))
createExtension_actions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateExtension' {HashMap ActionPoint (NonEmpty Action)
actions :: HashMap ActionPoint (NonEmpty Action)
$sel:actions:CreateExtension' :: CreateExtension -> HashMap ActionPoint (NonEmpty Action)
actions} -> HashMap ActionPoint (NonEmpty Action)
actions) (\s :: CreateExtension
s@CreateExtension' {} HashMap ActionPoint (NonEmpty Action)
a -> CreateExtension
s {$sel:actions:CreateExtension' :: HashMap ActionPoint (NonEmpty Action)
actions = HashMap ActionPoint (NonEmpty Action)
a} :: CreateExtension) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateExtension where
  type AWSResponse CreateExtension = Extension
  request :: (Service -> Service) -> CreateExtension -> Request CreateExtension
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 CreateExtension
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateExtension)))
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 CreateExtension where
  hashWithSalt :: Int -> CreateExtension -> Int
hashWithSalt Int
_salt CreateExtension' {Maybe Int
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text Parameter)
Text
HashMap ActionPoint (NonEmpty Action)
actions :: HashMap ActionPoint (NonEmpty Action)
name :: Text
tags :: Maybe (HashMap Text Text)
parameters :: Maybe (HashMap Text Parameter)
latestVersionNumber :: Maybe Int
description :: Maybe Text
$sel:actions:CreateExtension' :: CreateExtension -> HashMap ActionPoint (NonEmpty Action)
$sel:name:CreateExtension' :: CreateExtension -> Text
$sel:tags:CreateExtension' :: CreateExtension -> Maybe (HashMap Text Text)
$sel:parameters:CreateExtension' :: CreateExtension -> Maybe (HashMap Text Parameter)
$sel:latestVersionNumber:CreateExtension' :: CreateExtension -> Maybe Int
$sel:description:CreateExtension' :: CreateExtension -> 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 Int
latestVersionNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Parameter)
parameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap ActionPoint (NonEmpty Action)
actions

instance Prelude.NFData CreateExtension where
  rnf :: CreateExtension -> ()
rnf CreateExtension' {Maybe Int
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text Parameter)
Text
HashMap ActionPoint (NonEmpty Action)
actions :: HashMap ActionPoint (NonEmpty Action)
name :: Text
tags :: Maybe (HashMap Text Text)
parameters :: Maybe (HashMap Text Parameter)
latestVersionNumber :: Maybe Int
description :: Maybe Text
$sel:actions:CreateExtension' :: CreateExtension -> HashMap ActionPoint (NonEmpty Action)
$sel:name:CreateExtension' :: CreateExtension -> Text
$sel:tags:CreateExtension' :: CreateExtension -> Maybe (HashMap Text Text)
$sel:parameters:CreateExtension' :: CreateExtension -> Maybe (HashMap Text Parameter)
$sel:latestVersionNumber:CreateExtension' :: CreateExtension -> Maybe Int
$sel:description:CreateExtension' :: CreateExtension -> 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 Int
latestVersionNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Parameter)
parameters
      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
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap ActionPoint (NonEmpty Action)
actions

instance Data.ToHeaders CreateExtension where
  toHeaders :: CreateExtension -> ResponseHeaders
toHeaders CreateExtension' {Maybe Int
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text Parameter)
Text
HashMap ActionPoint (NonEmpty Action)
actions :: HashMap ActionPoint (NonEmpty Action)
name :: Text
tags :: Maybe (HashMap Text Text)
parameters :: Maybe (HashMap Text Parameter)
latestVersionNumber :: Maybe Int
description :: Maybe Text
$sel:actions:CreateExtension' :: CreateExtension -> HashMap ActionPoint (NonEmpty Action)
$sel:name:CreateExtension' :: CreateExtension -> Text
$sel:tags:CreateExtension' :: CreateExtension -> Maybe (HashMap Text Text)
$sel:parameters:CreateExtension' :: CreateExtension -> Maybe (HashMap Text Parameter)
$sel:latestVersionNumber:CreateExtension' :: CreateExtension -> Maybe Int
$sel:description:CreateExtension' :: CreateExtension -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"Latest-Version-Number" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Int
latestVersionNumber,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToJSON CreateExtension where
  toJSON :: CreateExtension -> Value
toJSON CreateExtension' {Maybe Int
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text Parameter)
Text
HashMap ActionPoint (NonEmpty Action)
actions :: HashMap ActionPoint (NonEmpty Action)
name :: Text
tags :: Maybe (HashMap Text Text)
parameters :: Maybe (HashMap Text Parameter)
latestVersionNumber :: Maybe Int
description :: Maybe Text
$sel:actions:CreateExtension' :: CreateExtension -> HashMap ActionPoint (NonEmpty Action)
$sel:name:CreateExtension' :: CreateExtension -> Text
$sel:tags:CreateExtension' :: CreateExtension -> Maybe (HashMap Text Text)
$sel:parameters:CreateExtension' :: CreateExtension -> Maybe (HashMap Text Parameter)
$sel:latestVersionNumber:CreateExtension' :: CreateExtension -> Maybe Int
$sel:description:CreateExtension' :: CreateExtension -> 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
"Parameters" 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 Parameter)
parameters,
            (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),
            forall a. a -> Maybe a
Prelude.Just (Key
"Actions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap ActionPoint (NonEmpty Action)
actions)
          ]
      )

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

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