{-# 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 #-}
module Amazonka.GameLift.DescribeMatchmakingRuleSets
(
DescribeMatchmakingRuleSets (..),
newDescribeMatchmakingRuleSets,
describeMatchmakingRuleSets_limit,
describeMatchmakingRuleSets_names,
describeMatchmakingRuleSets_nextToken,
DescribeMatchmakingRuleSetsResponse (..),
newDescribeMatchmakingRuleSetsResponse,
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
data DescribeMatchmakingRuleSets = DescribeMatchmakingRuleSets'
{
DescribeMatchmakingRuleSets -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
DescribeMatchmakingRuleSets -> Maybe (NonEmpty Text)
names :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
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)
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
}
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)
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
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
data DescribeMatchmakingRuleSetsResponse = DescribeMatchmakingRuleSetsResponse'
{
DescribeMatchmakingRuleSetsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
DescribeMatchmakingRuleSetsResponse -> Int
httpStatus :: Prelude.Int,
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)
newDescribeMatchmakingRuleSetsResponse ::
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
}
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)
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)
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