{-# 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.MarketplaceEntitlement.GetEntitlements
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- GetEntitlements retrieves entitlement values for a given product. The
-- results can be filtered based on customer identifier or product
-- dimensions.
--
-- This operation returns paginated results.
module Amazonka.MarketplaceEntitlement.GetEntitlements
  ( -- * Creating a Request
    GetEntitlements (..),
    newGetEntitlements,

    -- * Request Lenses
    getEntitlements_filter,
    getEntitlements_maxResults,
    getEntitlements_nextToken,
    getEntitlements_productCode,

    -- * Destructuring the Response
    GetEntitlementsResponse (..),
    newGetEntitlementsResponse,

    -- * Response Lenses
    getEntitlementsResponse_entitlements,
    getEntitlementsResponse_nextToken,
    getEntitlementsResponse_httpStatus,
  )
where

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

-- | The GetEntitlementsRequest contains parameters for the GetEntitlements
-- operation.
--
-- /See:/ 'newGetEntitlements' smart constructor.
data GetEntitlements = GetEntitlements'
  { -- | Filter is used to return entitlements for a specific customer or for a
    -- specific dimension. Filters are described as keys mapped to a lists of
    -- values. Filtered requests are /unioned/ for each value in the value
    -- list, and then /intersected/ for each filter key.
    GetEntitlements
-> Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
filter' :: Prelude.Maybe (Prelude.HashMap GetEntitlementFilterName (Prelude.NonEmpty Prelude.Text)),
    -- | The maximum number of items to retrieve from the GetEntitlements
    -- operation. For pagination, use the NextToken field in subsequent calls
    -- to GetEntitlements.
    GetEntitlements -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | For paginated calls to GetEntitlements, pass the NextToken from the
    -- previous GetEntitlementsResult.
    GetEntitlements -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Product code is used to uniquely identify a product in AWS Marketplace.
    -- The product code will be provided by AWS Marketplace when the product
    -- listing is created.
    GetEntitlements -> Text
productCode :: Prelude.Text
  }
  deriving (GetEntitlements -> GetEntitlements -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetEntitlements -> GetEntitlements -> Bool
$c/= :: GetEntitlements -> GetEntitlements -> Bool
== :: GetEntitlements -> GetEntitlements -> Bool
$c== :: GetEntitlements -> GetEntitlements -> Bool
Prelude.Eq, ReadPrec [GetEntitlements]
ReadPrec GetEntitlements
Int -> ReadS GetEntitlements
ReadS [GetEntitlements]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetEntitlements]
$creadListPrec :: ReadPrec [GetEntitlements]
readPrec :: ReadPrec GetEntitlements
$creadPrec :: ReadPrec GetEntitlements
readList :: ReadS [GetEntitlements]
$creadList :: ReadS [GetEntitlements]
readsPrec :: Int -> ReadS GetEntitlements
$creadsPrec :: Int -> ReadS GetEntitlements
Prelude.Read, Int -> GetEntitlements -> ShowS
[GetEntitlements] -> ShowS
GetEntitlements -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetEntitlements] -> ShowS
$cshowList :: [GetEntitlements] -> ShowS
show :: GetEntitlements -> String
$cshow :: GetEntitlements -> String
showsPrec :: Int -> GetEntitlements -> ShowS
$cshowsPrec :: Int -> GetEntitlements -> ShowS
Prelude.Show, forall x. Rep GetEntitlements x -> GetEntitlements
forall x. GetEntitlements -> Rep GetEntitlements x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetEntitlements x -> GetEntitlements
$cfrom :: forall x. GetEntitlements -> Rep GetEntitlements x
Prelude.Generic)

-- |
-- Create a value of 'GetEntitlements' 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:
--
-- 'filter'', 'getEntitlements_filter' - Filter is used to return entitlements for a specific customer or for a
-- specific dimension. Filters are described as keys mapped to a lists of
-- values. Filtered requests are /unioned/ for each value in the value
-- list, and then /intersected/ for each filter key.
--
-- 'maxResults', 'getEntitlements_maxResults' - The maximum number of items to retrieve from the GetEntitlements
-- operation. For pagination, use the NextToken field in subsequent calls
-- to GetEntitlements.
--
-- 'nextToken', 'getEntitlements_nextToken' - For paginated calls to GetEntitlements, pass the NextToken from the
-- previous GetEntitlementsResult.
--
-- 'productCode', 'getEntitlements_productCode' - Product code is used to uniquely identify a product in AWS Marketplace.
-- The product code will be provided by AWS Marketplace when the product
-- listing is created.
newGetEntitlements ::
  -- | 'productCode'
  Prelude.Text ->
  GetEntitlements
newGetEntitlements :: Text -> GetEntitlements
newGetEntitlements Text
pProductCode_ =
  GetEntitlements'
    { $sel:filter':GetEntitlements' :: Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
filter' = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetEntitlements' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetEntitlements' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:productCode:GetEntitlements' :: Text
productCode = Text
pProductCode_
    }

-- | Filter is used to return entitlements for a specific customer or for a
-- specific dimension. Filters are described as keys mapped to a lists of
-- values. Filtered requests are /unioned/ for each value in the value
-- list, and then /intersected/ for each filter key.
getEntitlements_filter :: Lens.Lens' GetEntitlements (Prelude.Maybe (Prelude.HashMap GetEntitlementFilterName (Prelude.NonEmpty Prelude.Text)))
getEntitlements_filter :: Lens'
  GetEntitlements
  (Maybe (HashMap GetEntitlementFilterName (NonEmpty Text)))
getEntitlements_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEntitlements' {Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
filter' :: Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
$sel:filter':GetEntitlements' :: GetEntitlements
-> Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
filter'} -> Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
filter') (\s :: GetEntitlements
s@GetEntitlements' {} Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
a -> GetEntitlements
s {$sel:filter':GetEntitlements' :: Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
filter' = Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
a} :: GetEntitlements) 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 items to retrieve from the GetEntitlements
-- operation. For pagination, use the NextToken field in subsequent calls
-- to GetEntitlements.
getEntitlements_maxResults :: Lens.Lens' GetEntitlements (Prelude.Maybe Prelude.Int)
getEntitlements_maxResults :: Lens' GetEntitlements (Maybe Int)
getEntitlements_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEntitlements' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:GetEntitlements' :: GetEntitlements -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: GetEntitlements
s@GetEntitlements' {} Maybe Int
a -> GetEntitlements
s {$sel:maxResults:GetEntitlements' :: Maybe Int
maxResults = Maybe Int
a} :: GetEntitlements)

-- | For paginated calls to GetEntitlements, pass the NextToken from the
-- previous GetEntitlementsResult.
getEntitlements_nextToken :: Lens.Lens' GetEntitlements (Prelude.Maybe Prelude.Text)
getEntitlements_nextToken :: Lens' GetEntitlements (Maybe Text)
getEntitlements_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEntitlements' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetEntitlements' :: GetEntitlements -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetEntitlements
s@GetEntitlements' {} Maybe Text
a -> GetEntitlements
s {$sel:nextToken:GetEntitlements' :: Maybe Text
nextToken = Maybe Text
a} :: GetEntitlements)

-- | Product code is used to uniquely identify a product in AWS Marketplace.
-- The product code will be provided by AWS Marketplace when the product
-- listing is created.
getEntitlements_productCode :: Lens.Lens' GetEntitlements Prelude.Text
getEntitlements_productCode :: Lens' GetEntitlements Text
getEntitlements_productCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEntitlements' {Text
productCode :: Text
$sel:productCode:GetEntitlements' :: GetEntitlements -> Text
productCode} -> Text
productCode) (\s :: GetEntitlements
s@GetEntitlements' {} Text
a -> GetEntitlements
s {$sel:productCode:GetEntitlements' :: Text
productCode = Text
a} :: GetEntitlements)

instance Core.AWSPager GetEntitlements where
  page :: GetEntitlements
-> AWSResponse GetEntitlements -> Maybe GetEntitlements
page GetEntitlements
rq AWSResponse GetEntitlements
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetEntitlements
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetEntitlementsResponse (Maybe Text)
getEntitlementsResponse_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 GetEntitlements
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetEntitlementsResponse (Maybe [Entitlement])
getEntitlementsResponse_entitlements
            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.$ GetEntitlements
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetEntitlements (Maybe Text)
getEntitlements_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetEntitlements
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetEntitlementsResponse (Maybe Text)
getEntitlementsResponse_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 GetEntitlements where
  type
    AWSResponse GetEntitlements =
      GetEntitlementsResponse
  request :: (Service -> Service) -> GetEntitlements -> Request GetEntitlements
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 GetEntitlements
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetEntitlements)))
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 [Entitlement] -> Maybe Text -> Int -> GetEntitlementsResponse
GetEntitlementsResponse'
            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
"Entitlements" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"NextToken")
            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 GetEntitlements where
  hashWithSalt :: Int -> GetEntitlements -> Int
hashWithSalt Int
_salt GetEntitlements' {Maybe Int
Maybe Text
Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
Text
productCode :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
filter' :: Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
$sel:productCode:GetEntitlements' :: GetEntitlements -> Text
$sel:nextToken:GetEntitlements' :: GetEntitlements -> Maybe Text
$sel:maxResults:GetEntitlements' :: GetEntitlements -> Maybe Int
$sel:filter':GetEntitlements' :: GetEntitlements
-> Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
filter'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
productCode

instance Prelude.NFData GetEntitlements where
  rnf :: GetEntitlements -> ()
rnf GetEntitlements' {Maybe Int
Maybe Text
Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
Text
productCode :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
filter' :: Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
$sel:productCode:GetEntitlements' :: GetEntitlements -> Text
$sel:nextToken:GetEntitlements' :: GetEntitlements -> Maybe Text
$sel:maxResults:GetEntitlements' :: GetEntitlements -> Maybe Int
$sel:filter':GetEntitlements' :: GetEntitlements
-> Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
filter'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
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 Text
productCode

instance Data.ToHeaders GetEntitlements where
  toHeaders :: GetEntitlements -> 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
"AWSMPEntitlementService.GetEntitlements" ::
                          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 GetEntitlements where
  toJSON :: GetEntitlements -> Value
toJSON GetEntitlements' {Maybe Int
Maybe Text
Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
Text
productCode :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
filter' :: Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
$sel:productCode:GetEntitlements' :: GetEntitlements -> Text
$sel:nextToken:GetEntitlements' :: GetEntitlements -> Maybe Text
$sel:maxResults:GetEntitlements' :: GetEntitlements -> Maybe Int
$sel:filter':GetEntitlements' :: GetEntitlements
-> Maybe (HashMap GetEntitlementFilterName (NonEmpty Text))
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Filter" 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 (HashMap GetEntitlementFilterName (NonEmpty Text))
filter',
            (Key
"MaxResults" 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 Int
maxResults,
            (Key
"NextToken" 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 Text
nextToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"ProductCode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
productCode)
          ]
      )

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

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

-- | The GetEntitlementsRequest contains results from the GetEntitlements
-- operation.
--
-- /See:/ 'newGetEntitlementsResponse' smart constructor.
data GetEntitlementsResponse = GetEntitlementsResponse'
  { -- | The set of entitlements found through the GetEntitlements operation. If
    -- the result contains an empty set of entitlements, NextToken might still
    -- be present and should be used.
    GetEntitlementsResponse -> Maybe [Entitlement]
entitlements :: Prelude.Maybe [Entitlement],
    -- | For paginated results, use NextToken in subsequent calls to
    -- GetEntitlements. If the result contains an empty set of entitlements,
    -- NextToken might still be present and should be used.
    GetEntitlementsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetEntitlementsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetEntitlementsResponse -> GetEntitlementsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetEntitlementsResponse -> GetEntitlementsResponse -> Bool
$c/= :: GetEntitlementsResponse -> GetEntitlementsResponse -> Bool
== :: GetEntitlementsResponse -> GetEntitlementsResponse -> Bool
$c== :: GetEntitlementsResponse -> GetEntitlementsResponse -> Bool
Prelude.Eq, ReadPrec [GetEntitlementsResponse]
ReadPrec GetEntitlementsResponse
Int -> ReadS GetEntitlementsResponse
ReadS [GetEntitlementsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetEntitlementsResponse]
$creadListPrec :: ReadPrec [GetEntitlementsResponse]
readPrec :: ReadPrec GetEntitlementsResponse
$creadPrec :: ReadPrec GetEntitlementsResponse
readList :: ReadS [GetEntitlementsResponse]
$creadList :: ReadS [GetEntitlementsResponse]
readsPrec :: Int -> ReadS GetEntitlementsResponse
$creadsPrec :: Int -> ReadS GetEntitlementsResponse
Prelude.Read, Int -> GetEntitlementsResponse -> ShowS
[GetEntitlementsResponse] -> ShowS
GetEntitlementsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetEntitlementsResponse] -> ShowS
$cshowList :: [GetEntitlementsResponse] -> ShowS
show :: GetEntitlementsResponse -> String
$cshow :: GetEntitlementsResponse -> String
showsPrec :: Int -> GetEntitlementsResponse -> ShowS
$cshowsPrec :: Int -> GetEntitlementsResponse -> ShowS
Prelude.Show, forall x. Rep GetEntitlementsResponse x -> GetEntitlementsResponse
forall x. GetEntitlementsResponse -> Rep GetEntitlementsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetEntitlementsResponse x -> GetEntitlementsResponse
$cfrom :: forall x. GetEntitlementsResponse -> Rep GetEntitlementsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetEntitlementsResponse' 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:
--
-- 'entitlements', 'getEntitlementsResponse_entitlements' - The set of entitlements found through the GetEntitlements operation. If
-- the result contains an empty set of entitlements, NextToken might still
-- be present and should be used.
--
-- 'nextToken', 'getEntitlementsResponse_nextToken' - For paginated results, use NextToken in subsequent calls to
-- GetEntitlements. If the result contains an empty set of entitlements,
-- NextToken might still be present and should be used.
--
-- 'httpStatus', 'getEntitlementsResponse_httpStatus' - The response's http status code.
newGetEntitlementsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetEntitlementsResponse
newGetEntitlementsResponse :: Int -> GetEntitlementsResponse
newGetEntitlementsResponse Int
pHttpStatus_ =
  GetEntitlementsResponse'
    { $sel:entitlements:GetEntitlementsResponse' :: Maybe [Entitlement]
entitlements =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetEntitlementsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetEntitlementsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The set of entitlements found through the GetEntitlements operation. If
-- the result contains an empty set of entitlements, NextToken might still
-- be present and should be used.
getEntitlementsResponse_entitlements :: Lens.Lens' GetEntitlementsResponse (Prelude.Maybe [Entitlement])
getEntitlementsResponse_entitlements :: Lens' GetEntitlementsResponse (Maybe [Entitlement])
getEntitlementsResponse_entitlements = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEntitlementsResponse' {Maybe [Entitlement]
entitlements :: Maybe [Entitlement]
$sel:entitlements:GetEntitlementsResponse' :: GetEntitlementsResponse -> Maybe [Entitlement]
entitlements} -> Maybe [Entitlement]
entitlements) (\s :: GetEntitlementsResponse
s@GetEntitlementsResponse' {} Maybe [Entitlement]
a -> GetEntitlementsResponse
s {$sel:entitlements:GetEntitlementsResponse' :: Maybe [Entitlement]
entitlements = Maybe [Entitlement]
a} :: GetEntitlementsResponse) 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

-- | For paginated results, use NextToken in subsequent calls to
-- GetEntitlements. If the result contains an empty set of entitlements,
-- NextToken might still be present and should be used.
getEntitlementsResponse_nextToken :: Lens.Lens' GetEntitlementsResponse (Prelude.Maybe Prelude.Text)
getEntitlementsResponse_nextToken :: Lens' GetEntitlementsResponse (Maybe Text)
getEntitlementsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEntitlementsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetEntitlementsResponse' :: GetEntitlementsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetEntitlementsResponse
s@GetEntitlementsResponse' {} Maybe Text
a -> GetEntitlementsResponse
s {$sel:nextToken:GetEntitlementsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetEntitlementsResponse)

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

instance Prelude.NFData GetEntitlementsResponse where
  rnf :: GetEntitlementsResponse -> ()
rnf GetEntitlementsResponse' {Int
Maybe [Entitlement]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
entitlements :: Maybe [Entitlement]
$sel:httpStatus:GetEntitlementsResponse' :: GetEntitlementsResponse -> Int
$sel:nextToken:GetEntitlementsResponse' :: GetEntitlementsResponse -> Maybe Text
$sel:entitlements:GetEntitlementsResponse' :: GetEntitlementsResponse -> Maybe [Entitlement]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Entitlement]
entitlements
      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 Int
httpStatus