{-# 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.DescribeVpcPeeringConnections
-- 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 information on VPC peering connections. Use this operation to
-- get peering information for all fleets or for one specific fleet ID.
--
-- To retrieve connection information, call this operation from the Amazon
-- Web Services account that is used to manage the Amazon GameLift fleets.
-- Specify a fleet ID or leave the parameter empty to retrieve all
-- connection records. If successful, the retrieved information includes
-- both active and pending connections. Active connections identify the
-- IpV4 CIDR block that the VPC uses to connect.
--
-- __Related actions__
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/reference-awssdk.html#reference-awssdk-resources-fleets All APIs by task>
module Amazonka.GameLift.DescribeVpcPeeringConnections
  ( -- * Creating a Request
    DescribeVpcPeeringConnections (..),
    newDescribeVpcPeeringConnections,

    -- * Request Lenses
    describeVpcPeeringConnections_fleetId,

    -- * Destructuring the Response
    DescribeVpcPeeringConnectionsResponse (..),
    newDescribeVpcPeeringConnectionsResponse,

    -- * Response Lenses
    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

-- | /See:/ 'newDescribeVpcPeeringConnections' smart constructor.
data DescribeVpcPeeringConnections = DescribeVpcPeeringConnections'
  { -- | A unique identifier for the fleet. You can use either the fleet ID or
    -- ARN value.
    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)

-- |
-- Create a value of 'DescribeVpcPeeringConnections' 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:
--
-- 'fleetId', 'describeVpcPeeringConnections_fleetId' - A unique identifier for the fleet. You can use either the fleet ID or
-- ARN value.
newDescribeVpcPeeringConnections ::
  DescribeVpcPeeringConnections
newDescribeVpcPeeringConnections :: DescribeVpcPeeringConnections
newDescribeVpcPeeringConnections =
  DescribeVpcPeeringConnections'
    { $sel:fleetId:DescribeVpcPeeringConnections' :: Maybe Text
fleetId =
        forall a. Maybe a
Prelude.Nothing
    }

-- | A unique identifier for the fleet. You can use either the fleet ID or
-- ARN value.
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

-- | /See:/ 'newDescribeVpcPeeringConnectionsResponse' smart constructor.
data DescribeVpcPeeringConnectionsResponse = DescribeVpcPeeringConnectionsResponse'
  { -- | A collection of VPC peering connection records that match the request.
    DescribeVpcPeeringConnectionsResponse
-> Maybe [VpcPeeringConnection]
vpcPeeringConnections :: Prelude.Maybe [VpcPeeringConnection],
    -- | The response's http status code.
    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)

-- |
-- Create a value of 'DescribeVpcPeeringConnectionsResponse' 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:
--
-- 'vpcPeeringConnections', 'describeVpcPeeringConnectionsResponse_vpcPeeringConnections' - A collection of VPC peering connection records that match the request.
--
-- 'httpStatus', 'describeVpcPeeringConnectionsResponse_httpStatus' - The response's http status code.
newDescribeVpcPeeringConnectionsResponse ::
  -- | 'httpStatus'
  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_
    }

-- | A collection of VPC peering connection records that match the request.
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

-- | The response's http status code.
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