{-# 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.CreateInfrastructureConfiguration
-- 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 infrastructure configuration. An infrastructure
-- configuration defines the environment in which your image will be built
-- and tested.
module Amazonka.ImageBuilder.CreateInfrastructureConfiguration
  ( -- * Creating a Request
    CreateInfrastructureConfiguration (..),
    newCreateInfrastructureConfiguration,

    -- * Request Lenses
    createInfrastructureConfiguration_description,
    createInfrastructureConfiguration_instanceMetadataOptions,
    createInfrastructureConfiguration_instanceTypes,
    createInfrastructureConfiguration_keyPair,
    createInfrastructureConfiguration_logging,
    createInfrastructureConfiguration_resourceTags,
    createInfrastructureConfiguration_securityGroupIds,
    createInfrastructureConfiguration_snsTopicArn,
    createInfrastructureConfiguration_subnetId,
    createInfrastructureConfiguration_tags,
    createInfrastructureConfiguration_terminateInstanceOnFailure,
    createInfrastructureConfiguration_name,
    createInfrastructureConfiguration_instanceProfileName,
    createInfrastructureConfiguration_clientToken,

    -- * Destructuring the Response
    CreateInfrastructureConfigurationResponse (..),
    newCreateInfrastructureConfigurationResponse,

    -- * Response Lenses
    createInfrastructureConfigurationResponse_clientToken,
    createInfrastructureConfigurationResponse_infrastructureConfigurationArn,
    createInfrastructureConfigurationResponse_requestId,
    createInfrastructureConfigurationResponse_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:/ 'newCreateInfrastructureConfiguration' smart constructor.
data CreateInfrastructureConfiguration = CreateInfrastructureConfiguration'
  { -- | The description of the infrastructure configuration.
    CreateInfrastructureConfiguration -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The instance metadata options that you can set for the HTTP requests
    -- that pipeline builds use to launch EC2 build and test instances.
    CreateInfrastructureConfiguration -> Maybe InstanceMetadataOptions
instanceMetadataOptions :: Prelude.Maybe InstanceMetadataOptions,
    -- | The instance types of the infrastructure configuration. You can specify
    -- one or more instance types to use for this build. The service will pick
    -- one of these instance types based on availability.
    CreateInfrastructureConfiguration -> Maybe [Text]
instanceTypes :: Prelude.Maybe [Prelude.Text],
    -- | The key pair of the infrastructure configuration. You can use this to
    -- log on to and debug the instance used to create your image.
    CreateInfrastructureConfiguration -> Maybe Text
keyPair :: Prelude.Maybe Prelude.Text,
    -- | The logging configuration of the infrastructure configuration.
    CreateInfrastructureConfiguration -> Maybe Logging
logging :: Prelude.Maybe Logging,
    -- | The tags attached to the resource created by Image Builder.
    CreateInfrastructureConfiguration -> Maybe (HashMap Text Text)
resourceTags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The security group IDs to associate with the instance used to customize
    -- your Amazon EC2 AMI.
    CreateInfrastructureConfiguration -> Maybe [Text]
securityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The Amazon Resource Name (ARN) for the SNS topic to which we send image
    -- build event notifications.
    --
    -- EC2 Image Builder is unable to send notifications to SNS topics that are
    -- encrypted using keys from other accounts. The key that is used to
    -- encrypt the SNS topic must reside in the account that the Image Builder
    -- service runs under.
    CreateInfrastructureConfiguration -> Maybe Text
snsTopicArn :: Prelude.Maybe Prelude.Text,
    -- | The subnet ID in which to place the instance used to customize your
    -- Amazon EC2 AMI.
    CreateInfrastructureConfiguration -> Maybe Text
subnetId :: Prelude.Maybe Prelude.Text,
    -- | The tags of the infrastructure configuration.
    CreateInfrastructureConfiguration -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The terminate instance on failure setting of the infrastructure
    -- configuration. Set to false if you want Image Builder to retain the
    -- instance used to configure your AMI if the build or test phase of your
    -- workflow fails.
    CreateInfrastructureConfiguration -> Maybe Bool
terminateInstanceOnFailure :: Prelude.Maybe Prelude.Bool,
    -- | The name of the infrastructure configuration.
    CreateInfrastructureConfiguration -> Text
name :: Prelude.Text,
    -- | The instance profile to associate with the instance used to customize
    -- your Amazon EC2 AMI.
    CreateInfrastructureConfiguration -> Text
instanceProfileName :: Prelude.Text,
    -- | The idempotency token used to make this request idempotent.
    CreateInfrastructureConfiguration -> Text
clientToken :: Prelude.Text
  }
  deriving (CreateInfrastructureConfiguration
-> CreateInfrastructureConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateInfrastructureConfiguration
-> CreateInfrastructureConfiguration -> Bool
$c/= :: CreateInfrastructureConfiguration
-> CreateInfrastructureConfiguration -> Bool
== :: CreateInfrastructureConfiguration
-> CreateInfrastructureConfiguration -> Bool
$c== :: CreateInfrastructureConfiguration
-> CreateInfrastructureConfiguration -> Bool
Prelude.Eq, ReadPrec [CreateInfrastructureConfiguration]
ReadPrec CreateInfrastructureConfiguration
Int -> ReadS CreateInfrastructureConfiguration
ReadS [CreateInfrastructureConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateInfrastructureConfiguration]
$creadListPrec :: ReadPrec [CreateInfrastructureConfiguration]
readPrec :: ReadPrec CreateInfrastructureConfiguration
$creadPrec :: ReadPrec CreateInfrastructureConfiguration
readList :: ReadS [CreateInfrastructureConfiguration]
$creadList :: ReadS [CreateInfrastructureConfiguration]
readsPrec :: Int -> ReadS CreateInfrastructureConfiguration
$creadsPrec :: Int -> ReadS CreateInfrastructureConfiguration
Prelude.Read, Int -> CreateInfrastructureConfiguration -> ShowS
[CreateInfrastructureConfiguration] -> ShowS
CreateInfrastructureConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateInfrastructureConfiguration] -> ShowS
$cshowList :: [CreateInfrastructureConfiguration] -> ShowS
show :: CreateInfrastructureConfiguration -> String
$cshow :: CreateInfrastructureConfiguration -> String
showsPrec :: Int -> CreateInfrastructureConfiguration -> ShowS
$cshowsPrec :: Int -> CreateInfrastructureConfiguration -> ShowS
Prelude.Show, forall x.
Rep CreateInfrastructureConfiguration x
-> CreateInfrastructureConfiguration
forall x.
CreateInfrastructureConfiguration
-> Rep CreateInfrastructureConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateInfrastructureConfiguration x
-> CreateInfrastructureConfiguration
$cfrom :: forall x.
CreateInfrastructureConfiguration
-> Rep CreateInfrastructureConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'CreateInfrastructureConfiguration' 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', 'createInfrastructureConfiguration_description' - The description of the infrastructure configuration.
--
-- 'instanceMetadataOptions', 'createInfrastructureConfiguration_instanceMetadataOptions' - The instance metadata options that you can set for the HTTP requests
-- that pipeline builds use to launch EC2 build and test instances.
--
-- 'instanceTypes', 'createInfrastructureConfiguration_instanceTypes' - The instance types of the infrastructure configuration. You can specify
-- one or more instance types to use for this build. The service will pick
-- one of these instance types based on availability.
--
-- 'keyPair', 'createInfrastructureConfiguration_keyPair' - The key pair of the infrastructure configuration. You can use this to
-- log on to and debug the instance used to create your image.
--
-- 'logging', 'createInfrastructureConfiguration_logging' - The logging configuration of the infrastructure configuration.
--
-- 'resourceTags', 'createInfrastructureConfiguration_resourceTags' - The tags attached to the resource created by Image Builder.
--
-- 'securityGroupIds', 'createInfrastructureConfiguration_securityGroupIds' - The security group IDs to associate with the instance used to customize
-- your Amazon EC2 AMI.
--
-- 'snsTopicArn', 'createInfrastructureConfiguration_snsTopicArn' - The Amazon Resource Name (ARN) for the SNS topic to which we send image
-- build event notifications.
--
-- EC2 Image Builder is unable to send notifications to SNS topics that are
-- encrypted using keys from other accounts. The key that is used to
-- encrypt the SNS topic must reside in the account that the Image Builder
-- service runs under.
--
-- 'subnetId', 'createInfrastructureConfiguration_subnetId' - The subnet ID in which to place the instance used to customize your
-- Amazon EC2 AMI.
--
-- 'tags', 'createInfrastructureConfiguration_tags' - The tags of the infrastructure configuration.
--
-- 'terminateInstanceOnFailure', 'createInfrastructureConfiguration_terminateInstanceOnFailure' - The terminate instance on failure setting of the infrastructure
-- configuration. Set to false if you want Image Builder to retain the
-- instance used to configure your AMI if the build or test phase of your
-- workflow fails.
--
-- 'name', 'createInfrastructureConfiguration_name' - The name of the infrastructure configuration.
--
-- 'instanceProfileName', 'createInfrastructureConfiguration_instanceProfileName' - The instance profile to associate with the instance used to customize
-- your Amazon EC2 AMI.
--
-- 'clientToken', 'createInfrastructureConfiguration_clientToken' - The idempotency token used to make this request idempotent.
newCreateInfrastructureConfiguration ::
  -- | 'name'
  Prelude.Text ->
  -- | 'instanceProfileName'
  Prelude.Text ->
  -- | 'clientToken'
  Prelude.Text ->
  CreateInfrastructureConfiguration
newCreateInfrastructureConfiguration :: Text -> Text -> Text -> CreateInfrastructureConfiguration
newCreateInfrastructureConfiguration
  Text
pName_
  Text
pInstanceProfileName_
  Text
pClientToken_ =
    CreateInfrastructureConfiguration'
      { $sel:description:CreateInfrastructureConfiguration' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:instanceMetadataOptions:CreateInfrastructureConfiguration' :: Maybe InstanceMetadataOptions
instanceMetadataOptions =
          forall a. Maybe a
Prelude.Nothing,
        $sel:instanceTypes:CreateInfrastructureConfiguration' :: Maybe [Text]
instanceTypes = forall a. Maybe a
Prelude.Nothing,
        $sel:keyPair:CreateInfrastructureConfiguration' :: Maybe Text
keyPair = forall a. Maybe a
Prelude.Nothing,
        $sel:logging:CreateInfrastructureConfiguration' :: Maybe Logging
logging = forall a. Maybe a
Prelude.Nothing,
        $sel:resourceTags:CreateInfrastructureConfiguration' :: Maybe (HashMap Text Text)
resourceTags = forall a. Maybe a
Prelude.Nothing,
        $sel:securityGroupIds:CreateInfrastructureConfiguration' :: Maybe [Text]
securityGroupIds = forall a. Maybe a
Prelude.Nothing,
        $sel:snsTopicArn:CreateInfrastructureConfiguration' :: Maybe Text
snsTopicArn = forall a. Maybe a
Prelude.Nothing,
        $sel:subnetId:CreateInfrastructureConfiguration' :: Maybe Text
subnetId = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateInfrastructureConfiguration' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:terminateInstanceOnFailure:CreateInfrastructureConfiguration' :: Maybe Bool
terminateInstanceOnFailure =
          forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateInfrastructureConfiguration' :: Text
name = Text
pName_,
        $sel:instanceProfileName:CreateInfrastructureConfiguration' :: Text
instanceProfileName =
          Text
pInstanceProfileName_,
        $sel:clientToken:CreateInfrastructureConfiguration' :: Text
clientToken = Text
pClientToken_
      }

-- | The description of the infrastructure configuration.
createInfrastructureConfiguration_description :: Lens.Lens' CreateInfrastructureConfiguration (Prelude.Maybe Prelude.Text)
createInfrastructureConfiguration_description :: Lens' CreateInfrastructureConfiguration (Maybe Text)
createInfrastructureConfiguration_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInfrastructureConfiguration' {Maybe Text
description :: Maybe Text
$sel:description:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateInfrastructureConfiguration
s@CreateInfrastructureConfiguration' {} Maybe Text
a -> CreateInfrastructureConfiguration
s {$sel:description:CreateInfrastructureConfiguration' :: Maybe Text
description = Maybe Text
a} :: CreateInfrastructureConfiguration)

-- | The instance metadata options that you can set for the HTTP requests
-- that pipeline builds use to launch EC2 build and test instances.
createInfrastructureConfiguration_instanceMetadataOptions :: Lens.Lens' CreateInfrastructureConfiguration (Prelude.Maybe InstanceMetadataOptions)
createInfrastructureConfiguration_instanceMetadataOptions :: Lens'
  CreateInfrastructureConfiguration (Maybe InstanceMetadataOptions)
createInfrastructureConfiguration_instanceMetadataOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInfrastructureConfiguration' {Maybe InstanceMetadataOptions
instanceMetadataOptions :: Maybe InstanceMetadataOptions
$sel:instanceMetadataOptions:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe InstanceMetadataOptions
instanceMetadataOptions} -> Maybe InstanceMetadataOptions
instanceMetadataOptions) (\s :: CreateInfrastructureConfiguration
s@CreateInfrastructureConfiguration' {} Maybe InstanceMetadataOptions
a -> CreateInfrastructureConfiguration
s {$sel:instanceMetadataOptions:CreateInfrastructureConfiguration' :: Maybe InstanceMetadataOptions
instanceMetadataOptions = Maybe InstanceMetadataOptions
a} :: CreateInfrastructureConfiguration)

-- | The instance types of the infrastructure configuration. You can specify
-- one or more instance types to use for this build. The service will pick
-- one of these instance types based on availability.
createInfrastructureConfiguration_instanceTypes :: Lens.Lens' CreateInfrastructureConfiguration (Prelude.Maybe [Prelude.Text])
createInfrastructureConfiguration_instanceTypes :: Lens' CreateInfrastructureConfiguration (Maybe [Text])
createInfrastructureConfiguration_instanceTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInfrastructureConfiguration' {Maybe [Text]
instanceTypes :: Maybe [Text]
$sel:instanceTypes:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe [Text]
instanceTypes} -> Maybe [Text]
instanceTypes) (\s :: CreateInfrastructureConfiguration
s@CreateInfrastructureConfiguration' {} Maybe [Text]
a -> CreateInfrastructureConfiguration
s {$sel:instanceTypes:CreateInfrastructureConfiguration' :: Maybe [Text]
instanceTypes = Maybe [Text]
a} :: CreateInfrastructureConfiguration) 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 key pair of the infrastructure configuration. You can use this to
-- log on to and debug the instance used to create your image.
createInfrastructureConfiguration_keyPair :: Lens.Lens' CreateInfrastructureConfiguration (Prelude.Maybe Prelude.Text)
createInfrastructureConfiguration_keyPair :: Lens' CreateInfrastructureConfiguration (Maybe Text)
createInfrastructureConfiguration_keyPair = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInfrastructureConfiguration' {Maybe Text
keyPair :: Maybe Text
$sel:keyPair:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Text
keyPair} -> Maybe Text
keyPair) (\s :: CreateInfrastructureConfiguration
s@CreateInfrastructureConfiguration' {} Maybe Text
a -> CreateInfrastructureConfiguration
s {$sel:keyPair:CreateInfrastructureConfiguration' :: Maybe Text
keyPair = Maybe Text
a} :: CreateInfrastructureConfiguration)

-- | The logging configuration of the infrastructure configuration.
createInfrastructureConfiguration_logging :: Lens.Lens' CreateInfrastructureConfiguration (Prelude.Maybe Logging)
createInfrastructureConfiguration_logging :: Lens' CreateInfrastructureConfiguration (Maybe Logging)
createInfrastructureConfiguration_logging = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInfrastructureConfiguration' {Maybe Logging
logging :: Maybe Logging
$sel:logging:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Logging
logging} -> Maybe Logging
logging) (\s :: CreateInfrastructureConfiguration
s@CreateInfrastructureConfiguration' {} Maybe Logging
a -> CreateInfrastructureConfiguration
s {$sel:logging:CreateInfrastructureConfiguration' :: Maybe Logging
logging = Maybe Logging
a} :: CreateInfrastructureConfiguration)

-- | The tags attached to the resource created by Image Builder.
createInfrastructureConfiguration_resourceTags :: Lens.Lens' CreateInfrastructureConfiguration (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createInfrastructureConfiguration_resourceTags :: Lens' CreateInfrastructureConfiguration (Maybe (HashMap Text Text))
createInfrastructureConfiguration_resourceTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInfrastructureConfiguration' {Maybe (HashMap Text Text)
resourceTags :: Maybe (HashMap Text Text)
$sel:resourceTags:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe (HashMap Text Text)
resourceTags} -> Maybe (HashMap Text Text)
resourceTags) (\s :: CreateInfrastructureConfiguration
s@CreateInfrastructureConfiguration' {} Maybe (HashMap Text Text)
a -> CreateInfrastructureConfiguration
s {$sel:resourceTags:CreateInfrastructureConfiguration' :: Maybe (HashMap Text Text)
resourceTags = Maybe (HashMap Text Text)
a} :: CreateInfrastructureConfiguration) 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 security group IDs to associate with the instance used to customize
-- your Amazon EC2 AMI.
createInfrastructureConfiguration_securityGroupIds :: Lens.Lens' CreateInfrastructureConfiguration (Prelude.Maybe [Prelude.Text])
createInfrastructureConfiguration_securityGroupIds :: Lens' CreateInfrastructureConfiguration (Maybe [Text])
createInfrastructureConfiguration_securityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInfrastructureConfiguration' {Maybe [Text]
securityGroupIds :: Maybe [Text]
$sel:securityGroupIds:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe [Text]
securityGroupIds} -> Maybe [Text]
securityGroupIds) (\s :: CreateInfrastructureConfiguration
s@CreateInfrastructureConfiguration' {} Maybe [Text]
a -> CreateInfrastructureConfiguration
s {$sel:securityGroupIds:CreateInfrastructureConfiguration' :: Maybe [Text]
securityGroupIds = Maybe [Text]
a} :: CreateInfrastructureConfiguration) 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 Amazon Resource Name (ARN) for the SNS topic to which we send image
-- build event notifications.
--
-- EC2 Image Builder is unable to send notifications to SNS topics that are
-- encrypted using keys from other accounts. The key that is used to
-- encrypt the SNS topic must reside in the account that the Image Builder
-- service runs under.
createInfrastructureConfiguration_snsTopicArn :: Lens.Lens' CreateInfrastructureConfiguration (Prelude.Maybe Prelude.Text)
createInfrastructureConfiguration_snsTopicArn :: Lens' CreateInfrastructureConfiguration (Maybe Text)
createInfrastructureConfiguration_snsTopicArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInfrastructureConfiguration' {Maybe Text
snsTopicArn :: Maybe Text
$sel:snsTopicArn:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Text
snsTopicArn} -> Maybe Text
snsTopicArn) (\s :: CreateInfrastructureConfiguration
s@CreateInfrastructureConfiguration' {} Maybe Text
a -> CreateInfrastructureConfiguration
s {$sel:snsTopicArn:CreateInfrastructureConfiguration' :: Maybe Text
snsTopicArn = Maybe Text
a} :: CreateInfrastructureConfiguration)

-- | The subnet ID in which to place the instance used to customize your
-- Amazon EC2 AMI.
createInfrastructureConfiguration_subnetId :: Lens.Lens' CreateInfrastructureConfiguration (Prelude.Maybe Prelude.Text)
createInfrastructureConfiguration_subnetId :: Lens' CreateInfrastructureConfiguration (Maybe Text)
createInfrastructureConfiguration_subnetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInfrastructureConfiguration' {Maybe Text
subnetId :: Maybe Text
$sel:subnetId:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Text
subnetId} -> Maybe Text
subnetId) (\s :: CreateInfrastructureConfiguration
s@CreateInfrastructureConfiguration' {} Maybe Text
a -> CreateInfrastructureConfiguration
s {$sel:subnetId:CreateInfrastructureConfiguration' :: Maybe Text
subnetId = Maybe Text
a} :: CreateInfrastructureConfiguration)

-- | The tags of the infrastructure configuration.
createInfrastructureConfiguration_tags :: Lens.Lens' CreateInfrastructureConfiguration (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createInfrastructureConfiguration_tags :: Lens' CreateInfrastructureConfiguration (Maybe (HashMap Text Text))
createInfrastructureConfiguration_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInfrastructureConfiguration' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateInfrastructureConfiguration
s@CreateInfrastructureConfiguration' {} Maybe (HashMap Text Text)
a -> CreateInfrastructureConfiguration
s {$sel:tags:CreateInfrastructureConfiguration' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateInfrastructureConfiguration) 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 terminate instance on failure setting of the infrastructure
-- configuration. Set to false if you want Image Builder to retain the
-- instance used to configure your AMI if the build or test phase of your
-- workflow fails.
createInfrastructureConfiguration_terminateInstanceOnFailure :: Lens.Lens' CreateInfrastructureConfiguration (Prelude.Maybe Prelude.Bool)
createInfrastructureConfiguration_terminateInstanceOnFailure :: Lens' CreateInfrastructureConfiguration (Maybe Bool)
createInfrastructureConfiguration_terminateInstanceOnFailure = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInfrastructureConfiguration' {Maybe Bool
terminateInstanceOnFailure :: Maybe Bool
$sel:terminateInstanceOnFailure:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Bool
terminateInstanceOnFailure} -> Maybe Bool
terminateInstanceOnFailure) (\s :: CreateInfrastructureConfiguration
s@CreateInfrastructureConfiguration' {} Maybe Bool
a -> CreateInfrastructureConfiguration
s {$sel:terminateInstanceOnFailure:CreateInfrastructureConfiguration' :: Maybe Bool
terminateInstanceOnFailure = Maybe Bool
a} :: CreateInfrastructureConfiguration)

-- | The name of the infrastructure configuration.
createInfrastructureConfiguration_name :: Lens.Lens' CreateInfrastructureConfiguration Prelude.Text
createInfrastructureConfiguration_name :: Lens' CreateInfrastructureConfiguration Text
createInfrastructureConfiguration_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInfrastructureConfiguration' {Text
name :: Text
$sel:name:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Text
name} -> Text
name) (\s :: CreateInfrastructureConfiguration
s@CreateInfrastructureConfiguration' {} Text
a -> CreateInfrastructureConfiguration
s {$sel:name:CreateInfrastructureConfiguration' :: Text
name = Text
a} :: CreateInfrastructureConfiguration)

-- | The instance profile to associate with the instance used to customize
-- your Amazon EC2 AMI.
createInfrastructureConfiguration_instanceProfileName :: Lens.Lens' CreateInfrastructureConfiguration Prelude.Text
createInfrastructureConfiguration_instanceProfileName :: Lens' CreateInfrastructureConfiguration Text
createInfrastructureConfiguration_instanceProfileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInfrastructureConfiguration' {Text
instanceProfileName :: Text
$sel:instanceProfileName:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Text
instanceProfileName} -> Text
instanceProfileName) (\s :: CreateInfrastructureConfiguration
s@CreateInfrastructureConfiguration' {} Text
a -> CreateInfrastructureConfiguration
s {$sel:instanceProfileName:CreateInfrastructureConfiguration' :: Text
instanceProfileName = Text
a} :: CreateInfrastructureConfiguration)

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

instance
  Core.AWSRequest
    CreateInfrastructureConfiguration
  where
  type
    AWSResponse CreateInfrastructureConfiguration =
      CreateInfrastructureConfigurationResponse
  request :: (Service -> Service)
-> CreateInfrastructureConfiguration
-> Request CreateInfrastructureConfiguration
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 CreateInfrastructureConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateInfrastructureConfiguration)))
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
-> CreateInfrastructureConfigurationResponse
CreateInfrastructureConfigurationResponse'
            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
"infrastructureConfigurationArn")
            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
    CreateInfrastructureConfiguration
  where
  hashWithSalt :: Int -> CreateInfrastructureConfiguration -> Int
hashWithSalt
    Int
_salt
    CreateInfrastructureConfiguration' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe InstanceMetadataOptions
Maybe Logging
Text
clientToken :: Text
instanceProfileName :: Text
name :: Text
terminateInstanceOnFailure :: Maybe Bool
tags :: Maybe (HashMap Text Text)
subnetId :: Maybe Text
snsTopicArn :: Maybe Text
securityGroupIds :: Maybe [Text]
resourceTags :: Maybe (HashMap Text Text)
logging :: Maybe Logging
keyPair :: Maybe Text
instanceTypes :: Maybe [Text]
instanceMetadataOptions :: Maybe InstanceMetadataOptions
description :: Maybe Text
$sel:clientToken:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Text
$sel:instanceProfileName:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Text
$sel:name:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Text
$sel:terminateInstanceOnFailure:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Bool
$sel:tags:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe (HashMap Text Text)
$sel:subnetId:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Text
$sel:snsTopicArn:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Text
$sel:securityGroupIds:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe [Text]
$sel:resourceTags:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe (HashMap Text Text)
$sel:logging:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Logging
$sel:keyPair:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Text
$sel:instanceTypes:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe [Text]
$sel:instanceMetadataOptions:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe InstanceMetadataOptions
$sel:description:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> 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 InstanceMetadataOptions
instanceMetadataOptions
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
instanceTypes
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
keyPair
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Logging
logging
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
resourceTags
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroupIds
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snsTopicArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subnetId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
terminateInstanceOnFailure
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceProfileName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken

instance
  Prelude.NFData
    CreateInfrastructureConfiguration
  where
  rnf :: CreateInfrastructureConfiguration -> ()
rnf CreateInfrastructureConfiguration' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe InstanceMetadataOptions
Maybe Logging
Text
clientToken :: Text
instanceProfileName :: Text
name :: Text
terminateInstanceOnFailure :: Maybe Bool
tags :: Maybe (HashMap Text Text)
subnetId :: Maybe Text
snsTopicArn :: Maybe Text
securityGroupIds :: Maybe [Text]
resourceTags :: Maybe (HashMap Text Text)
logging :: Maybe Logging
keyPair :: Maybe Text
instanceTypes :: Maybe [Text]
instanceMetadataOptions :: Maybe InstanceMetadataOptions
description :: Maybe Text
$sel:clientToken:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Text
$sel:instanceProfileName:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Text
$sel:name:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Text
$sel:terminateInstanceOnFailure:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Bool
$sel:tags:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe (HashMap Text Text)
$sel:subnetId:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Text
$sel:snsTopicArn:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Text
$sel:securityGroupIds:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe [Text]
$sel:resourceTags:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe (HashMap Text Text)
$sel:logging:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Logging
$sel:keyPair:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Text
$sel:instanceTypes:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe [Text]
$sel:instanceMetadataOptions:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe InstanceMetadataOptions
$sel:description:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> 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 InstanceMetadataOptions
instanceMetadataOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
instanceTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
keyPair
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Logging
logging
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
resourceTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
securityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
snsTopicArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subnetId
      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 Bool
terminateInstanceOnFailure
      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
instanceProfileName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken

instance
  Data.ToHeaders
    CreateInfrastructureConfiguration
  where
  toHeaders :: CreateInfrastructureConfiguration -> 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
    CreateInfrastructureConfiguration
  where
  toJSON :: CreateInfrastructureConfiguration -> Value
toJSON CreateInfrastructureConfiguration' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe InstanceMetadataOptions
Maybe Logging
Text
clientToken :: Text
instanceProfileName :: Text
name :: Text
terminateInstanceOnFailure :: Maybe Bool
tags :: Maybe (HashMap Text Text)
subnetId :: Maybe Text
snsTopicArn :: Maybe Text
securityGroupIds :: Maybe [Text]
resourceTags :: Maybe (HashMap Text Text)
logging :: Maybe Logging
keyPair :: Maybe Text
instanceTypes :: Maybe [Text]
instanceMetadataOptions :: Maybe InstanceMetadataOptions
description :: Maybe Text
$sel:clientToken:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Text
$sel:instanceProfileName:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Text
$sel:name:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Text
$sel:terminateInstanceOnFailure:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Bool
$sel:tags:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe (HashMap Text Text)
$sel:subnetId:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Text
$sel:snsTopicArn:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Text
$sel:securityGroupIds:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe [Text]
$sel:resourceTags:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe (HashMap Text Text)
$sel:logging:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Logging
$sel:keyPair:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe Text
$sel:instanceTypes:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe [Text]
$sel:instanceMetadataOptions:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> Maybe InstanceMetadataOptions
$sel:description:CreateInfrastructureConfiguration' :: CreateInfrastructureConfiguration -> 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
"instanceMetadataOptions" 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 InstanceMetadataOptions
instanceMetadataOptions,
            (Key
"instanceTypes" 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]
instanceTypes,
            (Key
"keyPair" 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
keyPair,
            (Key
"logging" 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 Logging
logging,
            (Key
"resourceTags" 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)
resourceTags,
            (Key
"securityGroupIds" 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]
securityGroupIds,
            (Key
"snsTopicArn" 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
snsTopicArn,
            (Key
"subnetId" 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
subnetId,
            (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
"terminateInstanceOnFailure" 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
terminateInstanceOnFailure,
            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
"instanceProfileName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceProfileName),
            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
    CreateInfrastructureConfiguration
  where
  toPath :: CreateInfrastructureConfiguration -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const ByteString
"/CreateInfrastructureConfiguration"

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

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

-- |
-- Create a value of 'CreateInfrastructureConfigurationResponse' 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', 'createInfrastructureConfigurationResponse_clientToken' - The idempotency token used to make this request idempotent.
--
-- 'infrastructureConfigurationArn', 'createInfrastructureConfigurationResponse_infrastructureConfigurationArn' - The Amazon Resource Name (ARN) of the infrastructure configuration that
-- was created by this request.
--
-- 'requestId', 'createInfrastructureConfigurationResponse_requestId' - The request ID that uniquely identifies this request.
--
-- 'httpStatus', 'createInfrastructureConfigurationResponse_httpStatus' - The response's http status code.
newCreateInfrastructureConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateInfrastructureConfigurationResponse
newCreateInfrastructureConfigurationResponse :: Int -> CreateInfrastructureConfigurationResponse
newCreateInfrastructureConfigurationResponse
  Int
pHttpStatus_ =
    CreateInfrastructureConfigurationResponse'
      { $sel:clientToken:CreateInfrastructureConfigurationResponse' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:infrastructureConfigurationArn:CreateInfrastructureConfigurationResponse' :: Maybe Text
infrastructureConfigurationArn =
          forall a. Maybe a
Prelude.Nothing,
        $sel:requestId:CreateInfrastructureConfigurationResponse' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateInfrastructureConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

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

-- | The Amazon Resource Name (ARN) of the infrastructure configuration that
-- was created by this request.
createInfrastructureConfigurationResponse_infrastructureConfigurationArn :: Lens.Lens' CreateInfrastructureConfigurationResponse (Prelude.Maybe Prelude.Text)
createInfrastructureConfigurationResponse_infrastructureConfigurationArn :: Lens' CreateInfrastructureConfigurationResponse (Maybe Text)
createInfrastructureConfigurationResponse_infrastructureConfigurationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInfrastructureConfigurationResponse' {Maybe Text
infrastructureConfigurationArn :: Maybe Text
$sel:infrastructureConfigurationArn:CreateInfrastructureConfigurationResponse' :: CreateInfrastructureConfigurationResponse -> Maybe Text
infrastructureConfigurationArn} -> Maybe Text
infrastructureConfigurationArn) (\s :: CreateInfrastructureConfigurationResponse
s@CreateInfrastructureConfigurationResponse' {} Maybe Text
a -> CreateInfrastructureConfigurationResponse
s {$sel:infrastructureConfigurationArn:CreateInfrastructureConfigurationResponse' :: Maybe Text
infrastructureConfigurationArn = Maybe Text
a} :: CreateInfrastructureConfigurationResponse)

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

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

instance
  Prelude.NFData
    CreateInfrastructureConfigurationResponse
  where
  rnf :: CreateInfrastructureConfigurationResponse -> ()
rnf CreateInfrastructureConfigurationResponse' {Int
Maybe Text
httpStatus :: Int
requestId :: Maybe Text
infrastructureConfigurationArn :: Maybe Text
clientToken :: Maybe Text
$sel:httpStatus:CreateInfrastructureConfigurationResponse' :: CreateInfrastructureConfigurationResponse -> Int
$sel:requestId:CreateInfrastructureConfigurationResponse' :: CreateInfrastructureConfigurationResponse -> Maybe Text
$sel:infrastructureConfigurationArn:CreateInfrastructureConfigurationResponse' :: CreateInfrastructureConfigurationResponse -> Maybe Text
$sel:clientToken:CreateInfrastructureConfigurationResponse' :: CreateInfrastructureConfigurationResponse -> 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
infrastructureConfigurationArn
      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