{-# 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.PurchaseScheduledInstances
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- You can no longer purchase Scheduled Instances.
--
-- Purchases the Scheduled Instances with the specified schedule.
--
-- Scheduled Instances enable you to purchase Amazon EC2 compute capacity
-- by the hour for a one-year term. Before you can purchase a Scheduled
-- Instance, you must call DescribeScheduledInstanceAvailability to check
-- for available schedules and obtain a purchase token. After you purchase
-- a Scheduled Instance, you must call RunScheduledInstances during each
-- scheduled time period.
--
-- After you purchase a Scheduled Instance, you can\'t cancel, modify, or
-- resell your purchase.
module Amazonka.EC2.PurchaseScheduledInstances
  ( -- * Creating a Request
    PurchaseScheduledInstances (..),
    newPurchaseScheduledInstances,

    -- * Request Lenses
    purchaseScheduledInstances_clientToken,
    purchaseScheduledInstances_dryRun,
    purchaseScheduledInstances_purchaseRequests,

    -- * Destructuring the Response
    PurchaseScheduledInstancesResponse (..),
    newPurchaseScheduledInstancesResponse,

    -- * Response Lenses
    purchaseScheduledInstancesResponse_scheduledInstanceSet,
    purchaseScheduledInstancesResponse_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 PurchaseScheduledInstances.
--
-- /See:/ 'newPurchaseScheduledInstances' smart constructor.
data PurchaseScheduledInstances = PurchaseScheduledInstances'
  { -- | 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>.
    PurchaseScheduledInstances -> 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@.
    PurchaseScheduledInstances -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The purchase requests.
    PurchaseScheduledInstances -> NonEmpty PurchaseRequest
purchaseRequests :: Prelude.NonEmpty PurchaseRequest
  }
  deriving (PurchaseScheduledInstances -> PurchaseScheduledInstances -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PurchaseScheduledInstances -> PurchaseScheduledInstances -> Bool
$c/= :: PurchaseScheduledInstances -> PurchaseScheduledInstances -> Bool
== :: PurchaseScheduledInstances -> PurchaseScheduledInstances -> Bool
$c== :: PurchaseScheduledInstances -> PurchaseScheduledInstances -> Bool
Prelude.Eq, ReadPrec [PurchaseScheduledInstances]
ReadPrec PurchaseScheduledInstances
Int -> ReadS PurchaseScheduledInstances
ReadS [PurchaseScheduledInstances]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PurchaseScheduledInstances]
$creadListPrec :: ReadPrec [PurchaseScheduledInstances]
readPrec :: ReadPrec PurchaseScheduledInstances
$creadPrec :: ReadPrec PurchaseScheduledInstances
readList :: ReadS [PurchaseScheduledInstances]
$creadList :: ReadS [PurchaseScheduledInstances]
readsPrec :: Int -> ReadS PurchaseScheduledInstances
$creadsPrec :: Int -> ReadS PurchaseScheduledInstances
Prelude.Read, Int -> PurchaseScheduledInstances -> ShowS
[PurchaseScheduledInstances] -> ShowS
PurchaseScheduledInstances -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PurchaseScheduledInstances] -> ShowS
$cshowList :: [PurchaseScheduledInstances] -> ShowS
show :: PurchaseScheduledInstances -> String
$cshow :: PurchaseScheduledInstances -> String
showsPrec :: Int -> PurchaseScheduledInstances -> ShowS
$cshowsPrec :: Int -> PurchaseScheduledInstances -> ShowS
Prelude.Show, forall x.
Rep PurchaseScheduledInstances x -> PurchaseScheduledInstances
forall x.
PurchaseScheduledInstances -> Rep PurchaseScheduledInstances x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PurchaseScheduledInstances x -> PurchaseScheduledInstances
$cfrom :: forall x.
PurchaseScheduledInstances -> Rep PurchaseScheduledInstances x
Prelude.Generic)

-- |
-- Create a value of 'PurchaseScheduledInstances' 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', 'purchaseScheduledInstances_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', 'purchaseScheduledInstances_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@.
--
-- 'purchaseRequests', 'purchaseScheduledInstances_purchaseRequests' - The purchase requests.
newPurchaseScheduledInstances ::
  -- | 'purchaseRequests'
  Prelude.NonEmpty PurchaseRequest ->
  PurchaseScheduledInstances
newPurchaseScheduledInstances :: NonEmpty PurchaseRequest -> PurchaseScheduledInstances
newPurchaseScheduledInstances NonEmpty PurchaseRequest
pPurchaseRequests_ =
  PurchaseScheduledInstances'
    { $sel:clientToken:PurchaseScheduledInstances' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:PurchaseScheduledInstances' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:purchaseRequests:PurchaseScheduledInstances' :: NonEmpty PurchaseRequest
purchaseRequests =
        forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty PurchaseRequest
pPurchaseRequests_
    }

-- | 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>.
purchaseScheduledInstances_clientToken :: Lens.Lens' PurchaseScheduledInstances (Prelude.Maybe Prelude.Text)
purchaseScheduledInstances_clientToken :: Lens' PurchaseScheduledInstances (Maybe Text)
purchaseScheduledInstances_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PurchaseScheduledInstances' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:PurchaseScheduledInstances' :: PurchaseScheduledInstances -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: PurchaseScheduledInstances
s@PurchaseScheduledInstances' {} Maybe Text
a -> PurchaseScheduledInstances
s {$sel:clientToken:PurchaseScheduledInstances' :: Maybe Text
clientToken = Maybe Text
a} :: PurchaseScheduledInstances)

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

-- | The purchase requests.
purchaseScheduledInstances_purchaseRequests :: Lens.Lens' PurchaseScheduledInstances (Prelude.NonEmpty PurchaseRequest)
purchaseScheduledInstances_purchaseRequests :: Lens' PurchaseScheduledInstances (NonEmpty PurchaseRequest)
purchaseScheduledInstances_purchaseRequests = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PurchaseScheduledInstances' {NonEmpty PurchaseRequest
purchaseRequests :: NonEmpty PurchaseRequest
$sel:purchaseRequests:PurchaseScheduledInstances' :: PurchaseScheduledInstances -> NonEmpty PurchaseRequest
purchaseRequests} -> NonEmpty PurchaseRequest
purchaseRequests) (\s :: PurchaseScheduledInstances
s@PurchaseScheduledInstances' {} NonEmpty PurchaseRequest
a -> PurchaseScheduledInstances
s {$sel:purchaseRequests:PurchaseScheduledInstances' :: NonEmpty PurchaseRequest
purchaseRequests = NonEmpty PurchaseRequest
a} :: PurchaseScheduledInstances) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest PurchaseScheduledInstances where
  type
    AWSResponse PurchaseScheduledInstances =
      PurchaseScheduledInstancesResponse
  request :: (Service -> Service)
-> PurchaseScheduledInstances -> Request PurchaseScheduledInstances
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 PurchaseScheduledInstances
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PurchaseScheduledInstances)))
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 [ScheduledInstance]
-> Int -> PurchaseScheduledInstancesResponse
PurchaseScheduledInstancesResponse'
            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
"scheduledInstanceSet"
                            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 PurchaseScheduledInstances where
  hashWithSalt :: Int -> PurchaseScheduledInstances -> Int
hashWithSalt Int
_salt PurchaseScheduledInstances' {Maybe Bool
Maybe Text
NonEmpty PurchaseRequest
purchaseRequests :: NonEmpty PurchaseRequest
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:purchaseRequests:PurchaseScheduledInstances' :: PurchaseScheduledInstances -> NonEmpty PurchaseRequest
$sel:dryRun:PurchaseScheduledInstances' :: PurchaseScheduledInstances -> Maybe Bool
$sel:clientToken:PurchaseScheduledInstances' :: PurchaseScheduledInstances -> 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` NonEmpty PurchaseRequest
purchaseRequests

instance Prelude.NFData PurchaseScheduledInstances where
  rnf :: PurchaseScheduledInstances -> ()
rnf PurchaseScheduledInstances' {Maybe Bool
Maybe Text
NonEmpty PurchaseRequest
purchaseRequests :: NonEmpty PurchaseRequest
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:purchaseRequests:PurchaseScheduledInstances' :: PurchaseScheduledInstances -> NonEmpty PurchaseRequest
$sel:dryRun:PurchaseScheduledInstances' :: PurchaseScheduledInstances -> Maybe Bool
$sel:clientToken:PurchaseScheduledInstances' :: PurchaseScheduledInstances -> 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 NonEmpty PurchaseRequest
purchaseRequests

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

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

instance Data.ToQuery PurchaseScheduledInstances where
  toQuery :: PurchaseScheduledInstances -> QueryString
toQuery PurchaseScheduledInstances' {Maybe Bool
Maybe Text
NonEmpty PurchaseRequest
purchaseRequests :: NonEmpty PurchaseRequest
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:purchaseRequests:PurchaseScheduledInstances' :: PurchaseScheduledInstances -> NonEmpty PurchaseRequest
$sel:dryRun:PurchaseScheduledInstances' :: PurchaseScheduledInstances -> Maybe Bool
$sel:clientToken:PurchaseScheduledInstances' :: PurchaseScheduledInstances -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"PurchaseScheduledInstances" :: 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,
        forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"PurchaseRequest" NonEmpty PurchaseRequest
purchaseRequests
      ]

-- | Contains the output of PurchaseScheduledInstances.
--
-- /See:/ 'newPurchaseScheduledInstancesResponse' smart constructor.
data PurchaseScheduledInstancesResponse = PurchaseScheduledInstancesResponse'
  { -- | Information about the Scheduled Instances.
    PurchaseScheduledInstancesResponse -> Maybe [ScheduledInstance]
scheduledInstanceSet :: Prelude.Maybe [ScheduledInstance],
    -- | The response's http status code.
    PurchaseScheduledInstancesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PurchaseScheduledInstancesResponse
-> PurchaseScheduledInstancesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PurchaseScheduledInstancesResponse
-> PurchaseScheduledInstancesResponse -> Bool
$c/= :: PurchaseScheduledInstancesResponse
-> PurchaseScheduledInstancesResponse -> Bool
== :: PurchaseScheduledInstancesResponse
-> PurchaseScheduledInstancesResponse -> Bool
$c== :: PurchaseScheduledInstancesResponse
-> PurchaseScheduledInstancesResponse -> Bool
Prelude.Eq, ReadPrec [PurchaseScheduledInstancesResponse]
ReadPrec PurchaseScheduledInstancesResponse
Int -> ReadS PurchaseScheduledInstancesResponse
ReadS [PurchaseScheduledInstancesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PurchaseScheduledInstancesResponse]
$creadListPrec :: ReadPrec [PurchaseScheduledInstancesResponse]
readPrec :: ReadPrec PurchaseScheduledInstancesResponse
$creadPrec :: ReadPrec PurchaseScheduledInstancesResponse
readList :: ReadS [PurchaseScheduledInstancesResponse]
$creadList :: ReadS [PurchaseScheduledInstancesResponse]
readsPrec :: Int -> ReadS PurchaseScheduledInstancesResponse
$creadsPrec :: Int -> ReadS PurchaseScheduledInstancesResponse
Prelude.Read, Int -> PurchaseScheduledInstancesResponse -> ShowS
[PurchaseScheduledInstancesResponse] -> ShowS
PurchaseScheduledInstancesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PurchaseScheduledInstancesResponse] -> ShowS
$cshowList :: [PurchaseScheduledInstancesResponse] -> ShowS
show :: PurchaseScheduledInstancesResponse -> String
$cshow :: PurchaseScheduledInstancesResponse -> String
showsPrec :: Int -> PurchaseScheduledInstancesResponse -> ShowS
$cshowsPrec :: Int -> PurchaseScheduledInstancesResponse -> ShowS
Prelude.Show, forall x.
Rep PurchaseScheduledInstancesResponse x
-> PurchaseScheduledInstancesResponse
forall x.
PurchaseScheduledInstancesResponse
-> Rep PurchaseScheduledInstancesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PurchaseScheduledInstancesResponse x
-> PurchaseScheduledInstancesResponse
$cfrom :: forall x.
PurchaseScheduledInstancesResponse
-> Rep PurchaseScheduledInstancesResponse x
Prelude.Generic)

-- |
-- Create a value of 'PurchaseScheduledInstancesResponse' 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:
--
-- 'scheduledInstanceSet', 'purchaseScheduledInstancesResponse_scheduledInstanceSet' - Information about the Scheduled Instances.
--
-- 'httpStatus', 'purchaseScheduledInstancesResponse_httpStatus' - The response's http status code.
newPurchaseScheduledInstancesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PurchaseScheduledInstancesResponse
newPurchaseScheduledInstancesResponse :: Int -> PurchaseScheduledInstancesResponse
newPurchaseScheduledInstancesResponse Int
pHttpStatus_ =
  PurchaseScheduledInstancesResponse'
    { $sel:scheduledInstanceSet:PurchaseScheduledInstancesResponse' :: Maybe [ScheduledInstance]
scheduledInstanceSet =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PurchaseScheduledInstancesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the Scheduled Instances.
purchaseScheduledInstancesResponse_scheduledInstanceSet :: Lens.Lens' PurchaseScheduledInstancesResponse (Prelude.Maybe [ScheduledInstance])
purchaseScheduledInstancesResponse_scheduledInstanceSet :: Lens'
  PurchaseScheduledInstancesResponse (Maybe [ScheduledInstance])
purchaseScheduledInstancesResponse_scheduledInstanceSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PurchaseScheduledInstancesResponse' {Maybe [ScheduledInstance]
scheduledInstanceSet :: Maybe [ScheduledInstance]
$sel:scheduledInstanceSet:PurchaseScheduledInstancesResponse' :: PurchaseScheduledInstancesResponse -> Maybe [ScheduledInstance]
scheduledInstanceSet} -> Maybe [ScheduledInstance]
scheduledInstanceSet) (\s :: PurchaseScheduledInstancesResponse
s@PurchaseScheduledInstancesResponse' {} Maybe [ScheduledInstance]
a -> PurchaseScheduledInstancesResponse
s {$sel:scheduledInstanceSet:PurchaseScheduledInstancesResponse' :: Maybe [ScheduledInstance]
scheduledInstanceSet = Maybe [ScheduledInstance]
a} :: PurchaseScheduledInstancesResponse) 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.
purchaseScheduledInstancesResponse_httpStatus :: Lens.Lens' PurchaseScheduledInstancesResponse Prelude.Int
purchaseScheduledInstancesResponse_httpStatus :: Lens' PurchaseScheduledInstancesResponse Int
purchaseScheduledInstancesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PurchaseScheduledInstancesResponse' {Int
httpStatus :: Int
$sel:httpStatus:PurchaseScheduledInstancesResponse' :: PurchaseScheduledInstancesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: PurchaseScheduledInstancesResponse
s@PurchaseScheduledInstancesResponse' {} Int
a -> PurchaseScheduledInstancesResponse
s {$sel:httpStatus:PurchaseScheduledInstancesResponse' :: Int
httpStatus = Int
a} :: PurchaseScheduledInstancesResponse)

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