{-# 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.MarketplaceMetering.MeterUsage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- API to emit metering records. For identical requests, the API is
-- idempotent. It simply returns the metering record ID.
--
-- @MeterUsage@ is authenticated on the buyer\'s AWS account using
-- credentials from the EC2 instance, ECS task, or EKS pod.
--
-- @MeterUsage@ can optionally include multiple usage allocations, to
-- provide customers with usage data split into buckets by tags that you
-- define (or allow the customer to define).
--
-- Usage records are expected to be submitted as quickly as possible after
-- the event that is being recorded, and are not accepted more than 6 hours
-- after the event.
module Amazonka.MarketplaceMetering.MeterUsage
  ( -- * Creating a Request
    MeterUsage (..),
    newMeterUsage,

    -- * Request Lenses
    meterUsage_dryRun,
    meterUsage_usageAllocations,
    meterUsage_usageQuantity,
    meterUsage_productCode,
    meterUsage_timestamp,
    meterUsage_usageDimension,

    -- * Destructuring the Response
    MeterUsageResponse (..),
    newMeterUsageResponse,

    -- * Response Lenses
    meterUsageResponse_meteringRecordId,
    meterUsageResponse_httpStatus,
  )
where

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

-- | /See:/ 'newMeterUsage' smart constructor.
data MeterUsage = MeterUsage'
  { -- | Checks whether you have the permissions required for the action, but
    -- does not make the request. If you have the permissions, the request
    -- returns @DryRunOperation@; otherwise, it returns
    -- @UnauthorizedException@. Defaults to @false@ if not specified.
    MeterUsage -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The set of @UsageAllocations@ to submit.
    --
    -- The sum of all @UsageAllocation@ quantities must equal the
    -- @UsageQuantity@ of the @MeterUsage@ request, and each @UsageAllocation@
    -- must have a unique set of tags (include no tags).
    MeterUsage -> Maybe (NonEmpty UsageAllocation)
usageAllocations :: Prelude.Maybe (Prelude.NonEmpty UsageAllocation),
    -- | Consumption value for the hour. Defaults to @0@ if not specified.
    MeterUsage -> Maybe Natural
usageQuantity :: Prelude.Maybe Prelude.Natural,
    -- | Product code is used to uniquely identify a product in AWS Marketplace.
    -- The product code should be the same as the one used during the
    -- publishing of a new product.
    MeterUsage -> Text
productCode :: Prelude.Text,
    -- | Timestamp, in UTC, for which the usage is being reported. Your
    -- application can meter usage for up to one hour in the past. Make sure
    -- the @timestamp@ value is not before the start of the software usage.
    MeterUsage -> POSIX
timestamp :: Data.POSIX,
    -- | It will be one of the fcp dimension name provided during the publishing
    -- of the product.
    MeterUsage -> Text
usageDimension :: Prelude.Text
  }
  deriving (MeterUsage -> MeterUsage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeterUsage -> MeterUsage -> Bool
$c/= :: MeterUsage -> MeterUsage -> Bool
== :: MeterUsage -> MeterUsage -> Bool
$c== :: MeterUsage -> MeterUsage -> Bool
Prelude.Eq, ReadPrec [MeterUsage]
ReadPrec MeterUsage
Int -> ReadS MeterUsage
ReadS [MeterUsage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MeterUsage]
$creadListPrec :: ReadPrec [MeterUsage]
readPrec :: ReadPrec MeterUsage
$creadPrec :: ReadPrec MeterUsage
readList :: ReadS [MeterUsage]
$creadList :: ReadS [MeterUsage]
readsPrec :: Int -> ReadS MeterUsage
$creadsPrec :: Int -> ReadS MeterUsage
Prelude.Read, Int -> MeterUsage -> ShowS
[MeterUsage] -> ShowS
MeterUsage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeterUsage] -> ShowS
$cshowList :: [MeterUsage] -> ShowS
show :: MeterUsage -> String
$cshow :: MeterUsage -> String
showsPrec :: Int -> MeterUsage -> ShowS
$cshowsPrec :: Int -> MeterUsage -> ShowS
Prelude.Show, forall x. Rep MeterUsage x -> MeterUsage
forall x. MeterUsage -> Rep MeterUsage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MeterUsage x -> MeterUsage
$cfrom :: forall x. MeterUsage -> Rep MeterUsage x
Prelude.Generic)

-- |
-- Create a value of 'MeterUsage' 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', 'meterUsage_dryRun' - Checks whether you have the permissions required for the action, but
-- does not make the request. If you have the permissions, the request
-- returns @DryRunOperation@; otherwise, it returns
-- @UnauthorizedException@. Defaults to @false@ if not specified.
--
-- 'usageAllocations', 'meterUsage_usageAllocations' - The set of @UsageAllocations@ to submit.
--
-- The sum of all @UsageAllocation@ quantities must equal the
-- @UsageQuantity@ of the @MeterUsage@ request, and each @UsageAllocation@
-- must have a unique set of tags (include no tags).
--
-- 'usageQuantity', 'meterUsage_usageQuantity' - Consumption value for the hour. Defaults to @0@ if not specified.
--
-- 'productCode', 'meterUsage_productCode' - Product code is used to uniquely identify a product in AWS Marketplace.
-- The product code should be the same as the one used during the
-- publishing of a new product.
--
-- 'timestamp', 'meterUsage_timestamp' - Timestamp, in UTC, for which the usage is being reported. Your
-- application can meter usage for up to one hour in the past. Make sure
-- the @timestamp@ value is not before the start of the software usage.
--
-- 'usageDimension', 'meterUsage_usageDimension' - It will be one of the fcp dimension name provided during the publishing
-- of the product.
newMeterUsage ::
  -- | 'productCode'
  Prelude.Text ->
  -- | 'timestamp'
  Prelude.UTCTime ->
  -- | 'usageDimension'
  Prelude.Text ->
  MeterUsage
newMeterUsage :: Text -> UTCTime -> Text -> MeterUsage
newMeterUsage
  Text
pProductCode_
  UTCTime
pTimestamp_
  Text
pUsageDimension_ =
    MeterUsage'
      { $sel:dryRun:MeterUsage' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:usageAllocations:MeterUsage' :: Maybe (NonEmpty UsageAllocation)
usageAllocations = forall a. Maybe a
Prelude.Nothing,
        $sel:usageQuantity:MeterUsage' :: Maybe Natural
usageQuantity = forall a. Maybe a
Prelude.Nothing,
        $sel:productCode:MeterUsage' :: Text
productCode = Text
pProductCode_,
        $sel:timestamp:MeterUsage' :: POSIX
timestamp = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pTimestamp_,
        $sel:usageDimension:MeterUsage' :: Text
usageDimension = Text
pUsageDimension_
      }

-- | Checks whether you have the permissions required for the action, but
-- does not make the request. If you have the permissions, the request
-- returns @DryRunOperation@; otherwise, it returns
-- @UnauthorizedException@. Defaults to @false@ if not specified.
meterUsage_dryRun :: Lens.Lens' MeterUsage (Prelude.Maybe Prelude.Bool)
meterUsage_dryRun :: Lens' MeterUsage (Maybe Bool)
meterUsage_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MeterUsage' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:MeterUsage' :: MeterUsage -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: MeterUsage
s@MeterUsage' {} Maybe Bool
a -> MeterUsage
s {$sel:dryRun:MeterUsage' :: Maybe Bool
dryRun = Maybe Bool
a} :: MeterUsage)

-- | The set of @UsageAllocations@ to submit.
--
-- The sum of all @UsageAllocation@ quantities must equal the
-- @UsageQuantity@ of the @MeterUsage@ request, and each @UsageAllocation@
-- must have a unique set of tags (include no tags).
meterUsage_usageAllocations :: Lens.Lens' MeterUsage (Prelude.Maybe (Prelude.NonEmpty UsageAllocation))
meterUsage_usageAllocations :: Lens' MeterUsage (Maybe (NonEmpty UsageAllocation))
meterUsage_usageAllocations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MeterUsage' {Maybe (NonEmpty UsageAllocation)
usageAllocations :: Maybe (NonEmpty UsageAllocation)
$sel:usageAllocations:MeterUsage' :: MeterUsage -> Maybe (NonEmpty UsageAllocation)
usageAllocations} -> Maybe (NonEmpty UsageAllocation)
usageAllocations) (\s :: MeterUsage
s@MeterUsage' {} Maybe (NonEmpty UsageAllocation)
a -> MeterUsage
s {$sel:usageAllocations:MeterUsage' :: Maybe (NonEmpty UsageAllocation)
usageAllocations = Maybe (NonEmpty UsageAllocation)
a} :: MeterUsage) 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

-- | Consumption value for the hour. Defaults to @0@ if not specified.
meterUsage_usageQuantity :: Lens.Lens' MeterUsage (Prelude.Maybe Prelude.Natural)
meterUsage_usageQuantity :: Lens' MeterUsage (Maybe Natural)
meterUsage_usageQuantity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MeterUsage' {Maybe Natural
usageQuantity :: Maybe Natural
$sel:usageQuantity:MeterUsage' :: MeterUsage -> Maybe Natural
usageQuantity} -> Maybe Natural
usageQuantity) (\s :: MeterUsage
s@MeterUsage' {} Maybe Natural
a -> MeterUsage
s {$sel:usageQuantity:MeterUsage' :: Maybe Natural
usageQuantity = Maybe Natural
a} :: MeterUsage)

-- | Product code is used to uniquely identify a product in AWS Marketplace.
-- The product code should be the same as the one used during the
-- publishing of a new product.
meterUsage_productCode :: Lens.Lens' MeterUsage Prelude.Text
meterUsage_productCode :: Lens' MeterUsage Text
meterUsage_productCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MeterUsage' {Text
productCode :: Text
$sel:productCode:MeterUsage' :: MeterUsage -> Text
productCode} -> Text
productCode) (\s :: MeterUsage
s@MeterUsage' {} Text
a -> MeterUsage
s {$sel:productCode:MeterUsage' :: Text
productCode = Text
a} :: MeterUsage)

-- | Timestamp, in UTC, for which the usage is being reported. Your
-- application can meter usage for up to one hour in the past. Make sure
-- the @timestamp@ value is not before the start of the software usage.
meterUsage_timestamp :: Lens.Lens' MeterUsage Prelude.UTCTime
meterUsage_timestamp :: Lens' MeterUsage UTCTime
meterUsage_timestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MeterUsage' {POSIX
timestamp :: POSIX
$sel:timestamp:MeterUsage' :: MeterUsage -> POSIX
timestamp} -> POSIX
timestamp) (\s :: MeterUsage
s@MeterUsage' {} POSIX
a -> MeterUsage
s {$sel:timestamp:MeterUsage' :: POSIX
timestamp = POSIX
a} :: MeterUsage) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | It will be one of the fcp dimension name provided during the publishing
-- of the product.
meterUsage_usageDimension :: Lens.Lens' MeterUsage Prelude.Text
meterUsage_usageDimension :: Lens' MeterUsage Text
meterUsage_usageDimension = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MeterUsage' {Text
usageDimension :: Text
$sel:usageDimension:MeterUsage' :: MeterUsage -> Text
usageDimension} -> Text
usageDimension) (\s :: MeterUsage
s@MeterUsage' {} Text
a -> MeterUsage
s {$sel:usageDimension:MeterUsage' :: Text
usageDimension = Text
a} :: MeterUsage)

instance Core.AWSRequest MeterUsage where
  type AWSResponse MeterUsage = MeterUsageResponse
  request :: (Service -> Service) -> MeterUsage -> Request MeterUsage
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 MeterUsage
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse MeterUsage)))
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 Text -> Int -> MeterUsageResponse
MeterUsageResponse'
            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
"MeteringRecordId")
            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 MeterUsage where
  hashWithSalt :: Int -> MeterUsage -> Int
hashWithSalt Int
_salt MeterUsage' {Maybe Bool
Maybe Natural
Maybe (NonEmpty UsageAllocation)
Text
POSIX
usageDimension :: Text
timestamp :: POSIX
productCode :: Text
usageQuantity :: Maybe Natural
usageAllocations :: Maybe (NonEmpty UsageAllocation)
dryRun :: Maybe Bool
$sel:usageDimension:MeterUsage' :: MeterUsage -> Text
$sel:timestamp:MeterUsage' :: MeterUsage -> POSIX
$sel:productCode:MeterUsage' :: MeterUsage -> Text
$sel:usageQuantity:MeterUsage' :: MeterUsage -> Maybe Natural
$sel:usageAllocations:MeterUsage' :: MeterUsage -> Maybe (NonEmpty UsageAllocation)
$sel:dryRun:MeterUsage' :: MeterUsage -> 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 (NonEmpty UsageAllocation)
usageAllocations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
usageQuantity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
productCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
timestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
usageDimension

instance Prelude.NFData MeterUsage where
  rnf :: MeterUsage -> ()
rnf MeterUsage' {Maybe Bool
Maybe Natural
Maybe (NonEmpty UsageAllocation)
Text
POSIX
usageDimension :: Text
timestamp :: POSIX
productCode :: Text
usageQuantity :: Maybe Natural
usageAllocations :: Maybe (NonEmpty UsageAllocation)
dryRun :: Maybe Bool
$sel:usageDimension:MeterUsage' :: MeterUsage -> Text
$sel:timestamp:MeterUsage' :: MeterUsage -> POSIX
$sel:productCode:MeterUsage' :: MeterUsage -> Text
$sel:usageQuantity:MeterUsage' :: MeterUsage -> Maybe Natural
$sel:usageAllocations:MeterUsage' :: MeterUsage -> Maybe (NonEmpty UsageAllocation)
$sel:dryRun:MeterUsage' :: MeterUsage -> 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 (NonEmpty UsageAllocation)
usageAllocations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
usageQuantity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
productCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
timestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
usageDimension

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

instance Data.ToJSON MeterUsage where
  toJSON :: MeterUsage -> Value
toJSON MeterUsage' {Maybe Bool
Maybe Natural
Maybe (NonEmpty UsageAllocation)
Text
POSIX
usageDimension :: Text
timestamp :: POSIX
productCode :: Text
usageQuantity :: Maybe Natural
usageAllocations :: Maybe (NonEmpty UsageAllocation)
dryRun :: Maybe Bool
$sel:usageDimension:MeterUsage' :: MeterUsage -> Text
$sel:timestamp:MeterUsage' :: MeterUsage -> POSIX
$sel:productCode:MeterUsage' :: MeterUsage -> Text
$sel:usageQuantity:MeterUsage' :: MeterUsage -> Maybe Natural
$sel:usageAllocations:MeterUsage' :: MeterUsage -> Maybe (NonEmpty UsageAllocation)
$sel:dryRun:MeterUsage' :: MeterUsage -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DryRun" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
dryRun,
            (Key
"UsageAllocations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty UsageAllocation)
usageAllocations,
            (Key
"UsageQuantity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
usageQuantity,
            forall a. a -> Maybe a
Prelude.Just (Key
"ProductCode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
productCode),
            forall a. a -> Maybe a
Prelude.Just (Key
"Timestamp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
timestamp),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"UsageDimension" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
usageDimension)
          ]
      )

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

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

-- | /See:/ 'newMeterUsageResponse' smart constructor.
data MeterUsageResponse = MeterUsageResponse'
  { -- | Metering record id.
    MeterUsageResponse -> Maybe Text
meteringRecordId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    MeterUsageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (MeterUsageResponse -> MeterUsageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeterUsageResponse -> MeterUsageResponse -> Bool
$c/= :: MeterUsageResponse -> MeterUsageResponse -> Bool
== :: MeterUsageResponse -> MeterUsageResponse -> Bool
$c== :: MeterUsageResponse -> MeterUsageResponse -> Bool
Prelude.Eq, ReadPrec [MeterUsageResponse]
ReadPrec MeterUsageResponse
Int -> ReadS MeterUsageResponse
ReadS [MeterUsageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MeterUsageResponse]
$creadListPrec :: ReadPrec [MeterUsageResponse]
readPrec :: ReadPrec MeterUsageResponse
$creadPrec :: ReadPrec MeterUsageResponse
readList :: ReadS [MeterUsageResponse]
$creadList :: ReadS [MeterUsageResponse]
readsPrec :: Int -> ReadS MeterUsageResponse
$creadsPrec :: Int -> ReadS MeterUsageResponse
Prelude.Read, Int -> MeterUsageResponse -> ShowS
[MeterUsageResponse] -> ShowS
MeterUsageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeterUsageResponse] -> ShowS
$cshowList :: [MeterUsageResponse] -> ShowS
show :: MeterUsageResponse -> String
$cshow :: MeterUsageResponse -> String
showsPrec :: Int -> MeterUsageResponse -> ShowS
$cshowsPrec :: Int -> MeterUsageResponse -> ShowS
Prelude.Show, forall x. Rep MeterUsageResponse x -> MeterUsageResponse
forall x. MeterUsageResponse -> Rep MeterUsageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MeterUsageResponse x -> MeterUsageResponse
$cfrom :: forall x. MeterUsageResponse -> Rep MeterUsageResponse x
Prelude.Generic)

-- |
-- Create a value of 'MeterUsageResponse' 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:
--
-- 'meteringRecordId', 'meterUsageResponse_meteringRecordId' - Metering record id.
--
-- 'httpStatus', 'meterUsageResponse_httpStatus' - The response's http status code.
newMeterUsageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  MeterUsageResponse
newMeterUsageResponse :: Int -> MeterUsageResponse
newMeterUsageResponse Int
pHttpStatus_ =
  MeterUsageResponse'
    { $sel:meteringRecordId:MeterUsageResponse' :: Maybe Text
meteringRecordId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:MeterUsageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Metering record id.
meterUsageResponse_meteringRecordId :: Lens.Lens' MeterUsageResponse (Prelude.Maybe Prelude.Text)
meterUsageResponse_meteringRecordId :: Lens' MeterUsageResponse (Maybe Text)
meterUsageResponse_meteringRecordId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MeterUsageResponse' {Maybe Text
meteringRecordId :: Maybe Text
$sel:meteringRecordId:MeterUsageResponse' :: MeterUsageResponse -> Maybe Text
meteringRecordId} -> Maybe Text
meteringRecordId) (\s :: MeterUsageResponse
s@MeterUsageResponse' {} Maybe Text
a -> MeterUsageResponse
s {$sel:meteringRecordId:MeterUsageResponse' :: Maybe Text
meteringRecordId = Maybe Text
a} :: MeterUsageResponse)

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

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