{-# 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.DescribeMatchmakingConfigurations
-- 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 of FlexMatch matchmaking configurations.
--
-- This operation offers the following options: (1) retrieve all
-- matchmaking configurations, (2) retrieve configurations for a specified
-- list, or (3) retrieve all configurations that use a specified rule set
-- name. When requesting multiple items, use the pagination parameters to
-- retrieve results as a set of sequential pages.
--
-- If successful, a configuration is returned for each requested name. When
-- specifying a list of names, only configurations that currently exist are
-- returned.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/matchmaker-build.html Setting up FlexMatch matchmakers>
--
-- This operation returns paginated results.
module Amazonka.GameLift.DescribeMatchmakingConfigurations
  ( -- * Creating a Request
    DescribeMatchmakingConfigurations (..),
    newDescribeMatchmakingConfigurations,

    -- * Request Lenses
    describeMatchmakingConfigurations_limit,
    describeMatchmakingConfigurations_names,
    describeMatchmakingConfigurations_nextToken,
    describeMatchmakingConfigurations_ruleSetName,

    -- * Destructuring the Response
    DescribeMatchmakingConfigurationsResponse (..),
    newDescribeMatchmakingConfigurationsResponse,

    -- * Response Lenses
    describeMatchmakingConfigurationsResponse_configurations,
    describeMatchmakingConfigurationsResponse_nextToken,
    describeMatchmakingConfigurationsResponse_httpStatus,
  )
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:/ 'newDescribeMatchmakingConfigurations' smart constructor.
data DescribeMatchmakingConfigurations = DescribeMatchmakingConfigurations'
  { -- | The maximum number of results to return. Use this parameter with
    -- @NextToken@ to get results as a set of sequential pages. This parameter
    -- is limited to 10.
    DescribeMatchmakingConfigurations -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | A unique identifier for the matchmaking configuration(s) to retrieve.
    -- You can use either the configuration name or ARN value. To request all
    -- existing configurations, leave this parameter empty.
    DescribeMatchmakingConfigurations -> Maybe [Text]
names :: Prelude.Maybe [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.
    DescribeMatchmakingConfigurations -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the matchmaking rule set. You can use either the
    -- rule set name or ARN value. Use this parameter to retrieve all
    -- matchmaking configurations that use this rule set.
    DescribeMatchmakingConfigurations -> Maybe Text
ruleSetName :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeMatchmakingConfigurations
-> DescribeMatchmakingConfigurations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeMatchmakingConfigurations
-> DescribeMatchmakingConfigurations -> Bool
$c/= :: DescribeMatchmakingConfigurations
-> DescribeMatchmakingConfigurations -> Bool
== :: DescribeMatchmakingConfigurations
-> DescribeMatchmakingConfigurations -> Bool
$c== :: DescribeMatchmakingConfigurations
-> DescribeMatchmakingConfigurations -> Bool
Prelude.Eq, ReadPrec [DescribeMatchmakingConfigurations]
ReadPrec DescribeMatchmakingConfigurations
Int -> ReadS DescribeMatchmakingConfigurations
ReadS [DescribeMatchmakingConfigurations]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeMatchmakingConfigurations]
$creadListPrec :: ReadPrec [DescribeMatchmakingConfigurations]
readPrec :: ReadPrec DescribeMatchmakingConfigurations
$creadPrec :: ReadPrec DescribeMatchmakingConfigurations
readList :: ReadS [DescribeMatchmakingConfigurations]
$creadList :: ReadS [DescribeMatchmakingConfigurations]
readsPrec :: Int -> ReadS DescribeMatchmakingConfigurations
$creadsPrec :: Int -> ReadS DescribeMatchmakingConfigurations
Prelude.Read, Int -> DescribeMatchmakingConfigurations -> ShowS
[DescribeMatchmakingConfigurations] -> ShowS
DescribeMatchmakingConfigurations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeMatchmakingConfigurations] -> ShowS
$cshowList :: [DescribeMatchmakingConfigurations] -> ShowS
show :: DescribeMatchmakingConfigurations -> String
$cshow :: DescribeMatchmakingConfigurations -> String
showsPrec :: Int -> DescribeMatchmakingConfigurations -> ShowS
$cshowsPrec :: Int -> DescribeMatchmakingConfigurations -> ShowS
Prelude.Show, forall x.
Rep DescribeMatchmakingConfigurations x
-> DescribeMatchmakingConfigurations
forall x.
DescribeMatchmakingConfigurations
-> Rep DescribeMatchmakingConfigurations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeMatchmakingConfigurations x
-> DescribeMatchmakingConfigurations
$cfrom :: forall x.
DescribeMatchmakingConfigurations
-> Rep DescribeMatchmakingConfigurations x
Prelude.Generic)

-- |
-- Create a value of 'DescribeMatchmakingConfigurations' 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', 'describeMatchmakingConfigurations_limit' - The maximum number of results to return. Use this parameter with
-- @NextToken@ to get results as a set of sequential pages. This parameter
-- is limited to 10.
--
-- 'names', 'describeMatchmakingConfigurations_names' - A unique identifier for the matchmaking configuration(s) to retrieve.
-- You can use either the configuration name or ARN value. To request all
-- existing configurations, leave this parameter empty.
--
-- 'nextToken', 'describeMatchmakingConfigurations_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.
--
-- 'ruleSetName', 'describeMatchmakingConfigurations_ruleSetName' - A unique identifier for the matchmaking rule set. You can use either the
-- rule set name or ARN value. Use this parameter to retrieve all
-- matchmaking configurations that use this rule set.
newDescribeMatchmakingConfigurations ::
  DescribeMatchmakingConfigurations
newDescribeMatchmakingConfigurations :: DescribeMatchmakingConfigurations
newDescribeMatchmakingConfigurations =
  DescribeMatchmakingConfigurations'
    { $sel:limit:DescribeMatchmakingConfigurations' :: Maybe Natural
limit =
        forall a. Maybe a
Prelude.Nothing,
      $sel:names:DescribeMatchmakingConfigurations' :: Maybe [Text]
names = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeMatchmakingConfigurations' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:ruleSetName:DescribeMatchmakingConfigurations' :: Maybe Text
ruleSetName = 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. This parameter
-- is limited to 10.
describeMatchmakingConfigurations_limit :: Lens.Lens' DescribeMatchmakingConfigurations (Prelude.Maybe Prelude.Natural)
describeMatchmakingConfigurations_limit :: Lens' DescribeMatchmakingConfigurations (Maybe Natural)
describeMatchmakingConfigurations_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMatchmakingConfigurations' {Maybe Natural
limit :: Maybe Natural
$sel:limit:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: DescribeMatchmakingConfigurations
s@DescribeMatchmakingConfigurations' {} Maybe Natural
a -> DescribeMatchmakingConfigurations
s {$sel:limit:DescribeMatchmakingConfigurations' :: Maybe Natural
limit = Maybe Natural
a} :: DescribeMatchmakingConfigurations)

-- | A unique identifier for the matchmaking configuration(s) to retrieve.
-- You can use either the configuration name or ARN value. To request all
-- existing configurations, leave this parameter empty.
describeMatchmakingConfigurations_names :: Lens.Lens' DescribeMatchmakingConfigurations (Prelude.Maybe [Prelude.Text])
describeMatchmakingConfigurations_names :: Lens' DescribeMatchmakingConfigurations (Maybe [Text])
describeMatchmakingConfigurations_names = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMatchmakingConfigurations' {Maybe [Text]
names :: Maybe [Text]
$sel:names:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> Maybe [Text]
names} -> Maybe [Text]
names) (\s :: DescribeMatchmakingConfigurations
s@DescribeMatchmakingConfigurations' {} Maybe [Text]
a -> DescribeMatchmakingConfigurations
s {$sel:names:DescribeMatchmakingConfigurations' :: Maybe [Text]
names = Maybe [Text]
a} :: DescribeMatchmakingConfigurations) 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.
describeMatchmakingConfigurations_nextToken :: Lens.Lens' DescribeMatchmakingConfigurations (Prelude.Maybe Prelude.Text)
describeMatchmakingConfigurations_nextToken :: Lens' DescribeMatchmakingConfigurations (Maybe Text)
describeMatchmakingConfigurations_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMatchmakingConfigurations' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeMatchmakingConfigurations
s@DescribeMatchmakingConfigurations' {} Maybe Text
a -> DescribeMatchmakingConfigurations
s {$sel:nextToken:DescribeMatchmakingConfigurations' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeMatchmakingConfigurations)

-- | A unique identifier for the matchmaking rule set. You can use either the
-- rule set name or ARN value. Use this parameter to retrieve all
-- matchmaking configurations that use this rule set.
describeMatchmakingConfigurations_ruleSetName :: Lens.Lens' DescribeMatchmakingConfigurations (Prelude.Maybe Prelude.Text)
describeMatchmakingConfigurations_ruleSetName :: Lens' DescribeMatchmakingConfigurations (Maybe Text)
describeMatchmakingConfigurations_ruleSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMatchmakingConfigurations' {Maybe Text
ruleSetName :: Maybe Text
$sel:ruleSetName:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> Maybe Text
ruleSetName} -> Maybe Text
ruleSetName) (\s :: DescribeMatchmakingConfigurations
s@DescribeMatchmakingConfigurations' {} Maybe Text
a -> DescribeMatchmakingConfigurations
s {$sel:ruleSetName:DescribeMatchmakingConfigurations' :: Maybe Text
ruleSetName = Maybe Text
a} :: DescribeMatchmakingConfigurations)

instance
  Core.AWSPager
    DescribeMatchmakingConfigurations
  where
  page :: DescribeMatchmakingConfigurations
-> AWSResponse DescribeMatchmakingConfigurations
-> Maybe DescribeMatchmakingConfigurations
page DescribeMatchmakingConfigurations
rq AWSResponse DescribeMatchmakingConfigurations
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeMatchmakingConfigurations
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeMatchmakingConfigurationsResponse (Maybe Text)
describeMatchmakingConfigurationsResponse_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 DescribeMatchmakingConfigurations
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  DescribeMatchmakingConfigurationsResponse
  (Maybe [MatchmakingConfiguration])
describeMatchmakingConfigurationsResponse_configurations
            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.$ DescribeMatchmakingConfigurations
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeMatchmakingConfigurations (Maybe Text)
describeMatchmakingConfigurations_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeMatchmakingConfigurations
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeMatchmakingConfigurationsResponse (Maybe Text)
describeMatchmakingConfigurationsResponse_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
    DescribeMatchmakingConfigurations
  where
  type
    AWSResponse DescribeMatchmakingConfigurations =
      DescribeMatchmakingConfigurationsResponse
  request :: (Service -> Service)
-> DescribeMatchmakingConfigurations
-> Request DescribeMatchmakingConfigurations
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 DescribeMatchmakingConfigurations
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DescribeMatchmakingConfigurations)))
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 [MatchmakingConfiguration]
-> Maybe Text -> Int -> DescribeMatchmakingConfigurationsResponse
DescribeMatchmakingConfigurationsResponse'
            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
"Configurations" 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
    DescribeMatchmakingConfigurations
  where
  hashWithSalt :: Int -> DescribeMatchmakingConfigurations -> Int
hashWithSalt
    Int
_salt
    DescribeMatchmakingConfigurations' {Maybe Natural
Maybe [Text]
Maybe Text
ruleSetName :: Maybe Text
nextToken :: Maybe Text
names :: Maybe [Text]
limit :: Maybe Natural
$sel:ruleSetName:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> Maybe Text
$sel:nextToken:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> Maybe Text
$sel:names:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> Maybe [Text]
$sel:limit:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> 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 [Text]
names
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ruleSetName

instance
  Prelude.NFData
    DescribeMatchmakingConfigurations
  where
  rnf :: DescribeMatchmakingConfigurations -> ()
rnf DescribeMatchmakingConfigurations' {Maybe Natural
Maybe [Text]
Maybe Text
ruleSetName :: Maybe Text
nextToken :: Maybe Text
names :: Maybe [Text]
limit :: Maybe Natural
$sel:ruleSetName:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> Maybe Text
$sel:nextToken:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> Maybe Text
$sel:names:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> Maybe [Text]
$sel:limit:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> 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 [Text]
names
      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 Maybe Text
ruleSetName

instance
  Data.ToHeaders
    DescribeMatchmakingConfigurations
  where
  toHeaders :: DescribeMatchmakingConfigurations -> 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.DescribeMatchmakingConfigurations" ::
                          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
    DescribeMatchmakingConfigurations
  where
  toJSON :: DescribeMatchmakingConfigurations -> Value
toJSON DescribeMatchmakingConfigurations' {Maybe Natural
Maybe [Text]
Maybe Text
ruleSetName :: Maybe Text
nextToken :: Maybe Text
names :: Maybe [Text]
limit :: Maybe Natural
$sel:ruleSetName:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> Maybe Text
$sel:nextToken:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> Maybe Text
$sel:names:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> Maybe [Text]
$sel:limit:DescribeMatchmakingConfigurations' :: DescribeMatchmakingConfigurations -> 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 [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,
            (Key
"RuleSetName" 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
ruleSetName
          ]
      )

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

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

-- | /See:/ 'newDescribeMatchmakingConfigurationsResponse' smart constructor.
data DescribeMatchmakingConfigurationsResponse = DescribeMatchmakingConfigurationsResponse'
  { -- | A collection of requested matchmaking configurations.
    DescribeMatchmakingConfigurationsResponse
-> Maybe [MatchmakingConfiguration]
configurations :: Prelude.Maybe [MatchmakingConfiguration],
    -- | 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.
    DescribeMatchmakingConfigurationsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeMatchmakingConfigurationsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeMatchmakingConfigurationsResponse
-> DescribeMatchmakingConfigurationsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeMatchmakingConfigurationsResponse
-> DescribeMatchmakingConfigurationsResponse -> Bool
$c/= :: DescribeMatchmakingConfigurationsResponse
-> DescribeMatchmakingConfigurationsResponse -> Bool
== :: DescribeMatchmakingConfigurationsResponse
-> DescribeMatchmakingConfigurationsResponse -> Bool
$c== :: DescribeMatchmakingConfigurationsResponse
-> DescribeMatchmakingConfigurationsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeMatchmakingConfigurationsResponse]
ReadPrec DescribeMatchmakingConfigurationsResponse
Int -> ReadS DescribeMatchmakingConfigurationsResponse
ReadS [DescribeMatchmakingConfigurationsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeMatchmakingConfigurationsResponse]
$creadListPrec :: ReadPrec [DescribeMatchmakingConfigurationsResponse]
readPrec :: ReadPrec DescribeMatchmakingConfigurationsResponse
$creadPrec :: ReadPrec DescribeMatchmakingConfigurationsResponse
readList :: ReadS [DescribeMatchmakingConfigurationsResponse]
$creadList :: ReadS [DescribeMatchmakingConfigurationsResponse]
readsPrec :: Int -> ReadS DescribeMatchmakingConfigurationsResponse
$creadsPrec :: Int -> ReadS DescribeMatchmakingConfigurationsResponse
Prelude.Read, Int -> DescribeMatchmakingConfigurationsResponse -> ShowS
[DescribeMatchmakingConfigurationsResponse] -> ShowS
DescribeMatchmakingConfigurationsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeMatchmakingConfigurationsResponse] -> ShowS
$cshowList :: [DescribeMatchmakingConfigurationsResponse] -> ShowS
show :: DescribeMatchmakingConfigurationsResponse -> String
$cshow :: DescribeMatchmakingConfigurationsResponse -> String
showsPrec :: Int -> DescribeMatchmakingConfigurationsResponse -> ShowS
$cshowsPrec :: Int -> DescribeMatchmakingConfigurationsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeMatchmakingConfigurationsResponse x
-> DescribeMatchmakingConfigurationsResponse
forall x.
DescribeMatchmakingConfigurationsResponse
-> Rep DescribeMatchmakingConfigurationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeMatchmakingConfigurationsResponse x
-> DescribeMatchmakingConfigurationsResponse
$cfrom :: forall x.
DescribeMatchmakingConfigurationsResponse
-> Rep DescribeMatchmakingConfigurationsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeMatchmakingConfigurationsResponse' 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:
--
-- 'configurations', 'describeMatchmakingConfigurationsResponse_configurations' - A collection of requested matchmaking configurations.
--
-- 'nextToken', 'describeMatchmakingConfigurationsResponse_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', 'describeMatchmakingConfigurationsResponse_httpStatus' - The response's http status code.
newDescribeMatchmakingConfigurationsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeMatchmakingConfigurationsResponse
newDescribeMatchmakingConfigurationsResponse :: Int -> DescribeMatchmakingConfigurationsResponse
newDescribeMatchmakingConfigurationsResponse
  Int
pHttpStatus_ =
    DescribeMatchmakingConfigurationsResponse'
      { $sel:configurations:DescribeMatchmakingConfigurationsResponse' :: Maybe [MatchmakingConfiguration]
configurations =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:DescribeMatchmakingConfigurationsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeMatchmakingConfigurationsResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | A collection of requested matchmaking configurations.
describeMatchmakingConfigurationsResponse_configurations :: Lens.Lens' DescribeMatchmakingConfigurationsResponse (Prelude.Maybe [MatchmakingConfiguration])
describeMatchmakingConfigurationsResponse_configurations :: Lens'
  DescribeMatchmakingConfigurationsResponse
  (Maybe [MatchmakingConfiguration])
describeMatchmakingConfigurationsResponse_configurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMatchmakingConfigurationsResponse' {Maybe [MatchmakingConfiguration]
configurations :: Maybe [MatchmakingConfiguration]
$sel:configurations:DescribeMatchmakingConfigurationsResponse' :: DescribeMatchmakingConfigurationsResponse
-> Maybe [MatchmakingConfiguration]
configurations} -> Maybe [MatchmakingConfiguration]
configurations) (\s :: DescribeMatchmakingConfigurationsResponse
s@DescribeMatchmakingConfigurationsResponse' {} Maybe [MatchmakingConfiguration]
a -> DescribeMatchmakingConfigurationsResponse
s {$sel:configurations:DescribeMatchmakingConfigurationsResponse' :: Maybe [MatchmakingConfiguration]
configurations = Maybe [MatchmakingConfiguration]
a} :: DescribeMatchmakingConfigurationsResponse) 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 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.
describeMatchmakingConfigurationsResponse_nextToken :: Lens.Lens' DescribeMatchmakingConfigurationsResponse (Prelude.Maybe Prelude.Text)
describeMatchmakingConfigurationsResponse_nextToken :: Lens' DescribeMatchmakingConfigurationsResponse (Maybe Text)
describeMatchmakingConfigurationsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMatchmakingConfigurationsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeMatchmakingConfigurationsResponse' :: DescribeMatchmakingConfigurationsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeMatchmakingConfigurationsResponse
s@DescribeMatchmakingConfigurationsResponse' {} Maybe Text
a -> DescribeMatchmakingConfigurationsResponse
s {$sel:nextToken:DescribeMatchmakingConfigurationsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeMatchmakingConfigurationsResponse)

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

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