{-# 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.RunScheduledInstances
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Launches the specified Scheduled Instances.
--
-- Before you can launch a Scheduled Instance, you must purchase it and
-- obtain an identifier using PurchaseScheduledInstances.
--
-- You must launch a Scheduled Instance during its scheduled time period.
-- You can\'t stop or reboot a Scheduled Instance, but you can terminate it
-- as needed. If you terminate a Scheduled Instance before the current
-- scheduled time period ends, you can launch it again after a few minutes.
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-scheduled-instances.html Scheduled Instances>
-- in the /Amazon EC2 User Guide/.
module Amazonka.EC2.RunScheduledInstances
  ( -- * Creating a Request
    RunScheduledInstances (..),
    newRunScheduledInstances,

    -- * Request Lenses
    runScheduledInstances_clientToken,
    runScheduledInstances_dryRun,
    runScheduledInstances_instanceCount,
    runScheduledInstances_launchSpecification,
    runScheduledInstances_scheduledInstanceId,

    -- * Destructuring the Response
    RunScheduledInstancesResponse (..),
    newRunScheduledInstancesResponse,

    -- * Response Lenses
    runScheduledInstancesResponse_instanceIdSet,
    runScheduledInstancesResponse_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

-- | Contains the parameters for RunScheduledInstances.
--
-- /See:/ 'newRunScheduledInstances' smart constructor.
data RunScheduledInstances = RunScheduledInstances'
  { -- | Unique, case-sensitive identifier that ensures the idempotency of the
    -- request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
    RunScheduledInstances -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | 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@.
    RunScheduledInstances -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The number of instances.
    --
    -- Default: 1
    RunScheduledInstances -> Maybe Int
instanceCount :: Prelude.Maybe Prelude.Int,
    -- | The launch specification. You must match the instance type, Availability
    -- Zone, network, and platform of the schedule that you purchased.
    RunScheduledInstances -> ScheduledInstancesLaunchSpecification
launchSpecification :: ScheduledInstancesLaunchSpecification,
    -- | The Scheduled Instance ID.
    RunScheduledInstances -> Text
scheduledInstanceId :: Prelude.Text
  }
  deriving (RunScheduledInstances -> RunScheduledInstances -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunScheduledInstances -> RunScheduledInstances -> Bool
$c/= :: RunScheduledInstances -> RunScheduledInstances -> Bool
== :: RunScheduledInstances -> RunScheduledInstances -> Bool
$c== :: RunScheduledInstances -> RunScheduledInstances -> Bool
Prelude.Eq, ReadPrec [RunScheduledInstances]
ReadPrec RunScheduledInstances
Int -> ReadS RunScheduledInstances
ReadS [RunScheduledInstances]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RunScheduledInstances]
$creadListPrec :: ReadPrec [RunScheduledInstances]
readPrec :: ReadPrec RunScheduledInstances
$creadPrec :: ReadPrec RunScheduledInstances
readList :: ReadS [RunScheduledInstances]
$creadList :: ReadS [RunScheduledInstances]
readsPrec :: Int -> ReadS RunScheduledInstances
$creadsPrec :: Int -> ReadS RunScheduledInstances
Prelude.Read, Int -> RunScheduledInstances -> ShowS
[RunScheduledInstances] -> ShowS
RunScheduledInstances -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunScheduledInstances] -> ShowS
$cshowList :: [RunScheduledInstances] -> ShowS
show :: RunScheduledInstances -> String
$cshow :: RunScheduledInstances -> String
showsPrec :: Int -> RunScheduledInstances -> ShowS
$cshowsPrec :: Int -> RunScheduledInstances -> ShowS
Prelude.Show, forall x. Rep RunScheduledInstances x -> RunScheduledInstances
forall x. RunScheduledInstances -> Rep RunScheduledInstances x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RunScheduledInstances x -> RunScheduledInstances
$cfrom :: forall x. RunScheduledInstances -> Rep RunScheduledInstances x
Prelude.Generic)

-- |
-- Create a value of 'RunScheduledInstances' 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', 'runScheduledInstances_clientToken' - Unique, case-sensitive identifier that ensures the idempotency of the
-- request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
--
-- 'dryRun', 'runScheduledInstances_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@.
--
-- 'instanceCount', 'runScheduledInstances_instanceCount' - The number of instances.
--
-- Default: 1
--
-- 'launchSpecification', 'runScheduledInstances_launchSpecification' - The launch specification. You must match the instance type, Availability
-- Zone, network, and platform of the schedule that you purchased.
--
-- 'scheduledInstanceId', 'runScheduledInstances_scheduledInstanceId' - The Scheduled Instance ID.
newRunScheduledInstances ::
  -- | 'launchSpecification'
  ScheduledInstancesLaunchSpecification ->
  -- | 'scheduledInstanceId'
  Prelude.Text ->
  RunScheduledInstances
newRunScheduledInstances :: ScheduledInstancesLaunchSpecification
-> Text -> RunScheduledInstances
newRunScheduledInstances
  ScheduledInstancesLaunchSpecification
pLaunchSpecification_
  Text
pScheduledInstanceId_ =
    RunScheduledInstances'
      { $sel:clientToken:RunScheduledInstances' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dryRun:RunScheduledInstances' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:instanceCount:RunScheduledInstances' :: Maybe Int
instanceCount = forall a. Maybe a
Prelude.Nothing,
        $sel:launchSpecification:RunScheduledInstances' :: ScheduledInstancesLaunchSpecification
launchSpecification = ScheduledInstancesLaunchSpecification
pLaunchSpecification_,
        $sel:scheduledInstanceId:RunScheduledInstances' :: Text
scheduledInstanceId = Text
pScheduledInstanceId_
      }

-- | Unique, case-sensitive identifier that ensures the idempotency of the
-- request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
runScheduledInstances_clientToken :: Lens.Lens' RunScheduledInstances (Prelude.Maybe Prelude.Text)
runScheduledInstances_clientToken :: Lens' RunScheduledInstances (Maybe Text)
runScheduledInstances_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RunScheduledInstances' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:RunScheduledInstances' :: RunScheduledInstances -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: RunScheduledInstances
s@RunScheduledInstances' {} Maybe Text
a -> RunScheduledInstances
s {$sel:clientToken:RunScheduledInstances' :: Maybe Text
clientToken = Maybe Text
a} :: RunScheduledInstances)

-- | 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@.
runScheduledInstances_dryRun :: Lens.Lens' RunScheduledInstances (Prelude.Maybe Prelude.Bool)
runScheduledInstances_dryRun :: Lens' RunScheduledInstances (Maybe Bool)
runScheduledInstances_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RunScheduledInstances' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:RunScheduledInstances' :: RunScheduledInstances -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: RunScheduledInstances
s@RunScheduledInstances' {} Maybe Bool
a -> RunScheduledInstances
s {$sel:dryRun:RunScheduledInstances' :: Maybe Bool
dryRun = Maybe Bool
a} :: RunScheduledInstances)

-- | The number of instances.
--
-- Default: 1
runScheduledInstances_instanceCount :: Lens.Lens' RunScheduledInstances (Prelude.Maybe Prelude.Int)
runScheduledInstances_instanceCount :: Lens' RunScheduledInstances (Maybe Int)
runScheduledInstances_instanceCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RunScheduledInstances' {Maybe Int
instanceCount :: Maybe Int
$sel:instanceCount:RunScheduledInstances' :: RunScheduledInstances -> Maybe Int
instanceCount} -> Maybe Int
instanceCount) (\s :: RunScheduledInstances
s@RunScheduledInstances' {} Maybe Int
a -> RunScheduledInstances
s {$sel:instanceCount:RunScheduledInstances' :: Maybe Int
instanceCount = Maybe Int
a} :: RunScheduledInstances)

-- | The launch specification. You must match the instance type, Availability
-- Zone, network, and platform of the schedule that you purchased.
runScheduledInstances_launchSpecification :: Lens.Lens' RunScheduledInstances ScheduledInstancesLaunchSpecification
runScheduledInstances_launchSpecification :: Lens' RunScheduledInstances ScheduledInstancesLaunchSpecification
runScheduledInstances_launchSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RunScheduledInstances' {ScheduledInstancesLaunchSpecification
launchSpecification :: ScheduledInstancesLaunchSpecification
$sel:launchSpecification:RunScheduledInstances' :: RunScheduledInstances -> ScheduledInstancesLaunchSpecification
launchSpecification} -> ScheduledInstancesLaunchSpecification
launchSpecification) (\s :: RunScheduledInstances
s@RunScheduledInstances' {} ScheduledInstancesLaunchSpecification
a -> RunScheduledInstances
s {$sel:launchSpecification:RunScheduledInstances' :: ScheduledInstancesLaunchSpecification
launchSpecification = ScheduledInstancesLaunchSpecification
a} :: RunScheduledInstances)

-- | The Scheduled Instance ID.
runScheduledInstances_scheduledInstanceId :: Lens.Lens' RunScheduledInstances Prelude.Text
runScheduledInstances_scheduledInstanceId :: Lens' RunScheduledInstances Text
runScheduledInstances_scheduledInstanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RunScheduledInstances' {Text
scheduledInstanceId :: Text
$sel:scheduledInstanceId:RunScheduledInstances' :: RunScheduledInstances -> Text
scheduledInstanceId} -> Text
scheduledInstanceId) (\s :: RunScheduledInstances
s@RunScheduledInstances' {} Text
a -> RunScheduledInstances
s {$sel:scheduledInstanceId:RunScheduledInstances' :: Text
scheduledInstanceId = Text
a} :: RunScheduledInstances)

instance Core.AWSRequest RunScheduledInstances where
  type
    AWSResponse RunScheduledInstances =
      RunScheduledInstancesResponse
  request :: (Service -> Service)
-> RunScheduledInstances -> Request RunScheduledInstances
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 RunScheduledInstances
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RunScheduledInstances)))
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] -> Int -> RunScheduledInstancesResponse
RunScheduledInstancesResponse'
            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
"instanceIdSet"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            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 RunScheduledInstances where
  hashWithSalt :: Int -> RunScheduledInstances -> Int
hashWithSalt Int
_salt RunScheduledInstances' {Maybe Bool
Maybe Int
Maybe Text
Text
ScheduledInstancesLaunchSpecification
scheduledInstanceId :: Text
launchSpecification :: ScheduledInstancesLaunchSpecification
instanceCount :: Maybe Int
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:scheduledInstanceId:RunScheduledInstances' :: RunScheduledInstances -> Text
$sel:launchSpecification:RunScheduledInstances' :: RunScheduledInstances -> ScheduledInstancesLaunchSpecification
$sel:instanceCount:RunScheduledInstances' :: RunScheduledInstances -> Maybe Int
$sel:dryRun:RunScheduledInstances' :: RunScheduledInstances -> Maybe Bool
$sel:clientToken:RunScheduledInstances' :: RunScheduledInstances -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
instanceCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ScheduledInstancesLaunchSpecification
launchSpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
scheduledInstanceId

instance Prelude.NFData RunScheduledInstances where
  rnf :: RunScheduledInstances -> ()
rnf RunScheduledInstances' {Maybe Bool
Maybe Int
Maybe Text
Text
ScheduledInstancesLaunchSpecification
scheduledInstanceId :: Text
launchSpecification :: ScheduledInstancesLaunchSpecification
instanceCount :: Maybe Int
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:scheduledInstanceId:RunScheduledInstances' :: RunScheduledInstances -> Text
$sel:launchSpecification:RunScheduledInstances' :: RunScheduledInstances -> ScheduledInstancesLaunchSpecification
$sel:instanceCount:RunScheduledInstances' :: RunScheduledInstances -> Maybe Int
$sel:dryRun:RunScheduledInstances' :: RunScheduledInstances -> Maybe Bool
$sel:clientToken:RunScheduledInstances' :: RunScheduledInstances -> 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 Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
instanceCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ScheduledInstancesLaunchSpecification
launchSpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
scheduledInstanceId

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

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

instance Data.ToQuery RunScheduledInstances where
  toQuery :: RunScheduledInstances -> QueryString
toQuery RunScheduledInstances' {Maybe Bool
Maybe Int
Maybe Text
Text
ScheduledInstancesLaunchSpecification
scheduledInstanceId :: Text
launchSpecification :: ScheduledInstancesLaunchSpecification
instanceCount :: Maybe Int
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:scheduledInstanceId:RunScheduledInstances' :: RunScheduledInstances -> Text
$sel:launchSpecification:RunScheduledInstances' :: RunScheduledInstances -> ScheduledInstancesLaunchSpecification
$sel:instanceCount:RunScheduledInstances' :: RunScheduledInstances -> Maybe Int
$sel:dryRun:RunScheduledInstances' :: RunScheduledInstances -> Maybe Bool
$sel:clientToken:RunScheduledInstances' :: RunScheduledInstances -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RunScheduledInstances" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"InstanceCount" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
instanceCount,
        ByteString
"LaunchSpecification" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ScheduledInstancesLaunchSpecification
launchSpecification,
        ByteString
"ScheduledInstanceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
scheduledInstanceId
      ]

-- | Contains the output of RunScheduledInstances.
--
-- /See:/ 'newRunScheduledInstancesResponse' smart constructor.
data RunScheduledInstancesResponse = RunScheduledInstancesResponse'
  { -- | The IDs of the newly launched instances.
    RunScheduledInstancesResponse -> Maybe [Text]
instanceIdSet :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    RunScheduledInstancesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RunScheduledInstancesResponse
-> RunScheduledInstancesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunScheduledInstancesResponse
-> RunScheduledInstancesResponse -> Bool
$c/= :: RunScheduledInstancesResponse
-> RunScheduledInstancesResponse -> Bool
== :: RunScheduledInstancesResponse
-> RunScheduledInstancesResponse -> Bool
$c== :: RunScheduledInstancesResponse
-> RunScheduledInstancesResponse -> Bool
Prelude.Eq, ReadPrec [RunScheduledInstancesResponse]
ReadPrec RunScheduledInstancesResponse
Int -> ReadS RunScheduledInstancesResponse
ReadS [RunScheduledInstancesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RunScheduledInstancesResponse]
$creadListPrec :: ReadPrec [RunScheduledInstancesResponse]
readPrec :: ReadPrec RunScheduledInstancesResponse
$creadPrec :: ReadPrec RunScheduledInstancesResponse
readList :: ReadS [RunScheduledInstancesResponse]
$creadList :: ReadS [RunScheduledInstancesResponse]
readsPrec :: Int -> ReadS RunScheduledInstancesResponse
$creadsPrec :: Int -> ReadS RunScheduledInstancesResponse
Prelude.Read, Int -> RunScheduledInstancesResponse -> ShowS
[RunScheduledInstancesResponse] -> ShowS
RunScheduledInstancesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunScheduledInstancesResponse] -> ShowS
$cshowList :: [RunScheduledInstancesResponse] -> ShowS
show :: RunScheduledInstancesResponse -> String
$cshow :: RunScheduledInstancesResponse -> String
showsPrec :: Int -> RunScheduledInstancesResponse -> ShowS
$cshowsPrec :: Int -> RunScheduledInstancesResponse -> ShowS
Prelude.Show, forall x.
Rep RunScheduledInstancesResponse x
-> RunScheduledInstancesResponse
forall x.
RunScheduledInstancesResponse
-> Rep RunScheduledInstancesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RunScheduledInstancesResponse x
-> RunScheduledInstancesResponse
$cfrom :: forall x.
RunScheduledInstancesResponse
-> Rep RunScheduledInstancesResponse x
Prelude.Generic)

-- |
-- Create a value of 'RunScheduledInstancesResponse' 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:
--
-- 'instanceIdSet', 'runScheduledInstancesResponse_instanceIdSet' - The IDs of the newly launched instances.
--
-- 'httpStatus', 'runScheduledInstancesResponse_httpStatus' - The response's http status code.
newRunScheduledInstancesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RunScheduledInstancesResponse
newRunScheduledInstancesResponse :: Int -> RunScheduledInstancesResponse
newRunScheduledInstancesResponse Int
pHttpStatus_ =
  RunScheduledInstancesResponse'
    { $sel:instanceIdSet:RunScheduledInstancesResponse' :: Maybe [Text]
instanceIdSet =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RunScheduledInstancesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The IDs of the newly launched instances.
runScheduledInstancesResponse_instanceIdSet :: Lens.Lens' RunScheduledInstancesResponse (Prelude.Maybe [Prelude.Text])
runScheduledInstancesResponse_instanceIdSet :: Lens' RunScheduledInstancesResponse (Maybe [Text])
runScheduledInstancesResponse_instanceIdSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RunScheduledInstancesResponse' {Maybe [Text]
instanceIdSet :: Maybe [Text]
$sel:instanceIdSet:RunScheduledInstancesResponse' :: RunScheduledInstancesResponse -> Maybe [Text]
instanceIdSet} -> Maybe [Text]
instanceIdSet) (\s :: RunScheduledInstancesResponse
s@RunScheduledInstancesResponse' {} Maybe [Text]
a -> RunScheduledInstancesResponse
s {$sel:instanceIdSet:RunScheduledInstancesResponse' :: Maybe [Text]
instanceIdSet = Maybe [Text]
a} :: RunScheduledInstancesResponse) 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 response's http status code.
runScheduledInstancesResponse_httpStatus :: Lens.Lens' RunScheduledInstancesResponse Prelude.Int
runScheduledInstancesResponse_httpStatus :: Lens' RunScheduledInstancesResponse Int
runScheduledInstancesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RunScheduledInstancesResponse' {Int
httpStatus :: Int
$sel:httpStatus:RunScheduledInstancesResponse' :: RunScheduledInstancesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: RunScheduledInstancesResponse
s@RunScheduledInstancesResponse' {} Int
a -> RunScheduledInstancesResponse
s {$sel:httpStatus:RunScheduledInstancesResponse' :: Int
httpStatus = Int
a} :: RunScheduledInstancesResponse)

instance Prelude.NFData RunScheduledInstancesResponse where
  rnf :: RunScheduledInstancesResponse -> ()
rnf RunScheduledInstancesResponse' {Int
Maybe [Text]
httpStatus :: Int
instanceIdSet :: Maybe [Text]
$sel:httpStatus:RunScheduledInstancesResponse' :: RunScheduledInstancesResponse -> Int
$sel:instanceIdSet:RunScheduledInstancesResponse' :: RunScheduledInstancesResponse -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
instanceIdSet
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus