{-# 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.GetSpotPlacementScores
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Calculates the Spot placement score for a Region or Availability Zone
-- based on the specified target capacity and compute requirements.
--
-- You can specify your compute requirements either by using
-- @InstanceRequirementsWithMetadata@ and letting Amazon EC2 choose the
-- optimal instance types to fulfill your Spot request, or you can specify
-- the instance types by using @InstanceTypes@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/spot-placement-score.html Spot placement score>
-- in the Amazon EC2 User Guide.
--
-- This operation returns paginated results.
module Amazonka.EC2.GetSpotPlacementScores
  ( -- * Creating a Request
    GetSpotPlacementScores (..),
    newGetSpotPlacementScores,

    -- * Request Lenses
    getSpotPlacementScores_dryRun,
    getSpotPlacementScores_instanceRequirementsWithMetadata,
    getSpotPlacementScores_instanceTypes,
    getSpotPlacementScores_maxResults,
    getSpotPlacementScores_nextToken,
    getSpotPlacementScores_regionNames,
    getSpotPlacementScores_singleAvailabilityZone,
    getSpotPlacementScores_targetCapacityUnitType,
    getSpotPlacementScores_targetCapacity,

    -- * Destructuring the Response
    GetSpotPlacementScoresResponse (..),
    newGetSpotPlacementScoresResponse,

    -- * Response Lenses
    getSpotPlacementScoresResponse_nextToken,
    getSpotPlacementScoresResponse_spotPlacementScores,
    getSpotPlacementScoresResponse_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:/ 'newGetSpotPlacementScores' smart constructor.
data GetSpotPlacementScores = GetSpotPlacementScores'
  { -- | 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@.
    GetSpotPlacementScores -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The attributes for the instance types. When you specify instance
    -- attributes, Amazon EC2 will identify instance types with those
    -- attributes.
    --
    -- If you specify @InstanceRequirementsWithMetadata@, you can\'t specify
    -- @InstanceTypes@.
    GetSpotPlacementScores
-> Maybe InstanceRequirementsWithMetadataRequest
instanceRequirementsWithMetadata :: Prelude.Maybe InstanceRequirementsWithMetadataRequest,
    -- | The instance types. We recommend that you specify at least three
    -- instance types. If you specify one or two instance types, or specify
    -- variations of a single instance type (for example, an @m3.xlarge@ with
    -- and without instance storage), the returned placement score will always
    -- be low.
    --
    -- If you specify @InstanceTypes@, you can\'t specify
    -- @InstanceRequirementsWithMetadata@.
    GetSpotPlacementScores -> Maybe [Text]
instanceTypes :: Prelude.Maybe [Prelude.Text],
    -- | The maximum number of results to return in a single call. Specify a
    -- value between 1 and
 1000. The default value is 1000. To retrieve the
    -- remaining results, make another call with
 the returned @NextToken@
    -- value.
    GetSpotPlacementScores -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token for the next set of results.
    GetSpotPlacementScores -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The Regions used to narrow down the list of Regions to be scored. Enter
    -- the Region code, for example, @us-east-1@.
    GetSpotPlacementScores -> Maybe [Text]
regionNames :: Prelude.Maybe [Prelude.Text],
    -- | Specify @true@ so that the response returns a list of scored
    -- Availability Zones. Otherwise, the response returns a list of scored
    -- Regions.
    --
    -- A list of scored Availability Zones is useful if you want to launch all
    -- of your Spot capacity into a single Availability Zone.
    GetSpotPlacementScores -> Maybe Bool
singleAvailabilityZone :: Prelude.Maybe Prelude.Bool,
    -- | The unit for the target capacity.
    --
    -- Default: @units@ (translates to number of instances)
    GetSpotPlacementScores -> Maybe TargetCapacityUnitType
targetCapacityUnitType :: Prelude.Maybe TargetCapacityUnitType,
    -- | The target capacity.
    GetSpotPlacementScores -> Natural
targetCapacity :: Prelude.Natural
  }
  deriving (GetSpotPlacementScores -> GetSpotPlacementScores -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSpotPlacementScores -> GetSpotPlacementScores -> Bool
$c/= :: GetSpotPlacementScores -> GetSpotPlacementScores -> Bool
== :: GetSpotPlacementScores -> GetSpotPlacementScores -> Bool
$c== :: GetSpotPlacementScores -> GetSpotPlacementScores -> Bool
Prelude.Eq, ReadPrec [GetSpotPlacementScores]
ReadPrec GetSpotPlacementScores
Int -> ReadS GetSpotPlacementScores
ReadS [GetSpotPlacementScores]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSpotPlacementScores]
$creadListPrec :: ReadPrec [GetSpotPlacementScores]
readPrec :: ReadPrec GetSpotPlacementScores
$creadPrec :: ReadPrec GetSpotPlacementScores
readList :: ReadS [GetSpotPlacementScores]
$creadList :: ReadS [GetSpotPlacementScores]
readsPrec :: Int -> ReadS GetSpotPlacementScores
$creadsPrec :: Int -> ReadS GetSpotPlacementScores
Prelude.Read, Int -> GetSpotPlacementScores -> ShowS
[GetSpotPlacementScores] -> ShowS
GetSpotPlacementScores -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSpotPlacementScores] -> ShowS
$cshowList :: [GetSpotPlacementScores] -> ShowS
show :: GetSpotPlacementScores -> String
$cshow :: GetSpotPlacementScores -> String
showsPrec :: Int -> GetSpotPlacementScores -> ShowS
$cshowsPrec :: Int -> GetSpotPlacementScores -> ShowS
Prelude.Show, forall x. Rep GetSpotPlacementScores x -> GetSpotPlacementScores
forall x. GetSpotPlacementScores -> Rep GetSpotPlacementScores x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSpotPlacementScores x -> GetSpotPlacementScores
$cfrom :: forall x. GetSpotPlacementScores -> Rep GetSpotPlacementScores x
Prelude.Generic)

-- |
-- Create a value of 'GetSpotPlacementScores' 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', 'getSpotPlacementScores_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@.
--
-- 'instanceRequirementsWithMetadata', 'getSpotPlacementScores_instanceRequirementsWithMetadata' - The attributes for the instance types. When you specify instance
-- attributes, Amazon EC2 will identify instance types with those
-- attributes.
--
-- If you specify @InstanceRequirementsWithMetadata@, you can\'t specify
-- @InstanceTypes@.
--
-- 'instanceTypes', 'getSpotPlacementScores_instanceTypes' - The instance types. We recommend that you specify at least three
-- instance types. If you specify one or two instance types, or specify
-- variations of a single instance type (for example, an @m3.xlarge@ with
-- and without instance storage), the returned placement score will always
-- be low.
--
-- If you specify @InstanceTypes@, you can\'t specify
-- @InstanceRequirementsWithMetadata@.
--
-- 'maxResults', 'getSpotPlacementScores_maxResults' - The maximum number of results to return in a single call. Specify a
-- value between 1 and
 1000. The default value is 1000. To retrieve the
-- remaining results, make another call with
 the returned @NextToken@
-- value.
--
-- 'nextToken', 'getSpotPlacementScores_nextToken' - The token for the next set of results.
--
-- 'regionNames', 'getSpotPlacementScores_regionNames' - The Regions used to narrow down the list of Regions to be scored. Enter
-- the Region code, for example, @us-east-1@.
--
-- 'singleAvailabilityZone', 'getSpotPlacementScores_singleAvailabilityZone' - Specify @true@ so that the response returns a list of scored
-- Availability Zones. Otherwise, the response returns a list of scored
-- Regions.
--
-- A list of scored Availability Zones is useful if you want to launch all
-- of your Spot capacity into a single Availability Zone.
--
-- 'targetCapacityUnitType', 'getSpotPlacementScores_targetCapacityUnitType' - The unit for the target capacity.
--
-- Default: @units@ (translates to number of instances)
--
-- 'targetCapacity', 'getSpotPlacementScores_targetCapacity' - The target capacity.
newGetSpotPlacementScores ::
  -- | 'targetCapacity'
  Prelude.Natural ->
  GetSpotPlacementScores
newGetSpotPlacementScores :: Natural -> GetSpotPlacementScores
newGetSpotPlacementScores Natural
pTargetCapacity_ =
  GetSpotPlacementScores'
    { $sel:dryRun:GetSpotPlacementScores' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceRequirementsWithMetadata:GetSpotPlacementScores' :: Maybe InstanceRequirementsWithMetadataRequest
instanceRequirementsWithMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceTypes:GetSpotPlacementScores' :: Maybe [Text]
instanceTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetSpotPlacementScores' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetSpotPlacementScores' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:regionNames:GetSpotPlacementScores' :: Maybe [Text]
regionNames = forall a. Maybe a
Prelude.Nothing,
      $sel:singleAvailabilityZone:GetSpotPlacementScores' :: Maybe Bool
singleAvailabilityZone = forall a. Maybe a
Prelude.Nothing,
      $sel:targetCapacityUnitType:GetSpotPlacementScores' :: Maybe TargetCapacityUnitType
targetCapacityUnitType = forall a. Maybe a
Prelude.Nothing,
      $sel:targetCapacity:GetSpotPlacementScores' :: Natural
targetCapacity = Natural
pTargetCapacity_
    }

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

-- | The attributes for the instance types. When you specify instance
-- attributes, Amazon EC2 will identify instance types with those
-- attributes.
--
-- If you specify @InstanceRequirementsWithMetadata@, you can\'t specify
-- @InstanceTypes@.
getSpotPlacementScores_instanceRequirementsWithMetadata :: Lens.Lens' GetSpotPlacementScores (Prelude.Maybe InstanceRequirementsWithMetadataRequest)
getSpotPlacementScores_instanceRequirementsWithMetadata :: Lens'
  GetSpotPlacementScores
  (Maybe InstanceRequirementsWithMetadataRequest)
getSpotPlacementScores_instanceRequirementsWithMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSpotPlacementScores' {Maybe InstanceRequirementsWithMetadataRequest
instanceRequirementsWithMetadata :: Maybe InstanceRequirementsWithMetadataRequest
$sel:instanceRequirementsWithMetadata:GetSpotPlacementScores' :: GetSpotPlacementScores
-> Maybe InstanceRequirementsWithMetadataRequest
instanceRequirementsWithMetadata} -> Maybe InstanceRequirementsWithMetadataRequest
instanceRequirementsWithMetadata) (\s :: GetSpotPlacementScores
s@GetSpotPlacementScores' {} Maybe InstanceRequirementsWithMetadataRequest
a -> GetSpotPlacementScores
s {$sel:instanceRequirementsWithMetadata:GetSpotPlacementScores' :: Maybe InstanceRequirementsWithMetadataRequest
instanceRequirementsWithMetadata = Maybe InstanceRequirementsWithMetadataRequest
a} :: GetSpotPlacementScores)

-- | The instance types. We recommend that you specify at least three
-- instance types. If you specify one or two instance types, or specify
-- variations of a single instance type (for example, an @m3.xlarge@ with
-- and without instance storage), the returned placement score will always
-- be low.
--
-- If you specify @InstanceTypes@, you can\'t specify
-- @InstanceRequirementsWithMetadata@.
getSpotPlacementScores_instanceTypes :: Lens.Lens' GetSpotPlacementScores (Prelude.Maybe [Prelude.Text])
getSpotPlacementScores_instanceTypes :: Lens' GetSpotPlacementScores (Maybe [Text])
getSpotPlacementScores_instanceTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSpotPlacementScores' {Maybe [Text]
instanceTypes :: Maybe [Text]
$sel:instanceTypes:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe [Text]
instanceTypes} -> Maybe [Text]
instanceTypes) (\s :: GetSpotPlacementScores
s@GetSpotPlacementScores' {} Maybe [Text]
a -> GetSpotPlacementScores
s {$sel:instanceTypes:GetSpotPlacementScores' :: Maybe [Text]
instanceTypes = Maybe [Text]
a} :: GetSpotPlacementScores) 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 maximum number of results to return in a single call. Specify a
-- value between 1 and
 1000. The default value is 1000. To retrieve the
-- remaining results, make another call with
 the returned @NextToken@
-- value.
getSpotPlacementScores_maxResults :: Lens.Lens' GetSpotPlacementScores (Prelude.Maybe Prelude.Natural)
getSpotPlacementScores_maxResults :: Lens' GetSpotPlacementScores (Maybe Natural)
getSpotPlacementScores_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSpotPlacementScores' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetSpotPlacementScores
s@GetSpotPlacementScores' {} Maybe Natural
a -> GetSpotPlacementScores
s {$sel:maxResults:GetSpotPlacementScores' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetSpotPlacementScores)

-- | The token for the next set of results.
getSpotPlacementScores_nextToken :: Lens.Lens' GetSpotPlacementScores (Prelude.Maybe Prelude.Text)
getSpotPlacementScores_nextToken :: Lens' GetSpotPlacementScores (Maybe Text)
getSpotPlacementScores_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSpotPlacementScores' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetSpotPlacementScores
s@GetSpotPlacementScores' {} Maybe Text
a -> GetSpotPlacementScores
s {$sel:nextToken:GetSpotPlacementScores' :: Maybe Text
nextToken = Maybe Text
a} :: GetSpotPlacementScores)

-- | The Regions used to narrow down the list of Regions to be scored. Enter
-- the Region code, for example, @us-east-1@.
getSpotPlacementScores_regionNames :: Lens.Lens' GetSpotPlacementScores (Prelude.Maybe [Prelude.Text])
getSpotPlacementScores_regionNames :: Lens' GetSpotPlacementScores (Maybe [Text])
getSpotPlacementScores_regionNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSpotPlacementScores' {Maybe [Text]
regionNames :: Maybe [Text]
$sel:regionNames:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe [Text]
regionNames} -> Maybe [Text]
regionNames) (\s :: GetSpotPlacementScores
s@GetSpotPlacementScores' {} Maybe [Text]
a -> GetSpotPlacementScores
s {$sel:regionNames:GetSpotPlacementScores' :: Maybe [Text]
regionNames = Maybe [Text]
a} :: GetSpotPlacementScores) 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

-- | Specify @true@ so that the response returns a list of scored
-- Availability Zones. Otherwise, the response returns a list of scored
-- Regions.
--
-- A list of scored Availability Zones is useful if you want to launch all
-- of your Spot capacity into a single Availability Zone.
getSpotPlacementScores_singleAvailabilityZone :: Lens.Lens' GetSpotPlacementScores (Prelude.Maybe Prelude.Bool)
getSpotPlacementScores_singleAvailabilityZone :: Lens' GetSpotPlacementScores (Maybe Bool)
getSpotPlacementScores_singleAvailabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSpotPlacementScores' {Maybe Bool
singleAvailabilityZone :: Maybe Bool
$sel:singleAvailabilityZone:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe Bool
singleAvailabilityZone} -> Maybe Bool
singleAvailabilityZone) (\s :: GetSpotPlacementScores
s@GetSpotPlacementScores' {} Maybe Bool
a -> GetSpotPlacementScores
s {$sel:singleAvailabilityZone:GetSpotPlacementScores' :: Maybe Bool
singleAvailabilityZone = Maybe Bool
a} :: GetSpotPlacementScores)

-- | The unit for the target capacity.
--
-- Default: @units@ (translates to number of instances)
getSpotPlacementScores_targetCapacityUnitType :: Lens.Lens' GetSpotPlacementScores (Prelude.Maybe TargetCapacityUnitType)
getSpotPlacementScores_targetCapacityUnitType :: Lens' GetSpotPlacementScores (Maybe TargetCapacityUnitType)
getSpotPlacementScores_targetCapacityUnitType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSpotPlacementScores' {Maybe TargetCapacityUnitType
targetCapacityUnitType :: Maybe TargetCapacityUnitType
$sel:targetCapacityUnitType:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe TargetCapacityUnitType
targetCapacityUnitType} -> Maybe TargetCapacityUnitType
targetCapacityUnitType) (\s :: GetSpotPlacementScores
s@GetSpotPlacementScores' {} Maybe TargetCapacityUnitType
a -> GetSpotPlacementScores
s {$sel:targetCapacityUnitType:GetSpotPlacementScores' :: Maybe TargetCapacityUnitType
targetCapacityUnitType = Maybe TargetCapacityUnitType
a} :: GetSpotPlacementScores)

-- | The target capacity.
getSpotPlacementScores_targetCapacity :: Lens.Lens' GetSpotPlacementScores Prelude.Natural
getSpotPlacementScores_targetCapacity :: Lens' GetSpotPlacementScores Natural
getSpotPlacementScores_targetCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSpotPlacementScores' {Natural
targetCapacity :: Natural
$sel:targetCapacity:GetSpotPlacementScores' :: GetSpotPlacementScores -> Natural
targetCapacity} -> Natural
targetCapacity) (\s :: GetSpotPlacementScores
s@GetSpotPlacementScores' {} Natural
a -> GetSpotPlacementScores
s {$sel:targetCapacity:GetSpotPlacementScores' :: Natural
targetCapacity = Natural
a} :: GetSpotPlacementScores)

instance Core.AWSPager GetSpotPlacementScores where
  page :: GetSpotPlacementScores
-> AWSResponse GetSpotPlacementScores
-> Maybe GetSpotPlacementScores
page GetSpotPlacementScores
rq AWSResponse GetSpotPlacementScores
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetSpotPlacementScores
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetSpotPlacementScoresResponse (Maybe Text)
getSpotPlacementScoresResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetSpotPlacementScores
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetSpotPlacementScoresResponse (Maybe [SpotPlacementScore])
getSpotPlacementScoresResponse_spotPlacementScores
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ GetSpotPlacementScores
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetSpotPlacementScores (Maybe Text)
getSpotPlacementScores_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetSpotPlacementScores
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetSpotPlacementScoresResponse (Maybe Text)
getSpotPlacementScoresResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest GetSpotPlacementScores where
  type
    AWSResponse GetSpotPlacementScores =
      GetSpotPlacementScoresResponse
  request :: (Service -> Service)
-> GetSpotPlacementScores -> Request GetSpotPlacementScores
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 GetSpotPlacementScores
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetSpotPlacementScores)))
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 [SpotPlacementScore]
-> Int
-> GetSpotPlacementScoresResponse
GetSpotPlacementScoresResponse'
            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
"nextToken")
            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
"spotPlacementScoreSet"
                            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 GetSpotPlacementScores where
  hashWithSalt :: Int -> GetSpotPlacementScores -> Int
hashWithSalt Int
_salt GetSpotPlacementScores' {Natural
Maybe Bool
Maybe Natural
Maybe [Text]
Maybe Text
Maybe TargetCapacityUnitType
Maybe InstanceRequirementsWithMetadataRequest
targetCapacity :: Natural
targetCapacityUnitType :: Maybe TargetCapacityUnitType
singleAvailabilityZone :: Maybe Bool
regionNames :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Natural
instanceTypes :: Maybe [Text]
instanceRequirementsWithMetadata :: Maybe InstanceRequirementsWithMetadataRequest
dryRun :: Maybe Bool
$sel:targetCapacity:GetSpotPlacementScores' :: GetSpotPlacementScores -> Natural
$sel:targetCapacityUnitType:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe TargetCapacityUnitType
$sel:singleAvailabilityZone:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe Bool
$sel:regionNames:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe [Text]
$sel:nextToken:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe Text
$sel:maxResults:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe Natural
$sel:instanceTypes:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe [Text]
$sel:instanceRequirementsWithMetadata:GetSpotPlacementScores' :: GetSpotPlacementScores
-> Maybe InstanceRequirementsWithMetadataRequest
$sel:dryRun:GetSpotPlacementScores' :: GetSpotPlacementScores -> 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 InstanceRequirementsWithMetadataRequest
instanceRequirementsWithMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
instanceTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
regionNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
singleAvailabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TargetCapacityUnitType
targetCapacityUnitType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
targetCapacity

instance Prelude.NFData GetSpotPlacementScores where
  rnf :: GetSpotPlacementScores -> ()
rnf GetSpotPlacementScores' {Natural
Maybe Bool
Maybe Natural
Maybe [Text]
Maybe Text
Maybe TargetCapacityUnitType
Maybe InstanceRequirementsWithMetadataRequest
targetCapacity :: Natural
targetCapacityUnitType :: Maybe TargetCapacityUnitType
singleAvailabilityZone :: Maybe Bool
regionNames :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Natural
instanceTypes :: Maybe [Text]
instanceRequirementsWithMetadata :: Maybe InstanceRequirementsWithMetadataRequest
dryRun :: Maybe Bool
$sel:targetCapacity:GetSpotPlacementScores' :: GetSpotPlacementScores -> Natural
$sel:targetCapacityUnitType:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe TargetCapacityUnitType
$sel:singleAvailabilityZone:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe Bool
$sel:regionNames:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe [Text]
$sel:nextToken:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe Text
$sel:maxResults:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe Natural
$sel:instanceTypes:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe [Text]
$sel:instanceRequirementsWithMetadata:GetSpotPlacementScores' :: GetSpotPlacementScores
-> Maybe InstanceRequirementsWithMetadataRequest
$sel:dryRun:GetSpotPlacementScores' :: GetSpotPlacementScores -> 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 InstanceRequirementsWithMetadataRequest
instanceRequirementsWithMetadata
      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 Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
regionNames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
singleAvailabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TargetCapacityUnitType
targetCapacityUnitType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
targetCapacity

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

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

instance Data.ToQuery GetSpotPlacementScores where
  toQuery :: GetSpotPlacementScores -> QueryString
toQuery GetSpotPlacementScores' {Natural
Maybe Bool
Maybe Natural
Maybe [Text]
Maybe Text
Maybe TargetCapacityUnitType
Maybe InstanceRequirementsWithMetadataRequest
targetCapacity :: Natural
targetCapacityUnitType :: Maybe TargetCapacityUnitType
singleAvailabilityZone :: Maybe Bool
regionNames :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Natural
instanceTypes :: Maybe [Text]
instanceRequirementsWithMetadata :: Maybe InstanceRequirementsWithMetadataRequest
dryRun :: Maybe Bool
$sel:targetCapacity:GetSpotPlacementScores' :: GetSpotPlacementScores -> Natural
$sel:targetCapacityUnitType:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe TargetCapacityUnitType
$sel:singleAvailabilityZone:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe Bool
$sel:regionNames:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe [Text]
$sel:nextToken:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe Text
$sel:maxResults:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe Natural
$sel:instanceTypes:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe [Text]
$sel:instanceRequirementsWithMetadata:GetSpotPlacementScores' :: GetSpotPlacementScores
-> Maybe InstanceRequirementsWithMetadataRequest
$sel:dryRun:GetSpotPlacementScores' :: GetSpotPlacementScores -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetSpotPlacementScores" :: 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
"InstanceRequirementsWithMetadata"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe InstanceRequirementsWithMetadataRequest
instanceRequirementsWithMetadata,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"InstanceType"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
instanceTypes
          ),
        ByteString
"MaxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"RegionName"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
regionNames
          ),
        ByteString
"SingleAvailabilityZone"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
singleAvailabilityZone,
        ByteString
"TargetCapacityUnitType"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe TargetCapacityUnitType
targetCapacityUnitType,
        ByteString
"TargetCapacity" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Natural
targetCapacity
      ]

-- | /See:/ 'newGetSpotPlacementScoresResponse' smart constructor.
data GetSpotPlacementScoresResponse = GetSpotPlacementScoresResponse'
  { -- | The token for the next set of results.
    GetSpotPlacementScoresResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The Spot placement score for the top 10 Regions or Availability Zones,
    -- scored on a scale from 1 to 10. Each score
 reflects how likely it is
    -- that each Region or Availability Zone will succeed at fulfilling the
    -- specified target capacity
 /at the time of the Spot placement score
    -- request/. A score of @10@ means that your Spot capacity request is
    -- highly likely to succeed in that Region or Availability Zone.
    --
    -- If you request a Spot placement score for Regions, a high score assumes
    -- that your fleet request will be configured to use all Availability Zones
    -- and the @capacity-optimized@ allocation strategy. If you request a Spot
    -- placement score for Availability Zones, a high score assumes that your
    -- fleet request will be configured to use a single Availability Zone and
    -- the @capacity-optimized@ allocation strategy.
    --
    -- Different
 Regions or Availability Zones might return the same score.
    --
    -- The Spot placement score serves as a recommendation only. No score
    -- guarantees that your Spot request will be fully or partially fulfilled.
    GetSpotPlacementScoresResponse -> Maybe [SpotPlacementScore]
spotPlacementScores :: Prelude.Maybe [SpotPlacementScore],
    -- | The response's http status code.
    GetSpotPlacementScoresResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetSpotPlacementScoresResponse
-> GetSpotPlacementScoresResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSpotPlacementScoresResponse
-> GetSpotPlacementScoresResponse -> Bool
$c/= :: GetSpotPlacementScoresResponse
-> GetSpotPlacementScoresResponse -> Bool
== :: GetSpotPlacementScoresResponse
-> GetSpotPlacementScoresResponse -> Bool
$c== :: GetSpotPlacementScoresResponse
-> GetSpotPlacementScoresResponse -> Bool
Prelude.Eq, ReadPrec [GetSpotPlacementScoresResponse]
ReadPrec GetSpotPlacementScoresResponse
Int -> ReadS GetSpotPlacementScoresResponse
ReadS [GetSpotPlacementScoresResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSpotPlacementScoresResponse]
$creadListPrec :: ReadPrec [GetSpotPlacementScoresResponse]
readPrec :: ReadPrec GetSpotPlacementScoresResponse
$creadPrec :: ReadPrec GetSpotPlacementScoresResponse
readList :: ReadS [GetSpotPlacementScoresResponse]
$creadList :: ReadS [GetSpotPlacementScoresResponse]
readsPrec :: Int -> ReadS GetSpotPlacementScoresResponse
$creadsPrec :: Int -> ReadS GetSpotPlacementScoresResponse
Prelude.Read, Int -> GetSpotPlacementScoresResponse -> ShowS
[GetSpotPlacementScoresResponse] -> ShowS
GetSpotPlacementScoresResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSpotPlacementScoresResponse] -> ShowS
$cshowList :: [GetSpotPlacementScoresResponse] -> ShowS
show :: GetSpotPlacementScoresResponse -> String
$cshow :: GetSpotPlacementScoresResponse -> String
showsPrec :: Int -> GetSpotPlacementScoresResponse -> ShowS
$cshowsPrec :: Int -> GetSpotPlacementScoresResponse -> ShowS
Prelude.Show, forall x.
Rep GetSpotPlacementScoresResponse x
-> GetSpotPlacementScoresResponse
forall x.
GetSpotPlacementScoresResponse
-> Rep GetSpotPlacementScoresResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetSpotPlacementScoresResponse x
-> GetSpotPlacementScoresResponse
$cfrom :: forall x.
GetSpotPlacementScoresResponse
-> Rep GetSpotPlacementScoresResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetSpotPlacementScoresResponse' 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:
--
-- 'nextToken', 'getSpotPlacementScoresResponse_nextToken' - The token for the next set of results.
--
-- 'spotPlacementScores', 'getSpotPlacementScoresResponse_spotPlacementScores' - The Spot placement score for the top 10 Regions or Availability Zones,
-- scored on a scale from 1 to 10. Each score
 reflects how likely it is
-- that each Region or Availability Zone will succeed at fulfilling the
-- specified target capacity
 /at the time of the Spot placement score
-- request/. A score of @10@ means that your Spot capacity request is
-- highly likely to succeed in that Region or Availability Zone.
--
-- If you request a Spot placement score for Regions, a high score assumes
-- that your fleet request will be configured to use all Availability Zones
-- and the @capacity-optimized@ allocation strategy. If you request a Spot
-- placement score for Availability Zones, a high score assumes that your
-- fleet request will be configured to use a single Availability Zone and
-- the @capacity-optimized@ allocation strategy.
--
-- Different
 Regions or Availability Zones might return the same score.
--
-- The Spot placement score serves as a recommendation only. No score
-- guarantees that your Spot request will be fully or partially fulfilled.
--
-- 'httpStatus', 'getSpotPlacementScoresResponse_httpStatus' - The response's http status code.
newGetSpotPlacementScoresResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSpotPlacementScoresResponse
newGetSpotPlacementScoresResponse :: Int -> GetSpotPlacementScoresResponse
newGetSpotPlacementScoresResponse Int
pHttpStatus_ =
  GetSpotPlacementScoresResponse'
    { $sel:nextToken:GetSpotPlacementScoresResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:spotPlacementScores:GetSpotPlacementScoresResponse' :: Maybe [SpotPlacementScore]
spotPlacementScores = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSpotPlacementScoresResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The token for the next set of results.
getSpotPlacementScoresResponse_nextToken :: Lens.Lens' GetSpotPlacementScoresResponse (Prelude.Maybe Prelude.Text)
getSpotPlacementScoresResponse_nextToken :: Lens' GetSpotPlacementScoresResponse (Maybe Text)
getSpotPlacementScoresResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSpotPlacementScoresResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetSpotPlacementScoresResponse' :: GetSpotPlacementScoresResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetSpotPlacementScoresResponse
s@GetSpotPlacementScoresResponse' {} Maybe Text
a -> GetSpotPlacementScoresResponse
s {$sel:nextToken:GetSpotPlacementScoresResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetSpotPlacementScoresResponse)

-- | The Spot placement score for the top 10 Regions or Availability Zones,
-- scored on a scale from 1 to 10. Each score
 reflects how likely it is
-- that each Region or Availability Zone will succeed at fulfilling the
-- specified target capacity
 /at the time of the Spot placement score
-- request/. A score of @10@ means that your Spot capacity request is
-- highly likely to succeed in that Region or Availability Zone.
--
-- If you request a Spot placement score for Regions, a high score assumes
-- that your fleet request will be configured to use all Availability Zones
-- and the @capacity-optimized@ allocation strategy. If you request a Spot
-- placement score for Availability Zones, a high score assumes that your
-- fleet request will be configured to use a single Availability Zone and
-- the @capacity-optimized@ allocation strategy.
--
-- Different
 Regions or Availability Zones might return the same score.
--
-- The Spot placement score serves as a recommendation only. No score
-- guarantees that your Spot request will be fully or partially fulfilled.
getSpotPlacementScoresResponse_spotPlacementScores :: Lens.Lens' GetSpotPlacementScoresResponse (Prelude.Maybe [SpotPlacementScore])
getSpotPlacementScoresResponse_spotPlacementScores :: Lens' GetSpotPlacementScoresResponse (Maybe [SpotPlacementScore])
getSpotPlacementScoresResponse_spotPlacementScores = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSpotPlacementScoresResponse' {Maybe [SpotPlacementScore]
spotPlacementScores :: Maybe [SpotPlacementScore]
$sel:spotPlacementScores:GetSpotPlacementScoresResponse' :: GetSpotPlacementScoresResponse -> Maybe [SpotPlacementScore]
spotPlacementScores} -> Maybe [SpotPlacementScore]
spotPlacementScores) (\s :: GetSpotPlacementScoresResponse
s@GetSpotPlacementScoresResponse' {} Maybe [SpotPlacementScore]
a -> GetSpotPlacementScoresResponse
s {$sel:spotPlacementScores:GetSpotPlacementScoresResponse' :: Maybe [SpotPlacementScore]
spotPlacementScores = Maybe [SpotPlacementScore]
a} :: GetSpotPlacementScoresResponse) 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.
getSpotPlacementScoresResponse_httpStatus :: Lens.Lens' GetSpotPlacementScoresResponse Prelude.Int
getSpotPlacementScoresResponse_httpStatus :: Lens' GetSpotPlacementScoresResponse Int
getSpotPlacementScoresResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSpotPlacementScoresResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetSpotPlacementScoresResponse' :: GetSpotPlacementScoresResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetSpotPlacementScoresResponse
s@GetSpotPlacementScoresResponse' {} Int
a -> GetSpotPlacementScoresResponse
s {$sel:httpStatus:GetSpotPlacementScoresResponse' :: Int
httpStatus = Int
a} :: GetSpotPlacementScoresResponse)

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