{-# 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.GameLift.DescribeMatchmakingRuleSets
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the details for FlexMatch matchmaking rule sets. You can
-- request all existing rule sets for the Region, or provide a list of one
-- or more rule set names. When requesting multiple items, use the
-- pagination parameters to retrieve results as a set of sequential pages.
-- If successful, a rule set is returned for each requested name.
--
-- __Learn more__
--
-- -   <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-rulesets.html Build a rule set>
--
-- This operation returns paginated results.
module Amazonka.GameLift.DescribeMatchmakingRuleSets
  ( -- * Creating a Request
    DescribeMatchmakingRuleSets (..),
    newDescribeMatchmakingRuleSets,

    -- * Request Lenses
    describeMatchmakingRuleSets_limit,
    describeMatchmakingRuleSets_names,
    describeMatchmakingRuleSets_nextToken,

    -- * Destructuring the Response
    DescribeMatchmakingRuleSetsResponse (..),
    newDescribeMatchmakingRuleSetsResponse,

    -- * Response Lenses
    describeMatchmakingRuleSetsResponse_nextToken,
    describeMatchmakingRuleSetsResponse_httpStatus,
    describeMatchmakingRuleSetsResponse_ruleSets,
  )
where

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

-- | /See:/ 'newDescribeMatchmakingRuleSets' smart constructor.
data DescribeMatchmakingRuleSets = DescribeMatchmakingRuleSets'
  { -- | The maximum number of results to return. Use this parameter with
    -- @NextToken@ to get results as a set of sequential pages.
    DescribeMatchmakingRuleSets -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | A list of one or more matchmaking rule set names to retrieve details
    -- for. (Note: The rule set name is different from the optional \"name\"
    -- field in the rule set body.) You can use either the rule set name or ARN
    -- value.
    DescribeMatchmakingRuleSets -> Maybe (NonEmpty Text)
names :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | A token that indicates the start of the next sequential page of results.
    -- Use the token that is returned with a previous call to this operation.
    -- To start at the beginning of the result set, do not specify a value.
    DescribeMatchmakingRuleSets -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeMatchmakingRuleSets -> DescribeMatchmakingRuleSets -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeMatchmakingRuleSets -> DescribeMatchmakingRuleSets -> Bool
$c/= :: DescribeMatchmakingRuleSets -> DescribeMatchmakingRuleSets -> Bool
== :: DescribeMatchmakingRuleSets -> DescribeMatchmakingRuleSets -> Bool
$c== :: DescribeMatchmakingRuleSets -> DescribeMatchmakingRuleSets -> Bool
Prelude.Eq, ReadPrec [DescribeMatchmakingRuleSets]
ReadPrec DescribeMatchmakingRuleSets
Int -> ReadS DescribeMatchmakingRuleSets
ReadS [DescribeMatchmakingRuleSets]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeMatchmakingRuleSets]
$creadListPrec :: ReadPrec [DescribeMatchmakingRuleSets]
readPrec :: ReadPrec DescribeMatchmakingRuleSets
$creadPrec :: ReadPrec DescribeMatchmakingRuleSets
readList :: ReadS [DescribeMatchmakingRuleSets]
$creadList :: ReadS [DescribeMatchmakingRuleSets]
readsPrec :: Int -> ReadS DescribeMatchmakingRuleSets
$creadsPrec :: Int -> ReadS DescribeMatchmakingRuleSets
Prelude.Read, Int -> DescribeMatchmakingRuleSets -> ShowS
[DescribeMatchmakingRuleSets] -> ShowS
DescribeMatchmakingRuleSets -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeMatchmakingRuleSets] -> ShowS
$cshowList :: [DescribeMatchmakingRuleSets] -> ShowS
show :: DescribeMatchmakingRuleSets -> String
$cshow :: DescribeMatchmakingRuleSets -> String
showsPrec :: Int -> DescribeMatchmakingRuleSets -> ShowS
$cshowsPrec :: Int -> DescribeMatchmakingRuleSets -> ShowS
Prelude.Show, forall x.
Rep DescribeMatchmakingRuleSets x -> DescribeMatchmakingRuleSets
forall x.
DescribeMatchmakingRuleSets -> Rep DescribeMatchmakingRuleSets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeMatchmakingRuleSets x -> DescribeMatchmakingRuleSets
$cfrom :: forall x.
DescribeMatchmakingRuleSets -> Rep DescribeMatchmakingRuleSets x
Prelude.Generic)

-- |
-- Create a value of 'DescribeMatchmakingRuleSets' 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:
--
-- 'limit', 'describeMatchmakingRuleSets_limit' - The maximum number of results to return. Use this parameter with
-- @NextToken@ to get results as a set of sequential pages.
--
-- 'names', 'describeMatchmakingRuleSets_names' - A list of one or more matchmaking rule set names to retrieve details
-- for. (Note: The rule set name is different from the optional \"name\"
-- field in the rule set body.) You can use either the rule set name or ARN
-- value.
--
-- 'nextToken', 'describeMatchmakingRuleSets_nextToken' - A token that indicates the start of the next sequential page of results.
-- Use the token that is returned with a previous call to this operation.
-- To start at the beginning of the result set, do not specify a value.
newDescribeMatchmakingRuleSets ::
  DescribeMatchmakingRuleSets
newDescribeMatchmakingRuleSets :: DescribeMatchmakingRuleSets
newDescribeMatchmakingRuleSets =
  DescribeMatchmakingRuleSets'
    { $sel:limit:DescribeMatchmakingRuleSets' :: Maybe Natural
limit =
        forall a. Maybe a
Prelude.Nothing,
      $sel:names:DescribeMatchmakingRuleSets' :: Maybe (NonEmpty Text)
names = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeMatchmakingRuleSets' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of results to return. Use this parameter with
-- @NextToken@ to get results as a set of sequential pages.
describeMatchmakingRuleSets_limit :: Lens.Lens' DescribeMatchmakingRuleSets (Prelude.Maybe Prelude.Natural)
describeMatchmakingRuleSets_limit :: Lens' DescribeMatchmakingRuleSets (Maybe Natural)
describeMatchmakingRuleSets_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMatchmakingRuleSets' {Maybe Natural
limit :: Maybe Natural
$sel:limit:DescribeMatchmakingRuleSets' :: DescribeMatchmakingRuleSets -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: DescribeMatchmakingRuleSets
s@DescribeMatchmakingRuleSets' {} Maybe Natural
a -> DescribeMatchmakingRuleSets
s {$sel:limit:DescribeMatchmakingRuleSets' :: Maybe Natural
limit = Maybe Natural
a} :: DescribeMatchmakingRuleSets)

-- | A list of one or more matchmaking rule set names to retrieve details
-- for. (Note: The rule set name is different from the optional \"name\"
-- field in the rule set body.) You can use either the rule set name or ARN
-- value.
describeMatchmakingRuleSets_names :: Lens.Lens' DescribeMatchmakingRuleSets (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
describeMatchmakingRuleSets_names :: Lens' DescribeMatchmakingRuleSets (Maybe (NonEmpty Text))
describeMatchmakingRuleSets_names = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMatchmakingRuleSets' {Maybe (NonEmpty Text)
names :: Maybe (NonEmpty Text)
$sel:names:DescribeMatchmakingRuleSets' :: DescribeMatchmakingRuleSets -> Maybe (NonEmpty Text)
names} -> Maybe (NonEmpty Text)
names) (\s :: DescribeMatchmakingRuleSets
s@DescribeMatchmakingRuleSets' {} Maybe (NonEmpty Text)
a -> DescribeMatchmakingRuleSets
s {$sel:names:DescribeMatchmakingRuleSets' :: Maybe (NonEmpty Text)
names = Maybe (NonEmpty Text)
a} :: DescribeMatchmakingRuleSets) 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

-- | A token that indicates the start of the next sequential page of results.
-- Use the token that is returned with a previous call to this operation.
-- To start at the beginning of the result set, do not specify a value.
describeMatchmakingRuleSets_nextToken :: Lens.Lens' DescribeMatchmakingRuleSets (Prelude.Maybe Prelude.Text)
describeMatchmakingRuleSets_nextToken :: Lens' DescribeMatchmakingRuleSets (Maybe Text)
describeMatchmakingRuleSets_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMatchmakingRuleSets' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeMatchmakingRuleSets' :: DescribeMatchmakingRuleSets -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeMatchmakingRuleSets
s@DescribeMatchmakingRuleSets' {} Maybe Text
a -> DescribeMatchmakingRuleSets
s {$sel:nextToken:DescribeMatchmakingRuleSets' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeMatchmakingRuleSets)

instance Core.AWSPager DescribeMatchmakingRuleSets where
  page :: DescribeMatchmakingRuleSets
-> AWSResponse DescribeMatchmakingRuleSets
-> Maybe DescribeMatchmakingRuleSets
page DescribeMatchmakingRuleSets
rq AWSResponse DescribeMatchmakingRuleSets
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeMatchmakingRuleSets
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeMatchmakingRuleSetsResponse (Maybe Text)
describeMatchmakingRuleSetsResponse_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 DescribeMatchmakingRuleSets
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' DescribeMatchmakingRuleSetsResponse [MatchmakingRuleSet]
describeMatchmakingRuleSetsResponse_ruleSets
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ DescribeMatchmakingRuleSets
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeMatchmakingRuleSets (Maybe Text)
describeMatchmakingRuleSets_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeMatchmakingRuleSets
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeMatchmakingRuleSetsResponse (Maybe Text)
describeMatchmakingRuleSetsResponse_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 DescribeMatchmakingRuleSets where
  type
    AWSResponse DescribeMatchmakingRuleSets =
      DescribeMatchmakingRuleSetsResponse
  request :: (Service -> Service)
-> DescribeMatchmakingRuleSets
-> Request DescribeMatchmakingRuleSets
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 DescribeMatchmakingRuleSets
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeMatchmakingRuleSets)))
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
-> [MatchmakingRuleSet]
-> DescribeMatchmakingRuleSetsResponse
DescribeMatchmakingRuleSetsResponse'
            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
"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))
            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
"RuleSets" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable DescribeMatchmakingRuleSets where
  hashWithSalt :: Int -> DescribeMatchmakingRuleSets -> Int
hashWithSalt Int
_salt DescribeMatchmakingRuleSets' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
nextToken :: Maybe Text
names :: Maybe (NonEmpty Text)
limit :: Maybe Natural
$sel:nextToken:DescribeMatchmakingRuleSets' :: DescribeMatchmakingRuleSets -> Maybe Text
$sel:names:DescribeMatchmakingRuleSets' :: DescribeMatchmakingRuleSets -> Maybe (NonEmpty Text)
$sel:limit:DescribeMatchmakingRuleSets' :: DescribeMatchmakingRuleSets -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
names
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData DescribeMatchmakingRuleSets where
  rnf :: DescribeMatchmakingRuleSets -> ()
rnf DescribeMatchmakingRuleSets' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
nextToken :: Maybe Text
names :: Maybe (NonEmpty Text)
limit :: Maybe Natural
$sel:nextToken:DescribeMatchmakingRuleSets' :: DescribeMatchmakingRuleSets -> Maybe Text
$sel:names:DescribeMatchmakingRuleSets' :: DescribeMatchmakingRuleSets -> Maybe (NonEmpty Text)
$sel:limit:DescribeMatchmakingRuleSets' :: DescribeMatchmakingRuleSets -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
names
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance Data.ToHeaders DescribeMatchmakingRuleSets where
  toHeaders :: DescribeMatchmakingRuleSets -> 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
"GameLift.DescribeMatchmakingRuleSets" ::
                          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 DescribeMatchmakingRuleSets where
  toJSON :: DescribeMatchmakingRuleSets -> Value
toJSON DescribeMatchmakingRuleSets' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
nextToken :: Maybe Text
names :: Maybe (NonEmpty Text)
limit :: Maybe Natural
$sel:nextToken:DescribeMatchmakingRuleSets' :: DescribeMatchmakingRuleSets -> Maybe Text
$sel:names:DescribeMatchmakingRuleSets' :: DescribeMatchmakingRuleSets -> Maybe (NonEmpty Text)
$sel:limit:DescribeMatchmakingRuleSets' :: DescribeMatchmakingRuleSets -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Limit" 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
limit,
            (Key
"Names" 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 Text)
names,
            (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
          ]
      )

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

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

-- | /See:/ 'newDescribeMatchmakingRuleSetsResponse' smart constructor.
data DescribeMatchmakingRuleSetsResponse = DescribeMatchmakingRuleSetsResponse'
  { -- | A token that indicates where to resume retrieving results on the next
    -- call to this operation. If no token is returned, these results represent
    -- the end of the list.
    DescribeMatchmakingRuleSetsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeMatchmakingRuleSetsResponse -> Int
httpStatus :: Prelude.Int,
    -- | A collection of requested matchmaking rule set objects.
    DescribeMatchmakingRuleSetsResponse -> [MatchmakingRuleSet]
ruleSets :: [MatchmakingRuleSet]
  }
  deriving (DescribeMatchmakingRuleSetsResponse
-> DescribeMatchmakingRuleSetsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeMatchmakingRuleSetsResponse
-> DescribeMatchmakingRuleSetsResponse -> Bool
$c/= :: DescribeMatchmakingRuleSetsResponse
-> DescribeMatchmakingRuleSetsResponse -> Bool
== :: DescribeMatchmakingRuleSetsResponse
-> DescribeMatchmakingRuleSetsResponse -> Bool
$c== :: DescribeMatchmakingRuleSetsResponse
-> DescribeMatchmakingRuleSetsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeMatchmakingRuleSetsResponse]
ReadPrec DescribeMatchmakingRuleSetsResponse
Int -> ReadS DescribeMatchmakingRuleSetsResponse
ReadS [DescribeMatchmakingRuleSetsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeMatchmakingRuleSetsResponse]
$creadListPrec :: ReadPrec [DescribeMatchmakingRuleSetsResponse]
readPrec :: ReadPrec DescribeMatchmakingRuleSetsResponse
$creadPrec :: ReadPrec DescribeMatchmakingRuleSetsResponse
readList :: ReadS [DescribeMatchmakingRuleSetsResponse]
$creadList :: ReadS [DescribeMatchmakingRuleSetsResponse]
readsPrec :: Int -> ReadS DescribeMatchmakingRuleSetsResponse
$creadsPrec :: Int -> ReadS DescribeMatchmakingRuleSetsResponse
Prelude.Read, Int -> DescribeMatchmakingRuleSetsResponse -> ShowS
[DescribeMatchmakingRuleSetsResponse] -> ShowS
DescribeMatchmakingRuleSetsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeMatchmakingRuleSetsResponse] -> ShowS
$cshowList :: [DescribeMatchmakingRuleSetsResponse] -> ShowS
show :: DescribeMatchmakingRuleSetsResponse -> String
$cshow :: DescribeMatchmakingRuleSetsResponse -> String
showsPrec :: Int -> DescribeMatchmakingRuleSetsResponse -> ShowS
$cshowsPrec :: Int -> DescribeMatchmakingRuleSetsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeMatchmakingRuleSetsResponse x
-> DescribeMatchmakingRuleSetsResponse
forall x.
DescribeMatchmakingRuleSetsResponse
-> Rep DescribeMatchmakingRuleSetsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeMatchmakingRuleSetsResponse x
-> DescribeMatchmakingRuleSetsResponse
$cfrom :: forall x.
DescribeMatchmakingRuleSetsResponse
-> Rep DescribeMatchmakingRuleSetsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeMatchmakingRuleSetsResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'nextToken', 'describeMatchmakingRuleSetsResponse_nextToken' - A token that indicates where to resume retrieving results on the next
-- call to this operation. If no token is returned, these results represent
-- the end of the list.
--
-- 'httpStatus', 'describeMatchmakingRuleSetsResponse_httpStatus' - The response's http status code.
--
-- 'ruleSets', 'describeMatchmakingRuleSetsResponse_ruleSets' - A collection of requested matchmaking rule set objects.
newDescribeMatchmakingRuleSetsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeMatchmakingRuleSetsResponse
newDescribeMatchmakingRuleSetsResponse :: Int -> DescribeMatchmakingRuleSetsResponse
newDescribeMatchmakingRuleSetsResponse Int
pHttpStatus_ =
  DescribeMatchmakingRuleSetsResponse'
    { $sel:nextToken:DescribeMatchmakingRuleSetsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeMatchmakingRuleSetsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:ruleSets:DescribeMatchmakingRuleSetsResponse' :: [MatchmakingRuleSet]
ruleSets = forall a. Monoid a => a
Prelude.mempty
    }

-- | A token that indicates where to resume retrieving results on the next
-- call to this operation. If no token is returned, these results represent
-- the end of the list.
describeMatchmakingRuleSetsResponse_nextToken :: Lens.Lens' DescribeMatchmakingRuleSetsResponse (Prelude.Maybe Prelude.Text)
describeMatchmakingRuleSetsResponse_nextToken :: Lens' DescribeMatchmakingRuleSetsResponse (Maybe Text)
describeMatchmakingRuleSetsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMatchmakingRuleSetsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeMatchmakingRuleSetsResponse' :: DescribeMatchmakingRuleSetsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeMatchmakingRuleSetsResponse
s@DescribeMatchmakingRuleSetsResponse' {} Maybe Text
a -> DescribeMatchmakingRuleSetsResponse
s {$sel:nextToken:DescribeMatchmakingRuleSetsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeMatchmakingRuleSetsResponse)

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

-- | A collection of requested matchmaking rule set objects.
describeMatchmakingRuleSetsResponse_ruleSets :: Lens.Lens' DescribeMatchmakingRuleSetsResponse [MatchmakingRuleSet]
describeMatchmakingRuleSetsResponse_ruleSets :: Lens' DescribeMatchmakingRuleSetsResponse [MatchmakingRuleSet]
describeMatchmakingRuleSetsResponse_ruleSets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMatchmakingRuleSetsResponse' {[MatchmakingRuleSet]
ruleSets :: [MatchmakingRuleSet]
$sel:ruleSets:DescribeMatchmakingRuleSetsResponse' :: DescribeMatchmakingRuleSetsResponse -> [MatchmakingRuleSet]
ruleSets} -> [MatchmakingRuleSet]
ruleSets) (\s :: DescribeMatchmakingRuleSetsResponse
s@DescribeMatchmakingRuleSetsResponse' {} [MatchmakingRuleSet]
a -> DescribeMatchmakingRuleSetsResponse
s {$sel:ruleSets:DescribeMatchmakingRuleSetsResponse' :: [MatchmakingRuleSet]
ruleSets = [MatchmakingRuleSet]
a} :: DescribeMatchmakingRuleSetsResponse) 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
  Prelude.NFData
    DescribeMatchmakingRuleSetsResponse
  where
  rnf :: DescribeMatchmakingRuleSetsResponse -> ()
rnf DescribeMatchmakingRuleSetsResponse' {Int
[MatchmakingRuleSet]
Maybe Text
ruleSets :: [MatchmakingRuleSet]
httpStatus :: Int
nextToken :: Maybe Text
$sel:ruleSets:DescribeMatchmakingRuleSetsResponse' :: DescribeMatchmakingRuleSetsResponse -> [MatchmakingRuleSet]
$sel:httpStatus:DescribeMatchmakingRuleSetsResponse' :: DescribeMatchmakingRuleSetsResponse -> Int
$sel:nextToken:DescribeMatchmakingRuleSetsResponse' :: DescribeMatchmakingRuleSetsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [MatchmakingRuleSet]
ruleSets