{-# 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.ImageBuilder.CreateImageRecipe
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new image recipe. Image recipes define how images are
-- configured, tested, and assessed.
module Amazonka.ImageBuilder.CreateImageRecipe
  ( -- * Creating a Request
    CreateImageRecipe (..),
    newCreateImageRecipe,

    -- * Request Lenses
    createImageRecipe_additionalInstanceConfiguration,
    createImageRecipe_blockDeviceMappings,
    createImageRecipe_description,
    createImageRecipe_tags,
    createImageRecipe_workingDirectory,
    createImageRecipe_name,
    createImageRecipe_semanticVersion,
    createImageRecipe_components,
    createImageRecipe_parentImage,
    createImageRecipe_clientToken,

    -- * Destructuring the Response
    CreateImageRecipeResponse (..),
    newCreateImageRecipeResponse,

    -- * Response Lenses
    createImageRecipeResponse_clientToken,
    createImageRecipeResponse_imageRecipeArn,
    createImageRecipeResponse_requestId,
    createImageRecipeResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateImageRecipe' smart constructor.
data CreateImageRecipe = CreateImageRecipe'
  { -- | Specify additional settings and launch scripts for your build instances.
    CreateImageRecipe -> Maybe AdditionalInstanceConfiguration
additionalInstanceConfiguration :: Prelude.Maybe AdditionalInstanceConfiguration,
    -- | The block device mappings of the image recipe.
    CreateImageRecipe -> Maybe [InstanceBlockDeviceMapping]
blockDeviceMappings :: Prelude.Maybe [InstanceBlockDeviceMapping],
    -- | The description of the image recipe.
    CreateImageRecipe -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The tags of the image recipe.
    CreateImageRecipe -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The working directory used during build and test workflows.
    CreateImageRecipe -> Maybe Text
workingDirectory :: Prelude.Maybe Prelude.Text,
    -- | The name of the image recipe.
    CreateImageRecipe -> Text
name :: Prelude.Text,
    -- | The semantic version of the image recipe. This version follows the
    -- semantic version syntax.
    --
    -- The semantic version has four nodes:
    -- \<major>.\<minor>.\<patch>\/\<build>. You can assign values for the
    -- first three, and can filter on all of them.
    --
    -- __Assignment:__ For the first three nodes you can assign any positive
    -- integer value, including zero, with an upper limit of 2^30-1, or
    -- 1073741823 for each node. Image Builder automatically assigns the build
    -- number to the fourth node.
    --
    -- __Patterns:__ You can use any numeric pattern that adheres to the
    -- assignment requirements for the nodes that you can assign. For example,
    -- you might choose a software version pattern, such as 1.0.0, or a date,
    -- such as 2021.01.01.
    CreateImageRecipe -> Text
semanticVersion :: Prelude.Text,
    -- | The components of the image recipe.
    CreateImageRecipe -> NonEmpty ComponentConfiguration
components :: Prelude.NonEmpty ComponentConfiguration,
    -- | The base image of the image recipe. The value of the string can be the
    -- ARN of the base image or an AMI ID. The format for the ARN follows this
    -- example:
    -- @arn:aws:imagebuilder:us-west-2:aws:image\/windows-server-2016-english-full-base-x86\/x.x.x@.
    -- You can provide the specific version that you want to use, or you can
    -- use a wildcard in all of the fields. If you enter an AMI ID for the
    -- string value, you must have access to the AMI, and the AMI must be in
    -- the same Region in which you are using Image Builder.
    CreateImageRecipe -> Text
parentImage :: Prelude.Text,
    -- | The idempotency token used to make this request idempotent.
    CreateImageRecipe -> Text
clientToken :: Prelude.Text
  }
  deriving (CreateImageRecipe -> CreateImageRecipe -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateImageRecipe -> CreateImageRecipe -> Bool
$c/= :: CreateImageRecipe -> CreateImageRecipe -> Bool
== :: CreateImageRecipe -> CreateImageRecipe -> Bool
$c== :: CreateImageRecipe -> CreateImageRecipe -> Bool
Prelude.Eq, ReadPrec [CreateImageRecipe]
ReadPrec CreateImageRecipe
Int -> ReadS CreateImageRecipe
ReadS [CreateImageRecipe]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateImageRecipe]
$creadListPrec :: ReadPrec [CreateImageRecipe]
readPrec :: ReadPrec CreateImageRecipe
$creadPrec :: ReadPrec CreateImageRecipe
readList :: ReadS [CreateImageRecipe]
$creadList :: ReadS [CreateImageRecipe]
readsPrec :: Int -> ReadS CreateImageRecipe
$creadsPrec :: Int -> ReadS CreateImageRecipe
Prelude.Read, Int -> CreateImageRecipe -> ShowS
[CreateImageRecipe] -> ShowS
CreateImageRecipe -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateImageRecipe] -> ShowS
$cshowList :: [CreateImageRecipe] -> ShowS
show :: CreateImageRecipe -> String
$cshow :: CreateImageRecipe -> String
showsPrec :: Int -> CreateImageRecipe -> ShowS
$cshowsPrec :: Int -> CreateImageRecipe -> ShowS
Prelude.Show, forall x. Rep CreateImageRecipe x -> CreateImageRecipe
forall x. CreateImageRecipe -> Rep CreateImageRecipe x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateImageRecipe x -> CreateImageRecipe
$cfrom :: forall x. CreateImageRecipe -> Rep CreateImageRecipe x
Prelude.Generic)

-- |
-- Create a value of 'CreateImageRecipe' 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:
--
-- 'additionalInstanceConfiguration', 'createImageRecipe_additionalInstanceConfiguration' - Specify additional settings and launch scripts for your build instances.
--
-- 'blockDeviceMappings', 'createImageRecipe_blockDeviceMappings' - The block device mappings of the image recipe.
--
-- 'description', 'createImageRecipe_description' - The description of the image recipe.
--
-- 'tags', 'createImageRecipe_tags' - The tags of the image recipe.
--
-- 'workingDirectory', 'createImageRecipe_workingDirectory' - The working directory used during build and test workflows.
--
-- 'name', 'createImageRecipe_name' - The name of the image recipe.
--
-- 'semanticVersion', 'createImageRecipe_semanticVersion' - The semantic version of the image recipe. This version follows the
-- semantic version syntax.
--
-- The semantic version has four nodes:
-- \<major>.\<minor>.\<patch>\/\<build>. You can assign values for the
-- first three, and can filter on all of them.
--
-- __Assignment:__ For the first three nodes you can assign any positive
-- integer value, including zero, with an upper limit of 2^30-1, or
-- 1073741823 for each node. Image Builder automatically assigns the build
-- number to the fourth node.
--
-- __Patterns:__ You can use any numeric pattern that adheres to the
-- assignment requirements for the nodes that you can assign. For example,
-- you might choose a software version pattern, such as 1.0.0, or a date,
-- such as 2021.01.01.
--
-- 'components', 'createImageRecipe_components' - The components of the image recipe.
--
-- 'parentImage', 'createImageRecipe_parentImage' - The base image of the image recipe. The value of the string can be the
-- ARN of the base image or an AMI ID. The format for the ARN follows this
-- example:
-- @arn:aws:imagebuilder:us-west-2:aws:image\/windows-server-2016-english-full-base-x86\/x.x.x@.
-- You can provide the specific version that you want to use, or you can
-- use a wildcard in all of the fields. If you enter an AMI ID for the
-- string value, you must have access to the AMI, and the AMI must be in
-- the same Region in which you are using Image Builder.
--
-- 'clientToken', 'createImageRecipe_clientToken' - The idempotency token used to make this request idempotent.
newCreateImageRecipe ::
  -- | 'name'
  Prelude.Text ->
  -- | 'semanticVersion'
  Prelude.Text ->
  -- | 'components'
  Prelude.NonEmpty ComponentConfiguration ->
  -- | 'parentImage'
  Prelude.Text ->
  -- | 'clientToken'
  Prelude.Text ->
  CreateImageRecipe
newCreateImageRecipe :: Text
-> Text
-> NonEmpty ComponentConfiguration
-> Text
-> Text
-> CreateImageRecipe
newCreateImageRecipe
  Text
pName_
  Text
pSemanticVersion_
  NonEmpty ComponentConfiguration
pComponents_
  Text
pParentImage_
  Text
pClientToken_ =
    CreateImageRecipe'
      { $sel:additionalInstanceConfiguration:CreateImageRecipe' :: Maybe AdditionalInstanceConfiguration
additionalInstanceConfiguration =
          forall a. Maybe a
Prelude.Nothing,
        $sel:blockDeviceMappings:CreateImageRecipe' :: Maybe [InstanceBlockDeviceMapping]
blockDeviceMappings = forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateImageRecipe' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateImageRecipe' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:workingDirectory:CreateImageRecipe' :: Maybe Text
workingDirectory = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateImageRecipe' :: Text
name = Text
pName_,
        $sel:semanticVersion:CreateImageRecipe' :: Text
semanticVersion = Text
pSemanticVersion_,
        $sel:components:CreateImageRecipe' :: NonEmpty ComponentConfiguration
components = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty ComponentConfiguration
pComponents_,
        $sel:parentImage:CreateImageRecipe' :: Text
parentImage = Text
pParentImage_,
        $sel:clientToken:CreateImageRecipe' :: Text
clientToken = Text
pClientToken_
      }

-- | Specify additional settings and launch scripts for your build instances.
createImageRecipe_additionalInstanceConfiguration :: Lens.Lens' CreateImageRecipe (Prelude.Maybe AdditionalInstanceConfiguration)
createImageRecipe_additionalInstanceConfiguration :: Lens' CreateImageRecipe (Maybe AdditionalInstanceConfiguration)
createImageRecipe_additionalInstanceConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImageRecipe' {Maybe AdditionalInstanceConfiguration
additionalInstanceConfiguration :: Maybe AdditionalInstanceConfiguration
$sel:additionalInstanceConfiguration:CreateImageRecipe' :: CreateImageRecipe -> Maybe AdditionalInstanceConfiguration
additionalInstanceConfiguration} -> Maybe AdditionalInstanceConfiguration
additionalInstanceConfiguration) (\s :: CreateImageRecipe
s@CreateImageRecipe' {} Maybe AdditionalInstanceConfiguration
a -> CreateImageRecipe
s {$sel:additionalInstanceConfiguration:CreateImageRecipe' :: Maybe AdditionalInstanceConfiguration
additionalInstanceConfiguration = Maybe AdditionalInstanceConfiguration
a} :: CreateImageRecipe)

-- | The block device mappings of the image recipe.
createImageRecipe_blockDeviceMappings :: Lens.Lens' CreateImageRecipe (Prelude.Maybe [InstanceBlockDeviceMapping])
createImageRecipe_blockDeviceMappings :: Lens' CreateImageRecipe (Maybe [InstanceBlockDeviceMapping])
createImageRecipe_blockDeviceMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImageRecipe' {Maybe [InstanceBlockDeviceMapping]
blockDeviceMappings :: Maybe [InstanceBlockDeviceMapping]
$sel:blockDeviceMappings:CreateImageRecipe' :: CreateImageRecipe -> Maybe [InstanceBlockDeviceMapping]
blockDeviceMappings} -> Maybe [InstanceBlockDeviceMapping]
blockDeviceMappings) (\s :: CreateImageRecipe
s@CreateImageRecipe' {} Maybe [InstanceBlockDeviceMapping]
a -> CreateImageRecipe
s {$sel:blockDeviceMappings:CreateImageRecipe' :: Maybe [InstanceBlockDeviceMapping]
blockDeviceMappings = Maybe [InstanceBlockDeviceMapping]
a} :: CreateImageRecipe) 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 description of the image recipe.
createImageRecipe_description :: Lens.Lens' CreateImageRecipe (Prelude.Maybe Prelude.Text)
createImageRecipe_description :: Lens' CreateImageRecipe (Maybe Text)
createImageRecipe_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImageRecipe' {Maybe Text
description :: Maybe Text
$sel:description:CreateImageRecipe' :: CreateImageRecipe -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateImageRecipe
s@CreateImageRecipe' {} Maybe Text
a -> CreateImageRecipe
s {$sel:description:CreateImageRecipe' :: Maybe Text
description = Maybe Text
a} :: CreateImageRecipe)

-- | The tags of the image recipe.
createImageRecipe_tags :: Lens.Lens' CreateImageRecipe (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createImageRecipe_tags :: Lens' CreateImageRecipe (Maybe (HashMap Text Text))
createImageRecipe_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImageRecipe' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateImageRecipe' :: CreateImageRecipe -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateImageRecipe
s@CreateImageRecipe' {} Maybe (HashMap Text Text)
a -> CreateImageRecipe
s {$sel:tags:CreateImageRecipe' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateImageRecipe) 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 working directory used during build and test workflows.
createImageRecipe_workingDirectory :: Lens.Lens' CreateImageRecipe (Prelude.Maybe Prelude.Text)
createImageRecipe_workingDirectory :: Lens' CreateImageRecipe (Maybe Text)
createImageRecipe_workingDirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImageRecipe' {Maybe Text
workingDirectory :: Maybe Text
$sel:workingDirectory:CreateImageRecipe' :: CreateImageRecipe -> Maybe Text
workingDirectory} -> Maybe Text
workingDirectory) (\s :: CreateImageRecipe
s@CreateImageRecipe' {} Maybe Text
a -> CreateImageRecipe
s {$sel:workingDirectory:CreateImageRecipe' :: Maybe Text
workingDirectory = Maybe Text
a} :: CreateImageRecipe)

-- | The name of the image recipe.
createImageRecipe_name :: Lens.Lens' CreateImageRecipe Prelude.Text
createImageRecipe_name :: Lens' CreateImageRecipe Text
createImageRecipe_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImageRecipe' {Text
name :: Text
$sel:name:CreateImageRecipe' :: CreateImageRecipe -> Text
name} -> Text
name) (\s :: CreateImageRecipe
s@CreateImageRecipe' {} Text
a -> CreateImageRecipe
s {$sel:name:CreateImageRecipe' :: Text
name = Text
a} :: CreateImageRecipe)

-- | The semantic version of the image recipe. This version follows the
-- semantic version syntax.
--
-- The semantic version has four nodes:
-- \<major>.\<minor>.\<patch>\/\<build>. You can assign values for the
-- first three, and can filter on all of them.
--
-- __Assignment:__ For the first three nodes you can assign any positive
-- integer value, including zero, with an upper limit of 2^30-1, or
-- 1073741823 for each node. Image Builder automatically assigns the build
-- number to the fourth node.
--
-- __Patterns:__ You can use any numeric pattern that adheres to the
-- assignment requirements for the nodes that you can assign. For example,
-- you might choose a software version pattern, such as 1.0.0, or a date,
-- such as 2021.01.01.
createImageRecipe_semanticVersion :: Lens.Lens' CreateImageRecipe Prelude.Text
createImageRecipe_semanticVersion :: Lens' CreateImageRecipe Text
createImageRecipe_semanticVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImageRecipe' {Text
semanticVersion :: Text
$sel:semanticVersion:CreateImageRecipe' :: CreateImageRecipe -> Text
semanticVersion} -> Text
semanticVersion) (\s :: CreateImageRecipe
s@CreateImageRecipe' {} Text
a -> CreateImageRecipe
s {$sel:semanticVersion:CreateImageRecipe' :: Text
semanticVersion = Text
a} :: CreateImageRecipe)

-- | The components of the image recipe.
createImageRecipe_components :: Lens.Lens' CreateImageRecipe (Prelude.NonEmpty ComponentConfiguration)
createImageRecipe_components :: Lens' CreateImageRecipe (NonEmpty ComponentConfiguration)
createImageRecipe_components = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImageRecipe' {NonEmpty ComponentConfiguration
components :: NonEmpty ComponentConfiguration
$sel:components:CreateImageRecipe' :: CreateImageRecipe -> NonEmpty ComponentConfiguration
components} -> NonEmpty ComponentConfiguration
components) (\s :: CreateImageRecipe
s@CreateImageRecipe' {} NonEmpty ComponentConfiguration
a -> CreateImageRecipe
s {$sel:components:CreateImageRecipe' :: NonEmpty ComponentConfiguration
components = NonEmpty ComponentConfiguration
a} :: CreateImageRecipe) 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

-- | The base image of the image recipe. The value of the string can be the
-- ARN of the base image or an AMI ID. The format for the ARN follows this
-- example:
-- @arn:aws:imagebuilder:us-west-2:aws:image\/windows-server-2016-english-full-base-x86\/x.x.x@.
-- You can provide the specific version that you want to use, or you can
-- use a wildcard in all of the fields. If you enter an AMI ID for the
-- string value, you must have access to the AMI, and the AMI must be in
-- the same Region in which you are using Image Builder.
createImageRecipe_parentImage :: Lens.Lens' CreateImageRecipe Prelude.Text
createImageRecipe_parentImage :: Lens' CreateImageRecipe Text
createImageRecipe_parentImage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImageRecipe' {Text
parentImage :: Text
$sel:parentImage:CreateImageRecipe' :: CreateImageRecipe -> Text
parentImage} -> Text
parentImage) (\s :: CreateImageRecipe
s@CreateImageRecipe' {} Text
a -> CreateImageRecipe
s {$sel:parentImage:CreateImageRecipe' :: Text
parentImage = Text
a} :: CreateImageRecipe)

-- | The idempotency token used to make this request idempotent.
createImageRecipe_clientToken :: Lens.Lens' CreateImageRecipe Prelude.Text
createImageRecipe_clientToken :: Lens' CreateImageRecipe Text
createImageRecipe_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImageRecipe' {Text
clientToken :: Text
$sel:clientToken:CreateImageRecipe' :: CreateImageRecipe -> Text
clientToken} -> Text
clientToken) (\s :: CreateImageRecipe
s@CreateImageRecipe' {} Text
a -> CreateImageRecipe
s {$sel:clientToken:CreateImageRecipe' :: Text
clientToken = Text
a} :: CreateImageRecipe)

instance Core.AWSRequest CreateImageRecipe where
  type
    AWSResponse CreateImageRecipe =
      CreateImageRecipeResponse
  request :: (Service -> Service)
-> CreateImageRecipe -> Request CreateImageRecipe
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateImageRecipe
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateImageRecipe)))
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
-> Maybe Text -> Maybe Text -> Int -> CreateImageRecipeResponse
CreateImageRecipeResponse'
            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
"clientToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"imageRecipeArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"requestId")
            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 CreateImageRecipe where
  hashWithSalt :: Int -> CreateImageRecipe -> Int
hashWithSalt Int
_salt CreateImageRecipe' {Maybe [InstanceBlockDeviceMapping]
Maybe Text
Maybe (HashMap Text Text)
Maybe AdditionalInstanceConfiguration
NonEmpty ComponentConfiguration
Text
clientToken :: Text
parentImage :: Text
components :: NonEmpty ComponentConfiguration
semanticVersion :: Text
name :: Text
workingDirectory :: Maybe Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
blockDeviceMappings :: Maybe [InstanceBlockDeviceMapping]
additionalInstanceConfiguration :: Maybe AdditionalInstanceConfiguration
$sel:clientToken:CreateImageRecipe' :: CreateImageRecipe -> Text
$sel:parentImage:CreateImageRecipe' :: CreateImageRecipe -> Text
$sel:components:CreateImageRecipe' :: CreateImageRecipe -> NonEmpty ComponentConfiguration
$sel:semanticVersion:CreateImageRecipe' :: CreateImageRecipe -> Text
$sel:name:CreateImageRecipe' :: CreateImageRecipe -> Text
$sel:workingDirectory:CreateImageRecipe' :: CreateImageRecipe -> Maybe Text
$sel:tags:CreateImageRecipe' :: CreateImageRecipe -> Maybe (HashMap Text Text)
$sel:description:CreateImageRecipe' :: CreateImageRecipe -> Maybe Text
$sel:blockDeviceMappings:CreateImageRecipe' :: CreateImageRecipe -> Maybe [InstanceBlockDeviceMapping]
$sel:additionalInstanceConfiguration:CreateImageRecipe' :: CreateImageRecipe -> Maybe AdditionalInstanceConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AdditionalInstanceConfiguration
additionalInstanceConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InstanceBlockDeviceMapping]
blockDeviceMappings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
workingDirectory
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
semanticVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty ComponentConfiguration
components
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
parentImage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken

instance Prelude.NFData CreateImageRecipe where
  rnf :: CreateImageRecipe -> ()
rnf CreateImageRecipe' {Maybe [InstanceBlockDeviceMapping]
Maybe Text
Maybe (HashMap Text Text)
Maybe AdditionalInstanceConfiguration
NonEmpty ComponentConfiguration
Text
clientToken :: Text
parentImage :: Text
components :: NonEmpty ComponentConfiguration
semanticVersion :: Text
name :: Text
workingDirectory :: Maybe Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
blockDeviceMappings :: Maybe [InstanceBlockDeviceMapping]
additionalInstanceConfiguration :: Maybe AdditionalInstanceConfiguration
$sel:clientToken:CreateImageRecipe' :: CreateImageRecipe -> Text
$sel:parentImage:CreateImageRecipe' :: CreateImageRecipe -> Text
$sel:components:CreateImageRecipe' :: CreateImageRecipe -> NonEmpty ComponentConfiguration
$sel:semanticVersion:CreateImageRecipe' :: CreateImageRecipe -> Text
$sel:name:CreateImageRecipe' :: CreateImageRecipe -> Text
$sel:workingDirectory:CreateImageRecipe' :: CreateImageRecipe -> Maybe Text
$sel:tags:CreateImageRecipe' :: CreateImageRecipe -> Maybe (HashMap Text Text)
$sel:description:CreateImageRecipe' :: CreateImageRecipe -> Maybe Text
$sel:blockDeviceMappings:CreateImageRecipe' :: CreateImageRecipe -> Maybe [InstanceBlockDeviceMapping]
$sel:additionalInstanceConfiguration:CreateImageRecipe' :: CreateImageRecipe -> Maybe AdditionalInstanceConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AdditionalInstanceConfiguration
additionalInstanceConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InstanceBlockDeviceMapping]
blockDeviceMappings
      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 (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
workingDirectory
      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 Text
semanticVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty ComponentConfiguration
components
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
parentImage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken

instance Data.ToHeaders CreateImageRecipe where
  toHeaders :: CreateImageRecipe -> 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 CreateImageRecipe where
  toJSON :: CreateImageRecipe -> Value
toJSON CreateImageRecipe' {Maybe [InstanceBlockDeviceMapping]
Maybe Text
Maybe (HashMap Text Text)
Maybe AdditionalInstanceConfiguration
NonEmpty ComponentConfiguration
Text
clientToken :: Text
parentImage :: Text
components :: NonEmpty ComponentConfiguration
semanticVersion :: Text
name :: Text
workingDirectory :: Maybe Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
blockDeviceMappings :: Maybe [InstanceBlockDeviceMapping]
additionalInstanceConfiguration :: Maybe AdditionalInstanceConfiguration
$sel:clientToken:CreateImageRecipe' :: CreateImageRecipe -> Text
$sel:parentImage:CreateImageRecipe' :: CreateImageRecipe -> Text
$sel:components:CreateImageRecipe' :: CreateImageRecipe -> NonEmpty ComponentConfiguration
$sel:semanticVersion:CreateImageRecipe' :: CreateImageRecipe -> Text
$sel:name:CreateImageRecipe' :: CreateImageRecipe -> Text
$sel:workingDirectory:CreateImageRecipe' :: CreateImageRecipe -> Maybe Text
$sel:tags:CreateImageRecipe' :: CreateImageRecipe -> Maybe (HashMap Text Text)
$sel:description:CreateImageRecipe' :: CreateImageRecipe -> Maybe Text
$sel:blockDeviceMappings:CreateImageRecipe' :: CreateImageRecipe -> Maybe [InstanceBlockDeviceMapping]
$sel:additionalInstanceConfiguration:CreateImageRecipe' :: CreateImageRecipe -> Maybe AdditionalInstanceConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"additionalInstanceConfiguration" 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 AdditionalInstanceConfiguration
additionalInstanceConfiguration,
            (Key
"blockDeviceMappings" 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 [InstanceBlockDeviceMapping]
blockDeviceMappings,
            (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
"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,
            (Key
"workingDirectory" 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
workingDirectory,
            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
"semanticVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
semanticVersion),
            forall a. a -> Maybe a
Prelude.Just (Key
"components" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty ComponentConfiguration
components),
            forall a. a -> Maybe a
Prelude.Just (Key
"parentImage" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
parentImage),
            forall a. a -> Maybe a
Prelude.Just (Key
"clientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientToken)
          ]
      )

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

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

-- | /See:/ 'newCreateImageRecipeResponse' smart constructor.
data CreateImageRecipeResponse = CreateImageRecipeResponse'
  { -- | The idempotency token used to make this request idempotent.
    CreateImageRecipeResponse -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the image recipe that was created by
    -- this request.
    CreateImageRecipeResponse -> Maybe Text
imageRecipeArn :: Prelude.Maybe Prelude.Text,
    -- | The request ID that uniquely identifies this request.
    CreateImageRecipeResponse -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateImageRecipeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateImageRecipeResponse -> CreateImageRecipeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateImageRecipeResponse -> CreateImageRecipeResponse -> Bool
$c/= :: CreateImageRecipeResponse -> CreateImageRecipeResponse -> Bool
== :: CreateImageRecipeResponse -> CreateImageRecipeResponse -> Bool
$c== :: CreateImageRecipeResponse -> CreateImageRecipeResponse -> Bool
Prelude.Eq, ReadPrec [CreateImageRecipeResponse]
ReadPrec CreateImageRecipeResponse
Int -> ReadS CreateImageRecipeResponse
ReadS [CreateImageRecipeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateImageRecipeResponse]
$creadListPrec :: ReadPrec [CreateImageRecipeResponse]
readPrec :: ReadPrec CreateImageRecipeResponse
$creadPrec :: ReadPrec CreateImageRecipeResponse
readList :: ReadS [CreateImageRecipeResponse]
$creadList :: ReadS [CreateImageRecipeResponse]
readsPrec :: Int -> ReadS CreateImageRecipeResponse
$creadsPrec :: Int -> ReadS CreateImageRecipeResponse
Prelude.Read, Int -> CreateImageRecipeResponse -> ShowS
[CreateImageRecipeResponse] -> ShowS
CreateImageRecipeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateImageRecipeResponse] -> ShowS
$cshowList :: [CreateImageRecipeResponse] -> ShowS
show :: CreateImageRecipeResponse -> String
$cshow :: CreateImageRecipeResponse -> String
showsPrec :: Int -> CreateImageRecipeResponse -> ShowS
$cshowsPrec :: Int -> CreateImageRecipeResponse -> ShowS
Prelude.Show, forall x.
Rep CreateImageRecipeResponse x -> CreateImageRecipeResponse
forall x.
CreateImageRecipeResponse -> Rep CreateImageRecipeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateImageRecipeResponse x -> CreateImageRecipeResponse
$cfrom :: forall x.
CreateImageRecipeResponse -> Rep CreateImageRecipeResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateImageRecipeResponse' 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:
--
-- 'clientToken', 'createImageRecipeResponse_clientToken' - The idempotency token used to make this request idempotent.
--
-- 'imageRecipeArn', 'createImageRecipeResponse_imageRecipeArn' - The Amazon Resource Name (ARN) of the image recipe that was created by
-- this request.
--
-- 'requestId', 'createImageRecipeResponse_requestId' - The request ID that uniquely identifies this request.
--
-- 'httpStatus', 'createImageRecipeResponse_httpStatus' - The response's http status code.
newCreateImageRecipeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateImageRecipeResponse
newCreateImageRecipeResponse :: Int -> CreateImageRecipeResponse
newCreateImageRecipeResponse Int
pHttpStatus_ =
  CreateImageRecipeResponse'
    { $sel:clientToken:CreateImageRecipeResponse' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:imageRecipeArn:CreateImageRecipeResponse' :: Maybe Text
imageRecipeArn = forall a. Maybe a
Prelude.Nothing,
      $sel:requestId:CreateImageRecipeResponse' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateImageRecipeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The idempotency token used to make this request idempotent.
createImageRecipeResponse_clientToken :: Lens.Lens' CreateImageRecipeResponse (Prelude.Maybe Prelude.Text)
createImageRecipeResponse_clientToken :: Lens' CreateImageRecipeResponse (Maybe Text)
createImageRecipeResponse_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImageRecipeResponse' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateImageRecipeResponse' :: CreateImageRecipeResponse -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateImageRecipeResponse
s@CreateImageRecipeResponse' {} Maybe Text
a -> CreateImageRecipeResponse
s {$sel:clientToken:CreateImageRecipeResponse' :: Maybe Text
clientToken = Maybe Text
a} :: CreateImageRecipeResponse)

-- | The Amazon Resource Name (ARN) of the image recipe that was created by
-- this request.
createImageRecipeResponse_imageRecipeArn :: Lens.Lens' CreateImageRecipeResponse (Prelude.Maybe Prelude.Text)
createImageRecipeResponse_imageRecipeArn :: Lens' CreateImageRecipeResponse (Maybe Text)
createImageRecipeResponse_imageRecipeArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImageRecipeResponse' {Maybe Text
imageRecipeArn :: Maybe Text
$sel:imageRecipeArn:CreateImageRecipeResponse' :: CreateImageRecipeResponse -> Maybe Text
imageRecipeArn} -> Maybe Text
imageRecipeArn) (\s :: CreateImageRecipeResponse
s@CreateImageRecipeResponse' {} Maybe Text
a -> CreateImageRecipeResponse
s {$sel:imageRecipeArn:CreateImageRecipeResponse' :: Maybe Text
imageRecipeArn = Maybe Text
a} :: CreateImageRecipeResponse)

-- | The request ID that uniquely identifies this request.
createImageRecipeResponse_requestId :: Lens.Lens' CreateImageRecipeResponse (Prelude.Maybe Prelude.Text)
createImageRecipeResponse_requestId :: Lens' CreateImageRecipeResponse (Maybe Text)
createImageRecipeResponse_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImageRecipeResponse' {Maybe Text
requestId :: Maybe Text
$sel:requestId:CreateImageRecipeResponse' :: CreateImageRecipeResponse -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: CreateImageRecipeResponse
s@CreateImageRecipeResponse' {} Maybe Text
a -> CreateImageRecipeResponse
s {$sel:requestId:CreateImageRecipeResponse' :: Maybe Text
requestId = Maybe Text
a} :: CreateImageRecipeResponse)

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

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