{-# 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.GroundStation.GetMinuteUsage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the number of minutes used by account.
module Amazonka.GroundStation.GetMinuteUsage
  ( -- * Creating a Request
    GetMinuteUsage (..),
    newGetMinuteUsage,

    -- * Request Lenses
    getMinuteUsage_month,
    getMinuteUsage_year,

    -- * Destructuring the Response
    GetMinuteUsageResponse (..),
    newGetMinuteUsageResponse,

    -- * Response Lenses
    getMinuteUsageResponse_estimatedMinutesRemaining,
    getMinuteUsageResponse_isReservedMinutesCustomer,
    getMinuteUsageResponse_totalReservedMinuteAllocation,
    getMinuteUsageResponse_totalScheduledMinutes,
    getMinuteUsageResponse_upcomingMinutesScheduled,
    getMinuteUsageResponse_httpStatus,
  )
where

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

-- |
--
-- /See:/ 'newGetMinuteUsage' smart constructor.
data GetMinuteUsage = GetMinuteUsage'
  { -- | The month being requested, with a value of 1-12.
    GetMinuteUsage -> Natural
month :: Prelude.Natural,
    -- | The year being requested, in the format of YYYY.
    GetMinuteUsage -> Natural
year :: Prelude.Natural
  }
  deriving (GetMinuteUsage -> GetMinuteUsage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMinuteUsage -> GetMinuteUsage -> Bool
$c/= :: GetMinuteUsage -> GetMinuteUsage -> Bool
== :: GetMinuteUsage -> GetMinuteUsage -> Bool
$c== :: GetMinuteUsage -> GetMinuteUsage -> Bool
Prelude.Eq, ReadPrec [GetMinuteUsage]
ReadPrec GetMinuteUsage
Int -> ReadS GetMinuteUsage
ReadS [GetMinuteUsage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMinuteUsage]
$creadListPrec :: ReadPrec [GetMinuteUsage]
readPrec :: ReadPrec GetMinuteUsage
$creadPrec :: ReadPrec GetMinuteUsage
readList :: ReadS [GetMinuteUsage]
$creadList :: ReadS [GetMinuteUsage]
readsPrec :: Int -> ReadS GetMinuteUsage
$creadsPrec :: Int -> ReadS GetMinuteUsage
Prelude.Read, Int -> GetMinuteUsage -> ShowS
[GetMinuteUsage] -> ShowS
GetMinuteUsage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMinuteUsage] -> ShowS
$cshowList :: [GetMinuteUsage] -> ShowS
show :: GetMinuteUsage -> String
$cshow :: GetMinuteUsage -> String
showsPrec :: Int -> GetMinuteUsage -> ShowS
$cshowsPrec :: Int -> GetMinuteUsage -> ShowS
Prelude.Show, forall x. Rep GetMinuteUsage x -> GetMinuteUsage
forall x. GetMinuteUsage -> Rep GetMinuteUsage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMinuteUsage x -> GetMinuteUsage
$cfrom :: forall x. GetMinuteUsage -> Rep GetMinuteUsage x
Prelude.Generic)

-- |
-- Create a value of 'GetMinuteUsage' 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:
--
-- 'month', 'getMinuteUsage_month' - The month being requested, with a value of 1-12.
--
-- 'year', 'getMinuteUsage_year' - The year being requested, in the format of YYYY.
newGetMinuteUsage ::
  -- | 'month'
  Prelude.Natural ->
  -- | 'year'
  Prelude.Natural ->
  GetMinuteUsage
newGetMinuteUsage :: Natural -> Natural -> GetMinuteUsage
newGetMinuteUsage Natural
pMonth_ Natural
pYear_ =
  GetMinuteUsage' {$sel:month:GetMinuteUsage' :: Natural
month = Natural
pMonth_, $sel:year:GetMinuteUsage' :: Natural
year = Natural
pYear_}

-- | The month being requested, with a value of 1-12.
getMinuteUsage_month :: Lens.Lens' GetMinuteUsage Prelude.Natural
getMinuteUsage_month :: Lens' GetMinuteUsage Natural
getMinuteUsage_month = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMinuteUsage' {Natural
month :: Natural
$sel:month:GetMinuteUsage' :: GetMinuteUsage -> Natural
month} -> Natural
month) (\s :: GetMinuteUsage
s@GetMinuteUsage' {} Natural
a -> GetMinuteUsage
s {$sel:month:GetMinuteUsage' :: Natural
month = Natural
a} :: GetMinuteUsage)

-- | The year being requested, in the format of YYYY.
getMinuteUsage_year :: Lens.Lens' GetMinuteUsage Prelude.Natural
getMinuteUsage_year :: Lens' GetMinuteUsage Natural
getMinuteUsage_year = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMinuteUsage' {Natural
year :: Natural
$sel:year:GetMinuteUsage' :: GetMinuteUsage -> Natural
year} -> Natural
year) (\s :: GetMinuteUsage
s@GetMinuteUsage' {} Natural
a -> GetMinuteUsage
s {$sel:year:GetMinuteUsage' :: Natural
year = Natural
a} :: GetMinuteUsage)

instance Core.AWSRequest GetMinuteUsage where
  type
    AWSResponse GetMinuteUsage =
      GetMinuteUsageResponse
  request :: (Service -> Service) -> GetMinuteUsage -> Request GetMinuteUsage
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetMinuteUsage
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetMinuteUsage)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Int
-> Maybe Bool
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Int
-> GetMinuteUsageResponse
GetMinuteUsageResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"estimatedMinutesRemaining")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"isReservedMinutesCustomer")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"totalReservedMinuteAllocation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"totalScheduledMinutes")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"upcomingMinutesScheduled")
            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 GetMinuteUsage where
  hashWithSalt :: Int -> GetMinuteUsage -> Int
hashWithSalt Int
_salt GetMinuteUsage' {Natural
year :: Natural
month :: Natural
$sel:year:GetMinuteUsage' :: GetMinuteUsage -> Natural
$sel:month:GetMinuteUsage' :: GetMinuteUsage -> Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
month
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
year

instance Prelude.NFData GetMinuteUsage where
  rnf :: GetMinuteUsage -> ()
rnf GetMinuteUsage' {Natural
year :: Natural
month :: Natural
$sel:year:GetMinuteUsage' :: GetMinuteUsage -> Natural
$sel:month:GetMinuteUsage' :: GetMinuteUsage -> Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Natural
month seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
year

instance Data.ToHeaders GetMinuteUsage where
  toHeaders :: GetMinuteUsage -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON GetMinuteUsage where
  toJSON :: GetMinuteUsage -> Value
toJSON GetMinuteUsage' {Natural
year :: Natural
month :: Natural
$sel:year:GetMinuteUsage' :: GetMinuteUsage -> Natural
$sel:month:GetMinuteUsage' :: GetMinuteUsage -> Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"month" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
month),
            forall a. a -> Maybe a
Prelude.Just (Key
"year" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
year)
          ]
      )

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

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

-- |
--
-- /See:/ 'newGetMinuteUsageResponse' smart constructor.
data GetMinuteUsageResponse = GetMinuteUsageResponse'
  { -- | Estimated number of minutes remaining for an account, specific to the
    -- month being requested.
    GetMinuteUsageResponse -> Maybe Int
estimatedMinutesRemaining :: Prelude.Maybe Prelude.Int,
    -- | Returns whether or not an account has signed up for the reserved minutes
    -- pricing plan, specific to the month being requested.
    GetMinuteUsageResponse -> Maybe Bool
isReservedMinutesCustomer :: Prelude.Maybe Prelude.Bool,
    -- | Total number of reserved minutes allocated, specific to the month being
    -- requested.
    GetMinuteUsageResponse -> Maybe Int
totalReservedMinuteAllocation :: Prelude.Maybe Prelude.Int,
    -- | Total scheduled minutes for an account, specific to the month being
    -- requested.
    GetMinuteUsageResponse -> Maybe Int
totalScheduledMinutes :: Prelude.Maybe Prelude.Int,
    -- | Upcoming minutes scheduled for an account, specific to the month being
    -- requested.
    GetMinuteUsageResponse -> Maybe Int
upcomingMinutesScheduled :: Prelude.Maybe Prelude.Int,
    -- | The response's http status code.
    GetMinuteUsageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetMinuteUsageResponse -> GetMinuteUsageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMinuteUsageResponse -> GetMinuteUsageResponse -> Bool
$c/= :: GetMinuteUsageResponse -> GetMinuteUsageResponse -> Bool
== :: GetMinuteUsageResponse -> GetMinuteUsageResponse -> Bool
$c== :: GetMinuteUsageResponse -> GetMinuteUsageResponse -> Bool
Prelude.Eq, ReadPrec [GetMinuteUsageResponse]
ReadPrec GetMinuteUsageResponse
Int -> ReadS GetMinuteUsageResponse
ReadS [GetMinuteUsageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMinuteUsageResponse]
$creadListPrec :: ReadPrec [GetMinuteUsageResponse]
readPrec :: ReadPrec GetMinuteUsageResponse
$creadPrec :: ReadPrec GetMinuteUsageResponse
readList :: ReadS [GetMinuteUsageResponse]
$creadList :: ReadS [GetMinuteUsageResponse]
readsPrec :: Int -> ReadS GetMinuteUsageResponse
$creadsPrec :: Int -> ReadS GetMinuteUsageResponse
Prelude.Read, Int -> GetMinuteUsageResponse -> ShowS
[GetMinuteUsageResponse] -> ShowS
GetMinuteUsageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMinuteUsageResponse] -> ShowS
$cshowList :: [GetMinuteUsageResponse] -> ShowS
show :: GetMinuteUsageResponse -> String
$cshow :: GetMinuteUsageResponse -> String
showsPrec :: Int -> GetMinuteUsageResponse -> ShowS
$cshowsPrec :: Int -> GetMinuteUsageResponse -> ShowS
Prelude.Show, forall x. Rep GetMinuteUsageResponse x -> GetMinuteUsageResponse
forall x. GetMinuteUsageResponse -> Rep GetMinuteUsageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMinuteUsageResponse x -> GetMinuteUsageResponse
$cfrom :: forall x. GetMinuteUsageResponse -> Rep GetMinuteUsageResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetMinuteUsageResponse' 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:
--
-- 'estimatedMinutesRemaining', 'getMinuteUsageResponse_estimatedMinutesRemaining' - Estimated number of minutes remaining for an account, specific to the
-- month being requested.
--
-- 'isReservedMinutesCustomer', 'getMinuteUsageResponse_isReservedMinutesCustomer' - Returns whether or not an account has signed up for the reserved minutes
-- pricing plan, specific to the month being requested.
--
-- 'totalReservedMinuteAllocation', 'getMinuteUsageResponse_totalReservedMinuteAllocation' - Total number of reserved minutes allocated, specific to the month being
-- requested.
--
-- 'totalScheduledMinutes', 'getMinuteUsageResponse_totalScheduledMinutes' - Total scheduled minutes for an account, specific to the month being
-- requested.
--
-- 'upcomingMinutesScheduled', 'getMinuteUsageResponse_upcomingMinutesScheduled' - Upcoming minutes scheduled for an account, specific to the month being
-- requested.
--
-- 'httpStatus', 'getMinuteUsageResponse_httpStatus' - The response's http status code.
newGetMinuteUsageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetMinuteUsageResponse
newGetMinuteUsageResponse :: Int -> GetMinuteUsageResponse
newGetMinuteUsageResponse Int
pHttpStatus_ =
  GetMinuteUsageResponse'
    { $sel:estimatedMinutesRemaining:GetMinuteUsageResponse' :: Maybe Int
estimatedMinutesRemaining =
        forall a. Maybe a
Prelude.Nothing,
      $sel:isReservedMinutesCustomer:GetMinuteUsageResponse' :: Maybe Bool
isReservedMinutesCustomer = forall a. Maybe a
Prelude.Nothing,
      $sel:totalReservedMinuteAllocation:GetMinuteUsageResponse' :: Maybe Int
totalReservedMinuteAllocation = forall a. Maybe a
Prelude.Nothing,
      $sel:totalScheduledMinutes:GetMinuteUsageResponse' :: Maybe Int
totalScheduledMinutes = forall a. Maybe a
Prelude.Nothing,
      $sel:upcomingMinutesScheduled:GetMinuteUsageResponse' :: Maybe Int
upcomingMinutesScheduled = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetMinuteUsageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Estimated number of minutes remaining for an account, specific to the
-- month being requested.
getMinuteUsageResponse_estimatedMinutesRemaining :: Lens.Lens' GetMinuteUsageResponse (Prelude.Maybe Prelude.Int)
getMinuteUsageResponse_estimatedMinutesRemaining :: Lens' GetMinuteUsageResponse (Maybe Int)
getMinuteUsageResponse_estimatedMinutesRemaining = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMinuteUsageResponse' {Maybe Int
estimatedMinutesRemaining :: Maybe Int
$sel:estimatedMinutesRemaining:GetMinuteUsageResponse' :: GetMinuteUsageResponse -> Maybe Int
estimatedMinutesRemaining} -> Maybe Int
estimatedMinutesRemaining) (\s :: GetMinuteUsageResponse
s@GetMinuteUsageResponse' {} Maybe Int
a -> GetMinuteUsageResponse
s {$sel:estimatedMinutesRemaining:GetMinuteUsageResponse' :: Maybe Int
estimatedMinutesRemaining = Maybe Int
a} :: GetMinuteUsageResponse)

-- | Returns whether or not an account has signed up for the reserved minutes
-- pricing plan, specific to the month being requested.
getMinuteUsageResponse_isReservedMinutesCustomer :: Lens.Lens' GetMinuteUsageResponse (Prelude.Maybe Prelude.Bool)
getMinuteUsageResponse_isReservedMinutesCustomer :: Lens' GetMinuteUsageResponse (Maybe Bool)
getMinuteUsageResponse_isReservedMinutesCustomer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMinuteUsageResponse' {Maybe Bool
isReservedMinutesCustomer :: Maybe Bool
$sel:isReservedMinutesCustomer:GetMinuteUsageResponse' :: GetMinuteUsageResponse -> Maybe Bool
isReservedMinutesCustomer} -> Maybe Bool
isReservedMinutesCustomer) (\s :: GetMinuteUsageResponse
s@GetMinuteUsageResponse' {} Maybe Bool
a -> GetMinuteUsageResponse
s {$sel:isReservedMinutesCustomer:GetMinuteUsageResponse' :: Maybe Bool
isReservedMinutesCustomer = Maybe Bool
a} :: GetMinuteUsageResponse)

-- | Total number of reserved minutes allocated, specific to the month being
-- requested.
getMinuteUsageResponse_totalReservedMinuteAllocation :: Lens.Lens' GetMinuteUsageResponse (Prelude.Maybe Prelude.Int)
getMinuteUsageResponse_totalReservedMinuteAllocation :: Lens' GetMinuteUsageResponse (Maybe Int)
getMinuteUsageResponse_totalReservedMinuteAllocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMinuteUsageResponse' {Maybe Int
totalReservedMinuteAllocation :: Maybe Int
$sel:totalReservedMinuteAllocation:GetMinuteUsageResponse' :: GetMinuteUsageResponse -> Maybe Int
totalReservedMinuteAllocation} -> Maybe Int
totalReservedMinuteAllocation) (\s :: GetMinuteUsageResponse
s@GetMinuteUsageResponse' {} Maybe Int
a -> GetMinuteUsageResponse
s {$sel:totalReservedMinuteAllocation:GetMinuteUsageResponse' :: Maybe Int
totalReservedMinuteAllocation = Maybe Int
a} :: GetMinuteUsageResponse)

-- | Total scheduled minutes for an account, specific to the month being
-- requested.
getMinuteUsageResponse_totalScheduledMinutes :: Lens.Lens' GetMinuteUsageResponse (Prelude.Maybe Prelude.Int)
getMinuteUsageResponse_totalScheduledMinutes :: Lens' GetMinuteUsageResponse (Maybe Int)
getMinuteUsageResponse_totalScheduledMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMinuteUsageResponse' {Maybe Int
totalScheduledMinutes :: Maybe Int
$sel:totalScheduledMinutes:GetMinuteUsageResponse' :: GetMinuteUsageResponse -> Maybe Int
totalScheduledMinutes} -> Maybe Int
totalScheduledMinutes) (\s :: GetMinuteUsageResponse
s@GetMinuteUsageResponse' {} Maybe Int
a -> GetMinuteUsageResponse
s {$sel:totalScheduledMinutes:GetMinuteUsageResponse' :: Maybe Int
totalScheduledMinutes = Maybe Int
a} :: GetMinuteUsageResponse)

-- | Upcoming minutes scheduled for an account, specific to the month being
-- requested.
getMinuteUsageResponse_upcomingMinutesScheduled :: Lens.Lens' GetMinuteUsageResponse (Prelude.Maybe Prelude.Int)
getMinuteUsageResponse_upcomingMinutesScheduled :: Lens' GetMinuteUsageResponse (Maybe Int)
getMinuteUsageResponse_upcomingMinutesScheduled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMinuteUsageResponse' {Maybe Int
upcomingMinutesScheduled :: Maybe Int
$sel:upcomingMinutesScheduled:GetMinuteUsageResponse' :: GetMinuteUsageResponse -> Maybe Int
upcomingMinutesScheduled} -> Maybe Int
upcomingMinutesScheduled) (\s :: GetMinuteUsageResponse
s@GetMinuteUsageResponse' {} Maybe Int
a -> GetMinuteUsageResponse
s {$sel:upcomingMinutesScheduled:GetMinuteUsageResponse' :: Maybe Int
upcomingMinutesScheduled = Maybe Int
a} :: GetMinuteUsageResponse)

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

instance Prelude.NFData GetMinuteUsageResponse where
  rnf :: GetMinuteUsageResponse -> ()
rnf GetMinuteUsageResponse' {Int
Maybe Bool
Maybe Int
httpStatus :: Int
upcomingMinutesScheduled :: Maybe Int
totalScheduledMinutes :: Maybe Int
totalReservedMinuteAllocation :: Maybe Int
isReservedMinutesCustomer :: Maybe Bool
estimatedMinutesRemaining :: Maybe Int
$sel:httpStatus:GetMinuteUsageResponse' :: GetMinuteUsageResponse -> Int
$sel:upcomingMinutesScheduled:GetMinuteUsageResponse' :: GetMinuteUsageResponse -> Maybe Int
$sel:totalScheduledMinutes:GetMinuteUsageResponse' :: GetMinuteUsageResponse -> Maybe Int
$sel:totalReservedMinuteAllocation:GetMinuteUsageResponse' :: GetMinuteUsageResponse -> Maybe Int
$sel:isReservedMinutesCustomer:GetMinuteUsageResponse' :: GetMinuteUsageResponse -> Maybe Bool
$sel:estimatedMinutesRemaining:GetMinuteUsageResponse' :: GetMinuteUsageResponse -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
estimatedMinutesRemaining
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isReservedMinutesCustomer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
totalReservedMinuteAllocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
totalScheduledMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
upcomingMinutesScheduled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus