{-# 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.EC2.EnableFastLaunch
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- When you enable faster launching for a Windows AMI, images are
-- pre-provisioned, using snapshots to launch instances up to 65% faster.
-- To create the optimized Windows image, Amazon EC2 launches an instance
-- and runs through Sysprep steps, rebooting as required. Then it creates a
-- set of reserved snapshots that are used for subsequent launches. The
-- reserved snapshots are automatically replenished as they are used,
-- depending on your settings for launch frequency.
--
-- To change these settings, you must own the AMI.
module Amazonka.EC2.EnableFastLaunch
  ( -- * Creating a Request
    EnableFastLaunch (..),
    newEnableFastLaunch,

    -- * Request Lenses
    enableFastLaunch_dryRun,
    enableFastLaunch_launchTemplate,
    enableFastLaunch_maxParallelLaunches,
    enableFastLaunch_resourceType,
    enableFastLaunch_snapshotConfiguration,
    enableFastLaunch_imageId,

    -- * Destructuring the Response
    EnableFastLaunchResponse (..),
    newEnableFastLaunchResponse,

    -- * Response Lenses
    enableFastLaunchResponse_imageId,
    enableFastLaunchResponse_launchTemplate,
    enableFastLaunchResponse_maxParallelLaunches,
    enableFastLaunchResponse_ownerId,
    enableFastLaunchResponse_resourceType,
    enableFastLaunchResponse_snapshotConfiguration,
    enableFastLaunchResponse_state,
    enableFastLaunchResponse_stateTransitionReason,
    enableFastLaunchResponse_stateTransitionTime,
    enableFastLaunchResponse_httpStatus,
  )
where

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

-- | /See:/ 'newEnableFastLaunch' smart constructor.
data EnableFastLaunch = EnableFastLaunch'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    EnableFastLaunch -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The launch template to use when launching Windows instances from
    -- pre-provisioned snapshots. Launch template parameters can include either
    -- the name or ID of the launch template, but not both.
    EnableFastLaunch
-> Maybe FastLaunchLaunchTemplateSpecificationRequest
launchTemplate :: Prelude.Maybe FastLaunchLaunchTemplateSpecificationRequest,
    -- | The maximum number of parallel instances to launch for creating
    -- resources. Value must be @6@ or greater.
    EnableFastLaunch -> Maybe Int
maxParallelLaunches :: Prelude.Maybe Prelude.Int,
    -- | The type of resource to use for pre-provisioning the Windows AMI for
    -- faster launching. Supported values include: @snapshot@, which is the
    -- default value.
    EnableFastLaunch -> Maybe Text
resourceType :: Prelude.Maybe Prelude.Text,
    -- | Configuration settings for creating and managing the snapshots that are
    -- used for pre-provisioning the Windows AMI for faster launching. The
    -- associated @ResourceType@ must be @snapshot@.
    EnableFastLaunch -> Maybe FastLaunchSnapshotConfigurationRequest
snapshotConfiguration :: Prelude.Maybe FastLaunchSnapshotConfigurationRequest,
    -- | The ID of the image for which you’re enabling faster launching.
    EnableFastLaunch -> Text
imageId :: Prelude.Text
  }
  deriving (EnableFastLaunch -> EnableFastLaunch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnableFastLaunch -> EnableFastLaunch -> Bool
$c/= :: EnableFastLaunch -> EnableFastLaunch -> Bool
== :: EnableFastLaunch -> EnableFastLaunch -> Bool
$c== :: EnableFastLaunch -> EnableFastLaunch -> Bool
Prelude.Eq, ReadPrec [EnableFastLaunch]
ReadPrec EnableFastLaunch
Int -> ReadS EnableFastLaunch
ReadS [EnableFastLaunch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnableFastLaunch]
$creadListPrec :: ReadPrec [EnableFastLaunch]
readPrec :: ReadPrec EnableFastLaunch
$creadPrec :: ReadPrec EnableFastLaunch
readList :: ReadS [EnableFastLaunch]
$creadList :: ReadS [EnableFastLaunch]
readsPrec :: Int -> ReadS EnableFastLaunch
$creadsPrec :: Int -> ReadS EnableFastLaunch
Prelude.Read, Int -> EnableFastLaunch -> ShowS
[EnableFastLaunch] -> ShowS
EnableFastLaunch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnableFastLaunch] -> ShowS
$cshowList :: [EnableFastLaunch] -> ShowS
show :: EnableFastLaunch -> String
$cshow :: EnableFastLaunch -> String
showsPrec :: Int -> EnableFastLaunch -> ShowS
$cshowsPrec :: Int -> EnableFastLaunch -> ShowS
Prelude.Show, forall x. Rep EnableFastLaunch x -> EnableFastLaunch
forall x. EnableFastLaunch -> Rep EnableFastLaunch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EnableFastLaunch x -> EnableFastLaunch
$cfrom :: forall x. EnableFastLaunch -> Rep EnableFastLaunch x
Prelude.Generic)

-- |
-- Create a value of 'EnableFastLaunch' 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:
--
-- 'dryRun', 'enableFastLaunch_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'launchTemplate', 'enableFastLaunch_launchTemplate' - The launch template to use when launching Windows instances from
-- pre-provisioned snapshots. Launch template parameters can include either
-- the name or ID of the launch template, but not both.
--
-- 'maxParallelLaunches', 'enableFastLaunch_maxParallelLaunches' - The maximum number of parallel instances to launch for creating
-- resources. Value must be @6@ or greater.
--
-- 'resourceType', 'enableFastLaunch_resourceType' - The type of resource to use for pre-provisioning the Windows AMI for
-- faster launching. Supported values include: @snapshot@, which is the
-- default value.
--
-- 'snapshotConfiguration', 'enableFastLaunch_snapshotConfiguration' - Configuration settings for creating and managing the snapshots that are
-- used for pre-provisioning the Windows AMI for faster launching. The
-- associated @ResourceType@ must be @snapshot@.
--
-- 'imageId', 'enableFastLaunch_imageId' - The ID of the image for which you’re enabling faster launching.
newEnableFastLaunch ::
  -- | 'imageId'
  Prelude.Text ->
  EnableFastLaunch
newEnableFastLaunch :: Text -> EnableFastLaunch
newEnableFastLaunch Text
pImageId_ =
  EnableFastLaunch'
    { $sel:dryRun:EnableFastLaunch' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:launchTemplate:EnableFastLaunch' :: Maybe FastLaunchLaunchTemplateSpecificationRequest
launchTemplate = forall a. Maybe a
Prelude.Nothing,
      $sel:maxParallelLaunches:EnableFastLaunch' :: Maybe Int
maxParallelLaunches = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:EnableFastLaunch' :: Maybe Text
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotConfiguration:EnableFastLaunch' :: Maybe FastLaunchSnapshotConfigurationRequest
snapshotConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:imageId:EnableFastLaunch' :: Text
imageId = Text
pImageId_
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
enableFastLaunch_dryRun :: Lens.Lens' EnableFastLaunch (Prelude.Maybe Prelude.Bool)
enableFastLaunch_dryRun :: Lens' EnableFastLaunch (Maybe Bool)
enableFastLaunch_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunch' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:EnableFastLaunch' :: EnableFastLaunch -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: EnableFastLaunch
s@EnableFastLaunch' {} Maybe Bool
a -> EnableFastLaunch
s {$sel:dryRun:EnableFastLaunch' :: Maybe Bool
dryRun = Maybe Bool
a} :: EnableFastLaunch)

-- | The launch template to use when launching Windows instances from
-- pre-provisioned snapshots. Launch template parameters can include either
-- the name or ID of the launch template, but not both.
enableFastLaunch_launchTemplate :: Lens.Lens' EnableFastLaunch (Prelude.Maybe FastLaunchLaunchTemplateSpecificationRequest)
enableFastLaunch_launchTemplate :: Lens'
  EnableFastLaunch
  (Maybe FastLaunchLaunchTemplateSpecificationRequest)
enableFastLaunch_launchTemplate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunch' {Maybe FastLaunchLaunchTemplateSpecificationRequest
launchTemplate :: Maybe FastLaunchLaunchTemplateSpecificationRequest
$sel:launchTemplate:EnableFastLaunch' :: EnableFastLaunch
-> Maybe FastLaunchLaunchTemplateSpecificationRequest
launchTemplate} -> Maybe FastLaunchLaunchTemplateSpecificationRequest
launchTemplate) (\s :: EnableFastLaunch
s@EnableFastLaunch' {} Maybe FastLaunchLaunchTemplateSpecificationRequest
a -> EnableFastLaunch
s {$sel:launchTemplate:EnableFastLaunch' :: Maybe FastLaunchLaunchTemplateSpecificationRequest
launchTemplate = Maybe FastLaunchLaunchTemplateSpecificationRequest
a} :: EnableFastLaunch)

-- | The maximum number of parallel instances to launch for creating
-- resources. Value must be @6@ or greater.
enableFastLaunch_maxParallelLaunches :: Lens.Lens' EnableFastLaunch (Prelude.Maybe Prelude.Int)
enableFastLaunch_maxParallelLaunches :: Lens' EnableFastLaunch (Maybe Int)
enableFastLaunch_maxParallelLaunches = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunch' {Maybe Int
maxParallelLaunches :: Maybe Int
$sel:maxParallelLaunches:EnableFastLaunch' :: EnableFastLaunch -> Maybe Int
maxParallelLaunches} -> Maybe Int
maxParallelLaunches) (\s :: EnableFastLaunch
s@EnableFastLaunch' {} Maybe Int
a -> EnableFastLaunch
s {$sel:maxParallelLaunches:EnableFastLaunch' :: Maybe Int
maxParallelLaunches = Maybe Int
a} :: EnableFastLaunch)

-- | The type of resource to use for pre-provisioning the Windows AMI for
-- faster launching. Supported values include: @snapshot@, which is the
-- default value.
enableFastLaunch_resourceType :: Lens.Lens' EnableFastLaunch (Prelude.Maybe Prelude.Text)
enableFastLaunch_resourceType :: Lens' EnableFastLaunch (Maybe Text)
enableFastLaunch_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunch' {Maybe Text
resourceType :: Maybe Text
$sel:resourceType:EnableFastLaunch' :: EnableFastLaunch -> Maybe Text
resourceType} -> Maybe Text
resourceType) (\s :: EnableFastLaunch
s@EnableFastLaunch' {} Maybe Text
a -> EnableFastLaunch
s {$sel:resourceType:EnableFastLaunch' :: Maybe Text
resourceType = Maybe Text
a} :: EnableFastLaunch)

-- | Configuration settings for creating and managing the snapshots that are
-- used for pre-provisioning the Windows AMI for faster launching. The
-- associated @ResourceType@ must be @snapshot@.
enableFastLaunch_snapshotConfiguration :: Lens.Lens' EnableFastLaunch (Prelude.Maybe FastLaunchSnapshotConfigurationRequest)
enableFastLaunch_snapshotConfiguration :: Lens'
  EnableFastLaunch (Maybe FastLaunchSnapshotConfigurationRequest)
enableFastLaunch_snapshotConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunch' {Maybe FastLaunchSnapshotConfigurationRequest
snapshotConfiguration :: Maybe FastLaunchSnapshotConfigurationRequest
$sel:snapshotConfiguration:EnableFastLaunch' :: EnableFastLaunch -> Maybe FastLaunchSnapshotConfigurationRequest
snapshotConfiguration} -> Maybe FastLaunchSnapshotConfigurationRequest
snapshotConfiguration) (\s :: EnableFastLaunch
s@EnableFastLaunch' {} Maybe FastLaunchSnapshotConfigurationRequest
a -> EnableFastLaunch
s {$sel:snapshotConfiguration:EnableFastLaunch' :: Maybe FastLaunchSnapshotConfigurationRequest
snapshotConfiguration = Maybe FastLaunchSnapshotConfigurationRequest
a} :: EnableFastLaunch)

-- | The ID of the image for which you’re enabling faster launching.
enableFastLaunch_imageId :: Lens.Lens' EnableFastLaunch Prelude.Text
enableFastLaunch_imageId :: Lens' EnableFastLaunch Text
enableFastLaunch_imageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunch' {Text
imageId :: Text
$sel:imageId:EnableFastLaunch' :: EnableFastLaunch -> Text
imageId} -> Text
imageId) (\s :: EnableFastLaunch
s@EnableFastLaunch' {} Text
a -> EnableFastLaunch
s {$sel:imageId:EnableFastLaunch' :: Text
imageId = Text
a} :: EnableFastLaunch)

instance Core.AWSRequest EnableFastLaunch where
  type
    AWSResponse EnableFastLaunch =
      EnableFastLaunchResponse
  request :: (Service -> Service)
-> EnableFastLaunch -> Request EnableFastLaunch
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy EnableFastLaunch
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse EnableFastLaunch)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe FastLaunchLaunchTemplateSpecificationResponse
-> Maybe Int
-> Maybe Text
-> Maybe FastLaunchResourceType
-> Maybe FastLaunchSnapshotConfigurationResponse
-> Maybe FastLaunchStateCode
-> Maybe Text
-> Maybe ISO8601
-> Int
-> EnableFastLaunchResponse
EnableFastLaunchResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"imageId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"launchTemplate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"maxParallelLaunches")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ownerId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"resourceType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"snapshotConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"state")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"stateTransitionReason")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"stateTransitionTime")
            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 EnableFastLaunch where
  hashWithSalt :: Int -> EnableFastLaunch -> Int
hashWithSalt Int
_salt EnableFastLaunch' {Maybe Bool
Maybe Int
Maybe Text
Maybe FastLaunchLaunchTemplateSpecificationRequest
Maybe FastLaunchSnapshotConfigurationRequest
Text
imageId :: Text
snapshotConfiguration :: Maybe FastLaunchSnapshotConfigurationRequest
resourceType :: Maybe Text
maxParallelLaunches :: Maybe Int
launchTemplate :: Maybe FastLaunchLaunchTemplateSpecificationRequest
dryRun :: Maybe Bool
$sel:imageId:EnableFastLaunch' :: EnableFastLaunch -> Text
$sel:snapshotConfiguration:EnableFastLaunch' :: EnableFastLaunch -> Maybe FastLaunchSnapshotConfigurationRequest
$sel:resourceType:EnableFastLaunch' :: EnableFastLaunch -> Maybe Text
$sel:maxParallelLaunches:EnableFastLaunch' :: EnableFastLaunch -> Maybe Int
$sel:launchTemplate:EnableFastLaunch' :: EnableFastLaunch
-> Maybe FastLaunchLaunchTemplateSpecificationRequest
$sel:dryRun:EnableFastLaunch' :: EnableFastLaunch -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FastLaunchLaunchTemplateSpecificationRequest
launchTemplate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxParallelLaunches
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FastLaunchSnapshotConfigurationRequest
snapshotConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
imageId

instance Prelude.NFData EnableFastLaunch where
  rnf :: EnableFastLaunch -> ()
rnf EnableFastLaunch' {Maybe Bool
Maybe Int
Maybe Text
Maybe FastLaunchLaunchTemplateSpecificationRequest
Maybe FastLaunchSnapshotConfigurationRequest
Text
imageId :: Text
snapshotConfiguration :: Maybe FastLaunchSnapshotConfigurationRequest
resourceType :: Maybe Text
maxParallelLaunches :: Maybe Int
launchTemplate :: Maybe FastLaunchLaunchTemplateSpecificationRequest
dryRun :: Maybe Bool
$sel:imageId:EnableFastLaunch' :: EnableFastLaunch -> Text
$sel:snapshotConfiguration:EnableFastLaunch' :: EnableFastLaunch -> Maybe FastLaunchSnapshotConfigurationRequest
$sel:resourceType:EnableFastLaunch' :: EnableFastLaunch -> Maybe Text
$sel:maxParallelLaunches:EnableFastLaunch' :: EnableFastLaunch -> Maybe Int
$sel:launchTemplate:EnableFastLaunch' :: EnableFastLaunch
-> Maybe FastLaunchLaunchTemplateSpecificationRequest
$sel:dryRun:EnableFastLaunch' :: EnableFastLaunch -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FastLaunchLaunchTemplateSpecificationRequest
launchTemplate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxParallelLaunches
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FastLaunchSnapshotConfigurationRequest
snapshotConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
imageId

instance Data.ToHeaders EnableFastLaunch where
  toHeaders :: EnableFastLaunch -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery EnableFastLaunch where
  toQuery :: EnableFastLaunch -> QueryString
toQuery EnableFastLaunch' {Maybe Bool
Maybe Int
Maybe Text
Maybe FastLaunchLaunchTemplateSpecificationRequest
Maybe FastLaunchSnapshotConfigurationRequest
Text
imageId :: Text
snapshotConfiguration :: Maybe FastLaunchSnapshotConfigurationRequest
resourceType :: Maybe Text
maxParallelLaunches :: Maybe Int
launchTemplate :: Maybe FastLaunchLaunchTemplateSpecificationRequest
dryRun :: Maybe Bool
$sel:imageId:EnableFastLaunch' :: EnableFastLaunch -> Text
$sel:snapshotConfiguration:EnableFastLaunch' :: EnableFastLaunch -> Maybe FastLaunchSnapshotConfigurationRequest
$sel:resourceType:EnableFastLaunch' :: EnableFastLaunch -> Maybe Text
$sel:maxParallelLaunches:EnableFastLaunch' :: EnableFastLaunch -> Maybe Int
$sel:launchTemplate:EnableFastLaunch' :: EnableFastLaunch
-> Maybe FastLaunchLaunchTemplateSpecificationRequest
$sel:dryRun:EnableFastLaunch' :: EnableFastLaunch -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"EnableFastLaunch" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"LaunchTemplate" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe FastLaunchLaunchTemplateSpecificationRequest
launchTemplate,
        ByteString
"MaxParallelLaunches" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxParallelLaunches,
        ByteString
"ResourceType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
resourceType,
        ByteString
"SnapshotConfiguration"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe FastLaunchSnapshotConfigurationRequest
snapshotConfiguration,
        ByteString
"ImageId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
imageId
      ]

-- | /See:/ 'newEnableFastLaunchResponse' smart constructor.
data EnableFastLaunchResponse = EnableFastLaunchResponse'
  { -- | The image ID that identifies the Windows AMI for which faster launching
    -- was enabled.
    EnableFastLaunchResponse -> Maybe Text
imageId :: Prelude.Maybe Prelude.Text,
    -- | The launch template that is used when launching Windows instances from
    -- pre-provisioned snapshots.
    EnableFastLaunchResponse
-> Maybe FastLaunchLaunchTemplateSpecificationResponse
launchTemplate :: Prelude.Maybe FastLaunchLaunchTemplateSpecificationResponse,
    -- | The maximum number of parallel instances to launch for creating
    -- resources.
    EnableFastLaunchResponse -> Maybe Int
maxParallelLaunches :: Prelude.Maybe Prelude.Int,
    -- | The owner ID for the Windows AMI for which faster launching was enabled.
    EnableFastLaunchResponse -> Maybe Text
ownerId :: Prelude.Maybe Prelude.Text,
    -- | The type of resource that was defined for pre-provisioning the Windows
    -- AMI for faster launching.
    EnableFastLaunchResponse -> Maybe FastLaunchResourceType
resourceType :: Prelude.Maybe FastLaunchResourceType,
    -- | The configuration settings that were defined for creating and managing
    -- the pre-provisioned snapshots for faster launching of the Windows AMI.
    -- This property is returned when the associated @resourceType@ is
    -- @snapshot@.
    EnableFastLaunchResponse
-> Maybe FastLaunchSnapshotConfigurationResponse
snapshotConfiguration :: Prelude.Maybe FastLaunchSnapshotConfigurationResponse,
    -- | The current state of faster launching for the specified Windows AMI.
    EnableFastLaunchResponse -> Maybe FastLaunchStateCode
state :: Prelude.Maybe FastLaunchStateCode,
    -- | The reason that the state changed for faster launching for the Windows
    -- AMI.
    EnableFastLaunchResponse -> Maybe Text
stateTransitionReason :: Prelude.Maybe Prelude.Text,
    -- | The time that the state changed for faster launching for the Windows
    -- AMI.
    EnableFastLaunchResponse -> Maybe ISO8601
stateTransitionTime :: Prelude.Maybe Data.ISO8601,
    -- | The response's http status code.
    EnableFastLaunchResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (EnableFastLaunchResponse -> EnableFastLaunchResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnableFastLaunchResponse -> EnableFastLaunchResponse -> Bool
$c/= :: EnableFastLaunchResponse -> EnableFastLaunchResponse -> Bool
== :: EnableFastLaunchResponse -> EnableFastLaunchResponse -> Bool
$c== :: EnableFastLaunchResponse -> EnableFastLaunchResponse -> Bool
Prelude.Eq, ReadPrec [EnableFastLaunchResponse]
ReadPrec EnableFastLaunchResponse
Int -> ReadS EnableFastLaunchResponse
ReadS [EnableFastLaunchResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnableFastLaunchResponse]
$creadListPrec :: ReadPrec [EnableFastLaunchResponse]
readPrec :: ReadPrec EnableFastLaunchResponse
$creadPrec :: ReadPrec EnableFastLaunchResponse
readList :: ReadS [EnableFastLaunchResponse]
$creadList :: ReadS [EnableFastLaunchResponse]
readsPrec :: Int -> ReadS EnableFastLaunchResponse
$creadsPrec :: Int -> ReadS EnableFastLaunchResponse
Prelude.Read, Int -> EnableFastLaunchResponse -> ShowS
[EnableFastLaunchResponse] -> ShowS
EnableFastLaunchResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnableFastLaunchResponse] -> ShowS
$cshowList :: [EnableFastLaunchResponse] -> ShowS
show :: EnableFastLaunchResponse -> String
$cshow :: EnableFastLaunchResponse -> String
showsPrec :: Int -> EnableFastLaunchResponse -> ShowS
$cshowsPrec :: Int -> EnableFastLaunchResponse -> ShowS
Prelude.Show, forall x.
Rep EnableFastLaunchResponse x -> EnableFastLaunchResponse
forall x.
EnableFastLaunchResponse -> Rep EnableFastLaunchResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep EnableFastLaunchResponse x -> EnableFastLaunchResponse
$cfrom :: forall x.
EnableFastLaunchResponse -> Rep EnableFastLaunchResponse x
Prelude.Generic)

-- |
-- Create a value of 'EnableFastLaunchResponse' 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:
--
-- 'imageId', 'enableFastLaunchResponse_imageId' - The image ID that identifies the Windows AMI for which faster launching
-- was enabled.
--
-- 'launchTemplate', 'enableFastLaunchResponse_launchTemplate' - The launch template that is used when launching Windows instances from
-- pre-provisioned snapshots.
--
-- 'maxParallelLaunches', 'enableFastLaunchResponse_maxParallelLaunches' - The maximum number of parallel instances to launch for creating
-- resources.
--
-- 'ownerId', 'enableFastLaunchResponse_ownerId' - The owner ID for the Windows AMI for which faster launching was enabled.
--
-- 'resourceType', 'enableFastLaunchResponse_resourceType' - The type of resource that was defined for pre-provisioning the Windows
-- AMI for faster launching.
--
-- 'snapshotConfiguration', 'enableFastLaunchResponse_snapshotConfiguration' - The configuration settings that were defined for creating and managing
-- the pre-provisioned snapshots for faster launching of the Windows AMI.
-- This property is returned when the associated @resourceType@ is
-- @snapshot@.
--
-- 'state', 'enableFastLaunchResponse_state' - The current state of faster launching for the specified Windows AMI.
--
-- 'stateTransitionReason', 'enableFastLaunchResponse_stateTransitionReason' - The reason that the state changed for faster launching for the Windows
-- AMI.
--
-- 'stateTransitionTime', 'enableFastLaunchResponse_stateTransitionTime' - The time that the state changed for faster launching for the Windows
-- AMI.
--
-- 'httpStatus', 'enableFastLaunchResponse_httpStatus' - The response's http status code.
newEnableFastLaunchResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  EnableFastLaunchResponse
newEnableFastLaunchResponse :: Int -> EnableFastLaunchResponse
newEnableFastLaunchResponse Int
pHttpStatus_ =
  EnableFastLaunchResponse'
    { $sel:imageId:EnableFastLaunchResponse' :: Maybe Text
imageId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:launchTemplate:EnableFastLaunchResponse' :: Maybe FastLaunchLaunchTemplateSpecificationResponse
launchTemplate = forall a. Maybe a
Prelude.Nothing,
      $sel:maxParallelLaunches:EnableFastLaunchResponse' :: Maybe Int
maxParallelLaunches = forall a. Maybe a
Prelude.Nothing,
      $sel:ownerId:EnableFastLaunchResponse' :: Maybe Text
ownerId = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:EnableFastLaunchResponse' :: Maybe FastLaunchResourceType
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotConfiguration:EnableFastLaunchResponse' :: Maybe FastLaunchSnapshotConfigurationResponse
snapshotConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:state:EnableFastLaunchResponse' :: Maybe FastLaunchStateCode
state = forall a. Maybe a
Prelude.Nothing,
      $sel:stateTransitionReason:EnableFastLaunchResponse' :: Maybe Text
stateTransitionReason = forall a. Maybe a
Prelude.Nothing,
      $sel:stateTransitionTime:EnableFastLaunchResponse' :: Maybe ISO8601
stateTransitionTime = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:EnableFastLaunchResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The image ID that identifies the Windows AMI for which faster launching
-- was enabled.
enableFastLaunchResponse_imageId :: Lens.Lens' EnableFastLaunchResponse (Prelude.Maybe Prelude.Text)
enableFastLaunchResponse_imageId :: Lens' EnableFastLaunchResponse (Maybe Text)
enableFastLaunchResponse_imageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunchResponse' {Maybe Text
imageId :: Maybe Text
$sel:imageId:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Maybe Text
imageId} -> Maybe Text
imageId) (\s :: EnableFastLaunchResponse
s@EnableFastLaunchResponse' {} Maybe Text
a -> EnableFastLaunchResponse
s {$sel:imageId:EnableFastLaunchResponse' :: Maybe Text
imageId = Maybe Text
a} :: EnableFastLaunchResponse)

-- | The launch template that is used when launching Windows instances from
-- pre-provisioned snapshots.
enableFastLaunchResponse_launchTemplate :: Lens.Lens' EnableFastLaunchResponse (Prelude.Maybe FastLaunchLaunchTemplateSpecificationResponse)
enableFastLaunchResponse_launchTemplate :: Lens'
  EnableFastLaunchResponse
  (Maybe FastLaunchLaunchTemplateSpecificationResponse)
enableFastLaunchResponse_launchTemplate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunchResponse' {Maybe FastLaunchLaunchTemplateSpecificationResponse
launchTemplate :: Maybe FastLaunchLaunchTemplateSpecificationResponse
$sel:launchTemplate:EnableFastLaunchResponse' :: EnableFastLaunchResponse
-> Maybe FastLaunchLaunchTemplateSpecificationResponse
launchTemplate} -> Maybe FastLaunchLaunchTemplateSpecificationResponse
launchTemplate) (\s :: EnableFastLaunchResponse
s@EnableFastLaunchResponse' {} Maybe FastLaunchLaunchTemplateSpecificationResponse
a -> EnableFastLaunchResponse
s {$sel:launchTemplate:EnableFastLaunchResponse' :: Maybe FastLaunchLaunchTemplateSpecificationResponse
launchTemplate = Maybe FastLaunchLaunchTemplateSpecificationResponse
a} :: EnableFastLaunchResponse)

-- | The maximum number of parallel instances to launch for creating
-- resources.
enableFastLaunchResponse_maxParallelLaunches :: Lens.Lens' EnableFastLaunchResponse (Prelude.Maybe Prelude.Int)
enableFastLaunchResponse_maxParallelLaunches :: Lens' EnableFastLaunchResponse (Maybe Int)
enableFastLaunchResponse_maxParallelLaunches = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunchResponse' {Maybe Int
maxParallelLaunches :: Maybe Int
$sel:maxParallelLaunches:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Maybe Int
maxParallelLaunches} -> Maybe Int
maxParallelLaunches) (\s :: EnableFastLaunchResponse
s@EnableFastLaunchResponse' {} Maybe Int
a -> EnableFastLaunchResponse
s {$sel:maxParallelLaunches:EnableFastLaunchResponse' :: Maybe Int
maxParallelLaunches = Maybe Int
a} :: EnableFastLaunchResponse)

-- | The owner ID for the Windows AMI for which faster launching was enabled.
enableFastLaunchResponse_ownerId :: Lens.Lens' EnableFastLaunchResponse (Prelude.Maybe Prelude.Text)
enableFastLaunchResponse_ownerId :: Lens' EnableFastLaunchResponse (Maybe Text)
enableFastLaunchResponse_ownerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunchResponse' {Maybe Text
ownerId :: Maybe Text
$sel:ownerId:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Maybe Text
ownerId} -> Maybe Text
ownerId) (\s :: EnableFastLaunchResponse
s@EnableFastLaunchResponse' {} Maybe Text
a -> EnableFastLaunchResponse
s {$sel:ownerId:EnableFastLaunchResponse' :: Maybe Text
ownerId = Maybe Text
a} :: EnableFastLaunchResponse)

-- | The type of resource that was defined for pre-provisioning the Windows
-- AMI for faster launching.
enableFastLaunchResponse_resourceType :: Lens.Lens' EnableFastLaunchResponse (Prelude.Maybe FastLaunchResourceType)
enableFastLaunchResponse_resourceType :: Lens' EnableFastLaunchResponse (Maybe FastLaunchResourceType)
enableFastLaunchResponse_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunchResponse' {Maybe FastLaunchResourceType
resourceType :: Maybe FastLaunchResourceType
$sel:resourceType:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Maybe FastLaunchResourceType
resourceType} -> Maybe FastLaunchResourceType
resourceType) (\s :: EnableFastLaunchResponse
s@EnableFastLaunchResponse' {} Maybe FastLaunchResourceType
a -> EnableFastLaunchResponse
s {$sel:resourceType:EnableFastLaunchResponse' :: Maybe FastLaunchResourceType
resourceType = Maybe FastLaunchResourceType
a} :: EnableFastLaunchResponse)

-- | The configuration settings that were defined for creating and managing
-- the pre-provisioned snapshots for faster launching of the Windows AMI.
-- This property is returned when the associated @resourceType@ is
-- @snapshot@.
enableFastLaunchResponse_snapshotConfiguration :: Lens.Lens' EnableFastLaunchResponse (Prelude.Maybe FastLaunchSnapshotConfigurationResponse)
enableFastLaunchResponse_snapshotConfiguration :: Lens'
  EnableFastLaunchResponse
  (Maybe FastLaunchSnapshotConfigurationResponse)
enableFastLaunchResponse_snapshotConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunchResponse' {Maybe FastLaunchSnapshotConfigurationResponse
snapshotConfiguration :: Maybe FastLaunchSnapshotConfigurationResponse
$sel:snapshotConfiguration:EnableFastLaunchResponse' :: EnableFastLaunchResponse
-> Maybe FastLaunchSnapshotConfigurationResponse
snapshotConfiguration} -> Maybe FastLaunchSnapshotConfigurationResponse
snapshotConfiguration) (\s :: EnableFastLaunchResponse
s@EnableFastLaunchResponse' {} Maybe FastLaunchSnapshotConfigurationResponse
a -> EnableFastLaunchResponse
s {$sel:snapshotConfiguration:EnableFastLaunchResponse' :: Maybe FastLaunchSnapshotConfigurationResponse
snapshotConfiguration = Maybe FastLaunchSnapshotConfigurationResponse
a} :: EnableFastLaunchResponse)

-- | The current state of faster launching for the specified Windows AMI.
enableFastLaunchResponse_state :: Lens.Lens' EnableFastLaunchResponse (Prelude.Maybe FastLaunchStateCode)
enableFastLaunchResponse_state :: Lens' EnableFastLaunchResponse (Maybe FastLaunchStateCode)
enableFastLaunchResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunchResponse' {Maybe FastLaunchStateCode
state :: Maybe FastLaunchStateCode
$sel:state:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Maybe FastLaunchStateCode
state} -> Maybe FastLaunchStateCode
state) (\s :: EnableFastLaunchResponse
s@EnableFastLaunchResponse' {} Maybe FastLaunchStateCode
a -> EnableFastLaunchResponse
s {$sel:state:EnableFastLaunchResponse' :: Maybe FastLaunchStateCode
state = Maybe FastLaunchStateCode
a} :: EnableFastLaunchResponse)

-- | The reason that the state changed for faster launching for the Windows
-- AMI.
enableFastLaunchResponse_stateTransitionReason :: Lens.Lens' EnableFastLaunchResponse (Prelude.Maybe Prelude.Text)
enableFastLaunchResponse_stateTransitionReason :: Lens' EnableFastLaunchResponse (Maybe Text)
enableFastLaunchResponse_stateTransitionReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunchResponse' {Maybe Text
stateTransitionReason :: Maybe Text
$sel:stateTransitionReason:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Maybe Text
stateTransitionReason} -> Maybe Text
stateTransitionReason) (\s :: EnableFastLaunchResponse
s@EnableFastLaunchResponse' {} Maybe Text
a -> EnableFastLaunchResponse
s {$sel:stateTransitionReason:EnableFastLaunchResponse' :: Maybe Text
stateTransitionReason = Maybe Text
a} :: EnableFastLaunchResponse)

-- | The time that the state changed for faster launching for the Windows
-- AMI.
enableFastLaunchResponse_stateTransitionTime :: Lens.Lens' EnableFastLaunchResponse (Prelude.Maybe Prelude.UTCTime)
enableFastLaunchResponse_stateTransitionTime :: Lens' EnableFastLaunchResponse (Maybe UTCTime)
enableFastLaunchResponse_stateTransitionTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableFastLaunchResponse' {Maybe ISO8601
stateTransitionTime :: Maybe ISO8601
$sel:stateTransitionTime:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Maybe ISO8601
stateTransitionTime} -> Maybe ISO8601
stateTransitionTime) (\s :: EnableFastLaunchResponse
s@EnableFastLaunchResponse' {} Maybe ISO8601
a -> EnableFastLaunchResponse
s {$sel:stateTransitionTime:EnableFastLaunchResponse' :: Maybe ISO8601
stateTransitionTime = Maybe ISO8601
a} :: EnableFastLaunchResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

instance Prelude.NFData EnableFastLaunchResponse where
  rnf :: EnableFastLaunchResponse -> ()
rnf EnableFastLaunchResponse' {Int
Maybe Int
Maybe Text
Maybe ISO8601
Maybe FastLaunchLaunchTemplateSpecificationResponse
Maybe FastLaunchResourceType
Maybe FastLaunchSnapshotConfigurationResponse
Maybe FastLaunchStateCode
httpStatus :: Int
stateTransitionTime :: Maybe ISO8601
stateTransitionReason :: Maybe Text
state :: Maybe FastLaunchStateCode
snapshotConfiguration :: Maybe FastLaunchSnapshotConfigurationResponse
resourceType :: Maybe FastLaunchResourceType
ownerId :: Maybe Text
maxParallelLaunches :: Maybe Int
launchTemplate :: Maybe FastLaunchLaunchTemplateSpecificationResponse
imageId :: Maybe Text
$sel:httpStatus:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Int
$sel:stateTransitionTime:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Maybe ISO8601
$sel:stateTransitionReason:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Maybe Text
$sel:state:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Maybe FastLaunchStateCode
$sel:snapshotConfiguration:EnableFastLaunchResponse' :: EnableFastLaunchResponse
-> Maybe FastLaunchSnapshotConfigurationResponse
$sel:resourceType:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Maybe FastLaunchResourceType
$sel:ownerId:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Maybe Text
$sel:maxParallelLaunches:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Maybe Int
$sel:launchTemplate:EnableFastLaunchResponse' :: EnableFastLaunchResponse
-> Maybe FastLaunchLaunchTemplateSpecificationResponse
$sel:imageId:EnableFastLaunchResponse' :: EnableFastLaunchResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
imageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FastLaunchLaunchTemplateSpecificationResponse
launchTemplate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxParallelLaunches
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ownerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FastLaunchResourceType
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FastLaunchSnapshotConfigurationResponse
snapshotConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FastLaunchStateCode
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stateTransitionReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
stateTransitionTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus