{-# 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.APIGateway.GetRestApis
(
GetRestApis (..),
newGetRestApis,
getRestApis_limit,
getRestApis_position,
GetRestApisResponse (..),
newGetRestApisResponse,
getRestApisResponse_items,
getRestApisResponse_position,
getRestApisResponse_httpStatus,
)
where
import Amazonka.APIGateway.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
data GetRestApis = GetRestApis'
{
GetRestApis -> Maybe Int
limit :: Prelude.Maybe Prelude.Int,
GetRestApis -> Maybe Text
position :: Prelude.Maybe Prelude.Text
}
deriving (GetRestApis -> GetRestApis -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRestApis -> GetRestApis -> Bool
$c/= :: GetRestApis -> GetRestApis -> Bool
== :: GetRestApis -> GetRestApis -> Bool
$c== :: GetRestApis -> GetRestApis -> Bool
Prelude.Eq, ReadPrec [GetRestApis]
ReadPrec GetRestApis
Int -> ReadS GetRestApis
ReadS [GetRestApis]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRestApis]
$creadListPrec :: ReadPrec [GetRestApis]
readPrec :: ReadPrec GetRestApis
$creadPrec :: ReadPrec GetRestApis
readList :: ReadS [GetRestApis]
$creadList :: ReadS [GetRestApis]
readsPrec :: Int -> ReadS GetRestApis
$creadsPrec :: Int -> ReadS GetRestApis
Prelude.Read, Int -> GetRestApis -> ShowS
[GetRestApis] -> ShowS
GetRestApis -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRestApis] -> ShowS
$cshowList :: [GetRestApis] -> ShowS
show :: GetRestApis -> String
$cshow :: GetRestApis -> String
showsPrec :: Int -> GetRestApis -> ShowS
$cshowsPrec :: Int -> GetRestApis -> ShowS
Prelude.Show, forall x. Rep GetRestApis x -> GetRestApis
forall x. GetRestApis -> Rep GetRestApis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetRestApis x -> GetRestApis
$cfrom :: forall x. GetRestApis -> Rep GetRestApis x
Prelude.Generic)
newGetRestApis ::
GetRestApis
newGetRestApis :: GetRestApis
newGetRestApis =
GetRestApis'
{ $sel:limit:GetRestApis' :: Maybe Int
limit = forall a. Maybe a
Prelude.Nothing,
$sel:position:GetRestApis' :: Maybe Text
position = forall a. Maybe a
Prelude.Nothing
}
getRestApis_limit :: Lens.Lens' GetRestApis (Prelude.Maybe Prelude.Int)
getRestApis_limit :: Lens' GetRestApis (Maybe Int)
getRestApis_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRestApis' {Maybe Int
limit :: Maybe Int
$sel:limit:GetRestApis' :: GetRestApis -> Maybe Int
limit} -> Maybe Int
limit) (\s :: GetRestApis
s@GetRestApis' {} Maybe Int
a -> GetRestApis
s {$sel:limit:GetRestApis' :: Maybe Int
limit = Maybe Int
a} :: GetRestApis)
getRestApis_position :: Lens.Lens' GetRestApis (Prelude.Maybe Prelude.Text)
getRestApis_position :: Lens' GetRestApis (Maybe Text)
getRestApis_position = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRestApis' {Maybe Text
position :: Maybe Text
$sel:position:GetRestApis' :: GetRestApis -> Maybe Text
position} -> Maybe Text
position) (\s :: GetRestApis
s@GetRestApis' {} Maybe Text
a -> GetRestApis
s {$sel:position:GetRestApis' :: Maybe Text
position = Maybe Text
a} :: GetRestApis)
instance Core.AWSPager GetRestApis where
page :: GetRestApis -> AWSResponse GetRestApis -> Maybe GetRestApis
page GetRestApis
rq AWSResponse GetRestApis
rs
| forall a. AWSTruncated a => a -> Bool
Core.stop
( AWSResponse GetRestApis
rs
forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetRestApisResponse (Maybe Text)
getRestApisResponse_position
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 GetRestApis
rs
forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetRestApisResponse (Maybe [RestApi])
getRestApisResponse_items
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.$ GetRestApis
rq
forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetRestApis (Maybe Text)
getRestApis_position
forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetRestApis
rs
forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetRestApisResponse (Maybe Text)
getRestApisResponse_position
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 GetRestApis where
type AWSResponse GetRestApis = GetRestApisResponse
request :: (Service -> Service) -> GetRestApis -> Request GetRestApis
request Service -> Service
overrides =
forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetRestApis
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetRestApis)))
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 [RestApi] -> Maybe Text -> Int -> GetRestApisResponse
GetRestApisResponse'
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
"item" 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
"position")
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 GetRestApis where
hashWithSalt :: Int -> GetRestApis -> Int
hashWithSalt Int
_salt GetRestApis' {Maybe Int
Maybe Text
position :: Maybe Text
limit :: Maybe Int
$sel:position:GetRestApis' :: GetRestApis -> Maybe Text
$sel:limit:GetRestApis' :: GetRestApis -> Maybe Int
..} =
Int
_salt
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
limit
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
position
instance Prelude.NFData GetRestApis where
rnf :: GetRestApis -> ()
rnf GetRestApis' {Maybe Int
Maybe Text
position :: Maybe Text
limit :: Maybe Int
$sel:position:GetRestApis' :: GetRestApis -> Maybe Text
$sel:limit:GetRestApis' :: GetRestApis -> Maybe Int
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
limit
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
position
instance Data.ToHeaders GetRestApis where
toHeaders :: GetRestApis -> ResponseHeaders
toHeaders =
forall a b. a -> b -> a
Prelude.const
( forall a. Monoid a => [a] -> a
Prelude.mconcat
[ HeaderName
"Accept"
forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/json" :: Prelude.ByteString)
]
)
instance Data.ToPath GetRestApis where
toPath :: GetRestApis -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/restapis"
instance Data.ToQuery GetRestApis where
toQuery :: GetRestApis -> QueryString
toQuery GetRestApis' {Maybe Int
Maybe Text
position :: Maybe Text
limit :: Maybe Int
$sel:position:GetRestApis' :: GetRestApis -> Maybe Text
$sel:limit:GetRestApis' :: GetRestApis -> Maybe Int
..} =
forall a. Monoid a => [a] -> a
Prelude.mconcat
[ByteString
"limit" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
limit, ByteString
"position" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
position]
data GetRestApisResponse = GetRestApisResponse'
{
GetRestApisResponse -> Maybe [RestApi]
items :: Prelude.Maybe [RestApi],
GetRestApisResponse -> Maybe Text
position :: Prelude.Maybe Prelude.Text,
GetRestApisResponse -> Int
httpStatus :: Prelude.Int
}
deriving (GetRestApisResponse -> GetRestApisResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRestApisResponse -> GetRestApisResponse -> Bool
$c/= :: GetRestApisResponse -> GetRestApisResponse -> Bool
== :: GetRestApisResponse -> GetRestApisResponse -> Bool
$c== :: GetRestApisResponse -> GetRestApisResponse -> Bool
Prelude.Eq, ReadPrec [GetRestApisResponse]
ReadPrec GetRestApisResponse
Int -> ReadS GetRestApisResponse
ReadS [GetRestApisResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRestApisResponse]
$creadListPrec :: ReadPrec [GetRestApisResponse]
readPrec :: ReadPrec GetRestApisResponse
$creadPrec :: ReadPrec GetRestApisResponse
readList :: ReadS [GetRestApisResponse]
$creadList :: ReadS [GetRestApisResponse]
readsPrec :: Int -> ReadS GetRestApisResponse
$creadsPrec :: Int -> ReadS GetRestApisResponse
Prelude.Read, Int -> GetRestApisResponse -> ShowS
[GetRestApisResponse] -> ShowS
GetRestApisResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRestApisResponse] -> ShowS
$cshowList :: [GetRestApisResponse] -> ShowS
show :: GetRestApisResponse -> String
$cshow :: GetRestApisResponse -> String
showsPrec :: Int -> GetRestApisResponse -> ShowS
$cshowsPrec :: Int -> GetRestApisResponse -> ShowS
Prelude.Show, forall x. Rep GetRestApisResponse x -> GetRestApisResponse
forall x. GetRestApisResponse -> Rep GetRestApisResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetRestApisResponse x -> GetRestApisResponse
$cfrom :: forall x. GetRestApisResponse -> Rep GetRestApisResponse x
Prelude.Generic)
newGetRestApisResponse ::
Prelude.Int ->
GetRestApisResponse
newGetRestApisResponse :: Int -> GetRestApisResponse
newGetRestApisResponse Int
pHttpStatus_ =
GetRestApisResponse'
{ $sel:items:GetRestApisResponse' :: Maybe [RestApi]
items = forall a. Maybe a
Prelude.Nothing,
$sel:position:GetRestApisResponse' :: Maybe Text
position = forall a. Maybe a
Prelude.Nothing,
$sel:httpStatus:GetRestApisResponse' :: Int
httpStatus = Int
pHttpStatus_
}
getRestApisResponse_items :: Lens.Lens' GetRestApisResponse (Prelude.Maybe [RestApi])
getRestApisResponse_items :: Lens' GetRestApisResponse (Maybe [RestApi])
getRestApisResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRestApisResponse' {Maybe [RestApi]
items :: Maybe [RestApi]
$sel:items:GetRestApisResponse' :: GetRestApisResponse -> Maybe [RestApi]
items} -> Maybe [RestApi]
items) (\s :: GetRestApisResponse
s@GetRestApisResponse' {} Maybe [RestApi]
a -> GetRestApisResponse
s {$sel:items:GetRestApisResponse' :: Maybe [RestApi]
items = Maybe [RestApi]
a} :: GetRestApisResponse) 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
getRestApisResponse_position :: Lens.Lens' GetRestApisResponse (Prelude.Maybe Prelude.Text)
getRestApisResponse_position :: Lens' GetRestApisResponse (Maybe Text)
getRestApisResponse_position = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRestApisResponse' {Maybe Text
position :: Maybe Text
$sel:position:GetRestApisResponse' :: GetRestApisResponse -> Maybe Text
position} -> Maybe Text
position) (\s :: GetRestApisResponse
s@GetRestApisResponse' {} Maybe Text
a -> GetRestApisResponse
s {$sel:position:GetRestApisResponse' :: Maybe Text
position = Maybe Text
a} :: GetRestApisResponse)
getRestApisResponse_httpStatus :: Lens.Lens' GetRestApisResponse Prelude.Int
getRestApisResponse_httpStatus :: Lens' GetRestApisResponse Int
getRestApisResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRestApisResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetRestApisResponse' :: GetRestApisResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetRestApisResponse
s@GetRestApisResponse' {} Int
a -> GetRestApisResponse
s {$sel:httpStatus:GetRestApisResponse' :: Int
httpStatus = Int
a} :: GetRestApisResponse)
instance Prelude.NFData GetRestApisResponse where
rnf :: GetRestApisResponse -> ()
rnf GetRestApisResponse' {Int
Maybe [RestApi]
Maybe Text
httpStatus :: Int
position :: Maybe Text
items :: Maybe [RestApi]
$sel:httpStatus:GetRestApisResponse' :: GetRestApisResponse -> Int
$sel:position:GetRestApisResponse' :: GetRestApisResponse -> Maybe Text
$sel:items:GetRestApisResponse' :: GetRestApisResponse -> Maybe [RestApi]
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe [RestApi]
items
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
position
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus