{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.EC2.Types.VpcPeeringConnection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.EC2.Types.VpcPeeringConnection where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Internal
import Amazonka.EC2.Types.Tag
import Amazonka.EC2.Types.VpcPeeringConnectionStateReason
import Amazonka.EC2.Types.VpcPeeringConnectionVpcInfo
import qualified Amazonka.Prelude as Prelude

-- | Describes a VPC peering connection.
--
-- /See:/ 'newVpcPeeringConnection' smart constructor.
data VpcPeeringConnection = VpcPeeringConnection'
  { -- | Information about the accepter VPC. CIDR block information is only
    -- returned when describing an active VPC peering connection.
    VpcPeeringConnection -> Maybe VpcPeeringConnectionVpcInfo
accepterVpcInfo :: Prelude.Maybe VpcPeeringConnectionVpcInfo,
    -- | The time that an unaccepted VPC peering connection will expire.
    VpcPeeringConnection -> Maybe ISO8601
expirationTime :: Prelude.Maybe Data.ISO8601,
    -- | Information about the requester VPC. CIDR block information is only
    -- returned when describing an active VPC peering connection.
    VpcPeeringConnection -> Maybe VpcPeeringConnectionVpcInfo
requesterVpcInfo :: Prelude.Maybe VpcPeeringConnectionVpcInfo,
    -- | The status of the VPC peering connection.
    VpcPeeringConnection -> Maybe VpcPeeringConnectionStateReason
status :: Prelude.Maybe VpcPeeringConnectionStateReason,
    -- | Any tags assigned to the resource.
    VpcPeeringConnection -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The ID of the VPC peering connection.
    VpcPeeringConnection -> Maybe Text
vpcPeeringConnectionId :: Prelude.Maybe Prelude.Text
  }
  deriving (VpcPeeringConnection -> VpcPeeringConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VpcPeeringConnection -> VpcPeeringConnection -> Bool
$c/= :: VpcPeeringConnection -> VpcPeeringConnection -> Bool
== :: VpcPeeringConnection -> VpcPeeringConnection -> Bool
$c== :: VpcPeeringConnection -> VpcPeeringConnection -> Bool
Prelude.Eq, ReadPrec [VpcPeeringConnection]
ReadPrec VpcPeeringConnection
Int -> ReadS VpcPeeringConnection
ReadS [VpcPeeringConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VpcPeeringConnection]
$creadListPrec :: ReadPrec [VpcPeeringConnection]
readPrec :: ReadPrec VpcPeeringConnection
$creadPrec :: ReadPrec VpcPeeringConnection
readList :: ReadS [VpcPeeringConnection]
$creadList :: ReadS [VpcPeeringConnection]
readsPrec :: Int -> ReadS VpcPeeringConnection
$creadsPrec :: Int -> ReadS VpcPeeringConnection
Prelude.Read, Int -> VpcPeeringConnection -> ShowS
[VpcPeeringConnection] -> ShowS
VpcPeeringConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VpcPeeringConnection] -> ShowS
$cshowList :: [VpcPeeringConnection] -> ShowS
show :: VpcPeeringConnection -> String
$cshow :: VpcPeeringConnection -> String
showsPrec :: Int -> VpcPeeringConnection -> ShowS
$cshowsPrec :: Int -> VpcPeeringConnection -> ShowS
Prelude.Show, forall x. Rep VpcPeeringConnection x -> VpcPeeringConnection
forall x. VpcPeeringConnection -> Rep VpcPeeringConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VpcPeeringConnection x -> VpcPeeringConnection
$cfrom :: forall x. VpcPeeringConnection -> Rep VpcPeeringConnection x
Prelude.Generic)

-- |
-- Create a value of 'VpcPeeringConnection' 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:
--
-- 'accepterVpcInfo', 'vpcPeeringConnection_accepterVpcInfo' - Information about the accepter VPC. CIDR block information is only
-- returned when describing an active VPC peering connection.
--
-- 'expirationTime', 'vpcPeeringConnection_expirationTime' - The time that an unaccepted VPC peering connection will expire.
--
-- 'requesterVpcInfo', 'vpcPeeringConnection_requesterVpcInfo' - Information about the requester VPC. CIDR block information is only
-- returned when describing an active VPC peering connection.
--
-- 'status', 'vpcPeeringConnection_status' - The status of the VPC peering connection.
--
-- 'tags', 'vpcPeeringConnection_tags' - Any tags assigned to the resource.
--
-- 'vpcPeeringConnectionId', 'vpcPeeringConnection_vpcPeeringConnectionId' - The ID of the VPC peering connection.
newVpcPeeringConnection ::
  VpcPeeringConnection
newVpcPeeringConnection :: VpcPeeringConnection
newVpcPeeringConnection =
  VpcPeeringConnection'
    { $sel:accepterVpcInfo:VpcPeeringConnection' :: Maybe VpcPeeringConnectionVpcInfo
accepterVpcInfo =
        forall a. Maybe a
Prelude.Nothing,
      $sel:expirationTime:VpcPeeringConnection' :: Maybe ISO8601
expirationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:requesterVpcInfo:VpcPeeringConnection' :: Maybe VpcPeeringConnectionVpcInfo
requesterVpcInfo = forall a. Maybe a
Prelude.Nothing,
      $sel:status:VpcPeeringConnection' :: Maybe VpcPeeringConnectionStateReason
status = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:VpcPeeringConnection' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcPeeringConnectionId:VpcPeeringConnection' :: Maybe Text
vpcPeeringConnectionId = forall a. Maybe a
Prelude.Nothing
    }

-- | Information about the accepter VPC. CIDR block information is only
-- returned when describing an active VPC peering connection.
vpcPeeringConnection_accepterVpcInfo :: Lens.Lens' VpcPeeringConnection (Prelude.Maybe VpcPeeringConnectionVpcInfo)
vpcPeeringConnection_accepterVpcInfo :: Lens' VpcPeeringConnection (Maybe VpcPeeringConnectionVpcInfo)
vpcPeeringConnection_accepterVpcInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VpcPeeringConnection' {Maybe VpcPeeringConnectionVpcInfo
accepterVpcInfo :: Maybe VpcPeeringConnectionVpcInfo
$sel:accepterVpcInfo:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe VpcPeeringConnectionVpcInfo
accepterVpcInfo} -> Maybe VpcPeeringConnectionVpcInfo
accepterVpcInfo) (\s :: VpcPeeringConnection
s@VpcPeeringConnection' {} Maybe VpcPeeringConnectionVpcInfo
a -> VpcPeeringConnection
s {$sel:accepterVpcInfo:VpcPeeringConnection' :: Maybe VpcPeeringConnectionVpcInfo
accepterVpcInfo = Maybe VpcPeeringConnectionVpcInfo
a} :: VpcPeeringConnection)

-- | The time that an unaccepted VPC peering connection will expire.
vpcPeeringConnection_expirationTime :: Lens.Lens' VpcPeeringConnection (Prelude.Maybe Prelude.UTCTime)
vpcPeeringConnection_expirationTime :: Lens' VpcPeeringConnection (Maybe UTCTime)
vpcPeeringConnection_expirationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VpcPeeringConnection' {Maybe ISO8601
expirationTime :: Maybe ISO8601
$sel:expirationTime:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe ISO8601
expirationTime} -> Maybe ISO8601
expirationTime) (\s :: VpcPeeringConnection
s@VpcPeeringConnection' {} Maybe ISO8601
a -> VpcPeeringConnection
s {$sel:expirationTime:VpcPeeringConnection' :: Maybe ISO8601
expirationTime = Maybe ISO8601
a} :: VpcPeeringConnection) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Information about the requester VPC. CIDR block information is only
-- returned when describing an active VPC peering connection.
vpcPeeringConnection_requesterVpcInfo :: Lens.Lens' VpcPeeringConnection (Prelude.Maybe VpcPeeringConnectionVpcInfo)
vpcPeeringConnection_requesterVpcInfo :: Lens' VpcPeeringConnection (Maybe VpcPeeringConnectionVpcInfo)
vpcPeeringConnection_requesterVpcInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VpcPeeringConnection' {Maybe VpcPeeringConnectionVpcInfo
requesterVpcInfo :: Maybe VpcPeeringConnectionVpcInfo
$sel:requesterVpcInfo:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe VpcPeeringConnectionVpcInfo
requesterVpcInfo} -> Maybe VpcPeeringConnectionVpcInfo
requesterVpcInfo) (\s :: VpcPeeringConnection
s@VpcPeeringConnection' {} Maybe VpcPeeringConnectionVpcInfo
a -> VpcPeeringConnection
s {$sel:requesterVpcInfo:VpcPeeringConnection' :: Maybe VpcPeeringConnectionVpcInfo
requesterVpcInfo = Maybe VpcPeeringConnectionVpcInfo
a} :: VpcPeeringConnection)

-- | The status of the VPC peering connection.
vpcPeeringConnection_status :: Lens.Lens' VpcPeeringConnection (Prelude.Maybe VpcPeeringConnectionStateReason)
vpcPeeringConnection_status :: Lens' VpcPeeringConnection (Maybe VpcPeeringConnectionStateReason)
vpcPeeringConnection_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VpcPeeringConnection' {Maybe VpcPeeringConnectionStateReason
status :: Maybe VpcPeeringConnectionStateReason
$sel:status:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe VpcPeeringConnectionStateReason
status} -> Maybe VpcPeeringConnectionStateReason
status) (\s :: VpcPeeringConnection
s@VpcPeeringConnection' {} Maybe VpcPeeringConnectionStateReason
a -> VpcPeeringConnection
s {$sel:status:VpcPeeringConnection' :: Maybe VpcPeeringConnectionStateReason
status = Maybe VpcPeeringConnectionStateReason
a} :: VpcPeeringConnection)

-- | Any tags assigned to the resource.
vpcPeeringConnection_tags :: Lens.Lens' VpcPeeringConnection (Prelude.Maybe [Tag])
vpcPeeringConnection_tags :: Lens' VpcPeeringConnection (Maybe [Tag])
vpcPeeringConnection_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VpcPeeringConnection' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: VpcPeeringConnection
s@VpcPeeringConnection' {} Maybe [Tag]
a -> VpcPeeringConnection
s {$sel:tags:VpcPeeringConnection' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: VpcPeeringConnection) 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 ID of the VPC peering connection.
vpcPeeringConnection_vpcPeeringConnectionId :: Lens.Lens' VpcPeeringConnection (Prelude.Maybe Prelude.Text)
vpcPeeringConnection_vpcPeeringConnectionId :: Lens' VpcPeeringConnection (Maybe Text)
vpcPeeringConnection_vpcPeeringConnectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VpcPeeringConnection' {Maybe Text
vpcPeeringConnectionId :: Maybe Text
$sel:vpcPeeringConnectionId:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe Text
vpcPeeringConnectionId} -> Maybe Text
vpcPeeringConnectionId) (\s :: VpcPeeringConnection
s@VpcPeeringConnection' {} Maybe Text
a -> VpcPeeringConnection
s {$sel:vpcPeeringConnectionId:VpcPeeringConnection' :: Maybe Text
vpcPeeringConnectionId = Maybe Text
a} :: VpcPeeringConnection)

instance Data.FromXML VpcPeeringConnection where
  parseXML :: [Node] -> Either String VpcPeeringConnection
parseXML [Node]
x =
    Maybe VpcPeeringConnectionVpcInfo
-> Maybe ISO8601
-> Maybe VpcPeeringConnectionVpcInfo
-> Maybe VpcPeeringConnectionStateReason
-> Maybe [Tag]
-> Maybe Text
-> VpcPeeringConnection
VpcPeeringConnection'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"accepterVpcInfo")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"expirationTime")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"requesterVpcInfo")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"status")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"tagSet"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"vpcPeeringConnectionId")

instance Prelude.Hashable VpcPeeringConnection where
  hashWithSalt :: Int -> VpcPeeringConnection -> Int
hashWithSalt Int
_salt VpcPeeringConnection' {Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe VpcPeeringConnectionStateReason
Maybe VpcPeeringConnectionVpcInfo
vpcPeeringConnectionId :: Maybe Text
tags :: Maybe [Tag]
status :: Maybe VpcPeeringConnectionStateReason
requesterVpcInfo :: Maybe VpcPeeringConnectionVpcInfo
expirationTime :: Maybe ISO8601
accepterVpcInfo :: Maybe VpcPeeringConnectionVpcInfo
$sel:vpcPeeringConnectionId:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe Text
$sel:tags:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe [Tag]
$sel:status:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe VpcPeeringConnectionStateReason
$sel:requesterVpcInfo:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe VpcPeeringConnectionVpcInfo
$sel:expirationTime:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe ISO8601
$sel:accepterVpcInfo:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe VpcPeeringConnectionVpcInfo
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcPeeringConnectionVpcInfo
accepterVpcInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
expirationTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcPeeringConnectionVpcInfo
requesterVpcInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcPeeringConnectionStateReason
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vpcPeeringConnectionId

instance Prelude.NFData VpcPeeringConnection where
  rnf :: VpcPeeringConnection -> ()
rnf VpcPeeringConnection' {Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe VpcPeeringConnectionStateReason
Maybe VpcPeeringConnectionVpcInfo
vpcPeeringConnectionId :: Maybe Text
tags :: Maybe [Tag]
status :: Maybe VpcPeeringConnectionStateReason
requesterVpcInfo :: Maybe VpcPeeringConnectionVpcInfo
expirationTime :: Maybe ISO8601
accepterVpcInfo :: Maybe VpcPeeringConnectionVpcInfo
$sel:vpcPeeringConnectionId:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe Text
$sel:tags:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe [Tag]
$sel:status:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe VpcPeeringConnectionStateReason
$sel:requesterVpcInfo:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe VpcPeeringConnectionVpcInfo
$sel:expirationTime:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe ISO8601
$sel:accepterVpcInfo:VpcPeeringConnection' :: VpcPeeringConnection -> Maybe VpcPeeringConnectionVpcInfo
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcPeeringConnectionVpcInfo
accepterVpcInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
expirationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcPeeringConnectionVpcInfo
requesterVpcInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcPeeringConnectionStateReason
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vpcPeeringConnectionId