{-# 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.DescribeVpcPeeringConnections
(
DescribeVpcPeeringConnections (..),
newDescribeVpcPeeringConnections,
describeVpcPeeringConnections_fleetId,
DescribeVpcPeeringConnectionsResponse (..),
newDescribeVpcPeeringConnectionsResponse,
describeVpcPeeringConnectionsResponse_vpcPeeringConnections,
describeVpcPeeringConnectionsResponse_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
data DescribeVpcPeeringConnections = DescribeVpcPeeringConnections'
{
DescribeVpcPeeringConnections -> Maybe Text
fleetId :: Prelude.Maybe Prelude.Text
}
deriving (DescribeVpcPeeringConnections
-> DescribeVpcPeeringConnections -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeVpcPeeringConnections
-> DescribeVpcPeeringConnections -> Bool
$c/= :: DescribeVpcPeeringConnections
-> DescribeVpcPeeringConnections -> Bool
== :: DescribeVpcPeeringConnections
-> DescribeVpcPeeringConnections -> Bool
$c== :: DescribeVpcPeeringConnections
-> DescribeVpcPeeringConnections -> Bool
Prelude.Eq, ReadPrec [DescribeVpcPeeringConnections]
ReadPrec DescribeVpcPeeringConnections
Int -> ReadS DescribeVpcPeeringConnections
ReadS [DescribeVpcPeeringConnections]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeVpcPeeringConnections]
$creadListPrec :: ReadPrec [DescribeVpcPeeringConnections]
readPrec :: ReadPrec DescribeVpcPeeringConnections
$creadPrec :: ReadPrec DescribeVpcPeeringConnections
readList :: ReadS [DescribeVpcPeeringConnections]
$creadList :: ReadS [DescribeVpcPeeringConnections]
readsPrec :: Int -> ReadS DescribeVpcPeeringConnections
$creadsPrec :: Int -> ReadS DescribeVpcPeeringConnections
Prelude.Read, Int -> DescribeVpcPeeringConnections -> ShowS
[DescribeVpcPeeringConnections] -> ShowS
DescribeVpcPeeringConnections -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeVpcPeeringConnections] -> ShowS
$cshowList :: [DescribeVpcPeeringConnections] -> ShowS
show :: DescribeVpcPeeringConnections -> String
$cshow :: DescribeVpcPeeringConnections -> String
showsPrec :: Int -> DescribeVpcPeeringConnections -> ShowS
$cshowsPrec :: Int -> DescribeVpcPeeringConnections -> ShowS
Prelude.Show, forall x.
Rep DescribeVpcPeeringConnections x
-> DescribeVpcPeeringConnections
forall x.
DescribeVpcPeeringConnections
-> Rep DescribeVpcPeeringConnections x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeVpcPeeringConnections x
-> DescribeVpcPeeringConnections
$cfrom :: forall x.
DescribeVpcPeeringConnections
-> Rep DescribeVpcPeeringConnections x
Prelude.Generic)
newDescribeVpcPeeringConnections ::
DescribeVpcPeeringConnections
newDescribeVpcPeeringConnections :: DescribeVpcPeeringConnections
newDescribeVpcPeeringConnections =
DescribeVpcPeeringConnections'
{ $sel:fleetId:DescribeVpcPeeringConnections' :: Maybe Text
fleetId =
forall a. Maybe a
Prelude.Nothing
}
describeVpcPeeringConnections_fleetId :: Lens.Lens' DescribeVpcPeeringConnections (Prelude.Maybe Prelude.Text)
describeVpcPeeringConnections_fleetId :: Lens' DescribeVpcPeeringConnections (Maybe Text)
describeVpcPeeringConnections_fleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVpcPeeringConnections' {Maybe Text
fleetId :: Maybe Text
$sel:fleetId:DescribeVpcPeeringConnections' :: DescribeVpcPeeringConnections -> Maybe Text
fleetId} -> Maybe Text
fleetId) (\s :: DescribeVpcPeeringConnections
s@DescribeVpcPeeringConnections' {} Maybe Text
a -> DescribeVpcPeeringConnections
s {$sel:fleetId:DescribeVpcPeeringConnections' :: Maybe Text
fleetId = Maybe Text
a} :: DescribeVpcPeeringConnections)
instance
Core.AWSRequest
DescribeVpcPeeringConnections
where
type
AWSResponse DescribeVpcPeeringConnections =
DescribeVpcPeeringConnectionsResponse
request :: (Service -> Service)
-> DescribeVpcPeeringConnections
-> Request DescribeVpcPeeringConnections
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 DescribeVpcPeeringConnections
-> ClientResponse ClientBody
-> m (Either
Error (ClientResponse (AWSResponse DescribeVpcPeeringConnections)))
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 [VpcPeeringConnection]
-> Int -> DescribeVpcPeeringConnectionsResponse
DescribeVpcPeeringConnectionsResponse'
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
"VpcPeeringConnections"
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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
)
instance
Prelude.Hashable
DescribeVpcPeeringConnections
where
hashWithSalt :: Int -> DescribeVpcPeeringConnections -> Int
hashWithSalt Int
_salt DescribeVpcPeeringConnections' {Maybe Text
fleetId :: Maybe Text
$sel:fleetId:DescribeVpcPeeringConnections' :: DescribeVpcPeeringConnections -> Maybe Text
..} =
Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
fleetId
instance Prelude.NFData DescribeVpcPeeringConnections where
rnf :: DescribeVpcPeeringConnections -> ()
rnf DescribeVpcPeeringConnections' {Maybe Text
fleetId :: Maybe Text
$sel:fleetId:DescribeVpcPeeringConnections' :: DescribeVpcPeeringConnections -> Maybe Text
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
fleetId
instance Data.ToHeaders DescribeVpcPeeringConnections where
toHeaders :: DescribeVpcPeeringConnections -> 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.DescribeVpcPeeringConnections" ::
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 DescribeVpcPeeringConnections where
toJSON :: DescribeVpcPeeringConnections -> Value
toJSON DescribeVpcPeeringConnections' {Maybe Text
fleetId :: Maybe Text
$sel:fleetId:DescribeVpcPeeringConnections' :: DescribeVpcPeeringConnections -> Maybe Text
..} =
[Pair] -> Value
Data.object
( forall a. [Maybe a] -> [a]
Prelude.catMaybes
[(Key
"FleetId" 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
fleetId]
)
instance Data.ToPath DescribeVpcPeeringConnections where
toPath :: DescribeVpcPeeringConnections -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"
instance Data.ToQuery DescribeVpcPeeringConnections where
toQuery :: DescribeVpcPeeringConnections -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty
data DescribeVpcPeeringConnectionsResponse = DescribeVpcPeeringConnectionsResponse'
{
DescribeVpcPeeringConnectionsResponse
-> Maybe [VpcPeeringConnection]
vpcPeeringConnections :: Prelude.Maybe [VpcPeeringConnection],
DescribeVpcPeeringConnectionsResponse -> Int
httpStatus :: Prelude.Int
}
deriving (DescribeVpcPeeringConnectionsResponse
-> DescribeVpcPeeringConnectionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeVpcPeeringConnectionsResponse
-> DescribeVpcPeeringConnectionsResponse -> Bool
$c/= :: DescribeVpcPeeringConnectionsResponse
-> DescribeVpcPeeringConnectionsResponse -> Bool
== :: DescribeVpcPeeringConnectionsResponse
-> DescribeVpcPeeringConnectionsResponse -> Bool
$c== :: DescribeVpcPeeringConnectionsResponse
-> DescribeVpcPeeringConnectionsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeVpcPeeringConnectionsResponse]
ReadPrec DescribeVpcPeeringConnectionsResponse
Int -> ReadS DescribeVpcPeeringConnectionsResponse
ReadS [DescribeVpcPeeringConnectionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeVpcPeeringConnectionsResponse]
$creadListPrec :: ReadPrec [DescribeVpcPeeringConnectionsResponse]
readPrec :: ReadPrec DescribeVpcPeeringConnectionsResponse
$creadPrec :: ReadPrec DescribeVpcPeeringConnectionsResponse
readList :: ReadS [DescribeVpcPeeringConnectionsResponse]
$creadList :: ReadS [DescribeVpcPeeringConnectionsResponse]
readsPrec :: Int -> ReadS DescribeVpcPeeringConnectionsResponse
$creadsPrec :: Int -> ReadS DescribeVpcPeeringConnectionsResponse
Prelude.Read, Int -> DescribeVpcPeeringConnectionsResponse -> ShowS
[DescribeVpcPeeringConnectionsResponse] -> ShowS
DescribeVpcPeeringConnectionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeVpcPeeringConnectionsResponse] -> ShowS
$cshowList :: [DescribeVpcPeeringConnectionsResponse] -> ShowS
show :: DescribeVpcPeeringConnectionsResponse -> String
$cshow :: DescribeVpcPeeringConnectionsResponse -> String
showsPrec :: Int -> DescribeVpcPeeringConnectionsResponse -> ShowS
$cshowsPrec :: Int -> DescribeVpcPeeringConnectionsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeVpcPeeringConnectionsResponse x
-> DescribeVpcPeeringConnectionsResponse
forall x.
DescribeVpcPeeringConnectionsResponse
-> Rep DescribeVpcPeeringConnectionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeVpcPeeringConnectionsResponse x
-> DescribeVpcPeeringConnectionsResponse
$cfrom :: forall x.
DescribeVpcPeeringConnectionsResponse
-> Rep DescribeVpcPeeringConnectionsResponse x
Prelude.Generic)
newDescribeVpcPeeringConnectionsResponse ::
Prelude.Int ->
DescribeVpcPeeringConnectionsResponse
newDescribeVpcPeeringConnectionsResponse :: Int -> DescribeVpcPeeringConnectionsResponse
newDescribeVpcPeeringConnectionsResponse Int
pHttpStatus_ =
DescribeVpcPeeringConnectionsResponse'
{ $sel:vpcPeeringConnections:DescribeVpcPeeringConnectionsResponse' :: Maybe [VpcPeeringConnection]
vpcPeeringConnections =
forall a. Maybe a
Prelude.Nothing,
$sel:httpStatus:DescribeVpcPeeringConnectionsResponse' :: Int
httpStatus = Int
pHttpStatus_
}
describeVpcPeeringConnectionsResponse_vpcPeeringConnections :: Lens.Lens' DescribeVpcPeeringConnectionsResponse (Prelude.Maybe [VpcPeeringConnection])
describeVpcPeeringConnectionsResponse_vpcPeeringConnections :: Lens'
DescribeVpcPeeringConnectionsResponse
(Maybe [VpcPeeringConnection])
describeVpcPeeringConnectionsResponse_vpcPeeringConnections = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVpcPeeringConnectionsResponse' {Maybe [VpcPeeringConnection]
vpcPeeringConnections :: Maybe [VpcPeeringConnection]
$sel:vpcPeeringConnections:DescribeVpcPeeringConnectionsResponse' :: DescribeVpcPeeringConnectionsResponse
-> Maybe [VpcPeeringConnection]
vpcPeeringConnections} -> Maybe [VpcPeeringConnection]
vpcPeeringConnections) (\s :: DescribeVpcPeeringConnectionsResponse
s@DescribeVpcPeeringConnectionsResponse' {} Maybe [VpcPeeringConnection]
a -> DescribeVpcPeeringConnectionsResponse
s {$sel:vpcPeeringConnections:DescribeVpcPeeringConnectionsResponse' :: Maybe [VpcPeeringConnection]
vpcPeeringConnections = Maybe [VpcPeeringConnection]
a} :: DescribeVpcPeeringConnectionsResponse) 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
describeVpcPeeringConnectionsResponse_httpStatus :: Lens.Lens' DescribeVpcPeeringConnectionsResponse Prelude.Int
describeVpcPeeringConnectionsResponse_httpStatus :: Lens' DescribeVpcPeeringConnectionsResponse Int
describeVpcPeeringConnectionsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVpcPeeringConnectionsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeVpcPeeringConnectionsResponse' :: DescribeVpcPeeringConnectionsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeVpcPeeringConnectionsResponse
s@DescribeVpcPeeringConnectionsResponse' {} Int
a -> DescribeVpcPeeringConnectionsResponse
s {$sel:httpStatus:DescribeVpcPeeringConnectionsResponse' :: Int
httpStatus = Int
a} :: DescribeVpcPeeringConnectionsResponse)
instance
Prelude.NFData
DescribeVpcPeeringConnectionsResponse
where
rnf :: DescribeVpcPeeringConnectionsResponse -> ()
rnf DescribeVpcPeeringConnectionsResponse' {Int
Maybe [VpcPeeringConnection]
httpStatus :: Int
vpcPeeringConnections :: Maybe [VpcPeeringConnection]
$sel:httpStatus:DescribeVpcPeeringConnectionsResponse' :: DescribeVpcPeeringConnectionsResponse -> Int
$sel:vpcPeeringConnections:DescribeVpcPeeringConnectionsResponse' :: DescribeVpcPeeringConnectionsResponse
-> Maybe [VpcPeeringConnection]
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe [VpcPeeringConnection]
vpcPeeringConnections
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus