{-# 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.CarrierGateway
-- 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.CarrierGateway 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.CarrierGatewayState
import Amazonka.EC2.Types.Tag
import qualified Amazonka.Prelude as Prelude

-- | Describes a carrier gateway.
--
-- /See:/ 'newCarrierGateway' smart constructor.
data CarrierGateway = CarrierGateway'
  { -- | The ID of the carrier gateway.
    CarrierGateway -> Maybe Text
carrierGatewayId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services account ID of the owner of the carrier gateway.
    CarrierGateway -> Maybe Text
ownerId :: Prelude.Maybe Prelude.Text,
    -- | The state of the carrier gateway.
    CarrierGateway -> Maybe CarrierGatewayState
state :: Prelude.Maybe CarrierGatewayState,
    -- | The tags assigned to the carrier gateway.
    CarrierGateway -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The ID of the VPC associated with the carrier gateway.
    CarrierGateway -> Maybe Text
vpcId :: Prelude.Maybe Prelude.Text
  }
  deriving (CarrierGateway -> CarrierGateway -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CarrierGateway -> CarrierGateway -> Bool
$c/= :: CarrierGateway -> CarrierGateway -> Bool
== :: CarrierGateway -> CarrierGateway -> Bool
$c== :: CarrierGateway -> CarrierGateway -> Bool
Prelude.Eq, ReadPrec [CarrierGateway]
ReadPrec CarrierGateway
Int -> ReadS CarrierGateway
ReadS [CarrierGateway]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CarrierGateway]
$creadListPrec :: ReadPrec [CarrierGateway]
readPrec :: ReadPrec CarrierGateway
$creadPrec :: ReadPrec CarrierGateway
readList :: ReadS [CarrierGateway]
$creadList :: ReadS [CarrierGateway]
readsPrec :: Int -> ReadS CarrierGateway
$creadsPrec :: Int -> ReadS CarrierGateway
Prelude.Read, Int -> CarrierGateway -> ShowS
[CarrierGateway] -> ShowS
CarrierGateway -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CarrierGateway] -> ShowS
$cshowList :: [CarrierGateway] -> ShowS
show :: CarrierGateway -> String
$cshow :: CarrierGateway -> String
showsPrec :: Int -> CarrierGateway -> ShowS
$cshowsPrec :: Int -> CarrierGateway -> ShowS
Prelude.Show, forall x. Rep CarrierGateway x -> CarrierGateway
forall x. CarrierGateway -> Rep CarrierGateway x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CarrierGateway x -> CarrierGateway
$cfrom :: forall x. CarrierGateway -> Rep CarrierGateway x
Prelude.Generic)

-- |
-- Create a value of 'CarrierGateway' 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:
--
-- 'carrierGatewayId', 'carrierGateway_carrierGatewayId' - The ID of the carrier gateway.
--
-- 'ownerId', 'carrierGateway_ownerId' - The Amazon Web Services account ID of the owner of the carrier gateway.
--
-- 'state', 'carrierGateway_state' - The state of the carrier gateway.
--
-- 'tags', 'carrierGateway_tags' - The tags assigned to the carrier gateway.
--
-- 'vpcId', 'carrierGateway_vpcId' - The ID of the VPC associated with the carrier gateway.
newCarrierGateway ::
  CarrierGateway
newCarrierGateway :: CarrierGateway
newCarrierGateway =
  CarrierGateway'
    { $sel:carrierGatewayId:CarrierGateway' :: Maybe Text
carrierGatewayId = forall a. Maybe a
Prelude.Nothing,
      $sel:ownerId:CarrierGateway' :: Maybe Text
ownerId = forall a. Maybe a
Prelude.Nothing,
      $sel:state:CarrierGateway' :: Maybe CarrierGatewayState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CarrierGateway' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcId:CarrierGateway' :: Maybe Text
vpcId = forall a. Maybe a
Prelude.Nothing
    }

-- | The ID of the carrier gateway.
carrierGateway_carrierGatewayId :: Lens.Lens' CarrierGateway (Prelude.Maybe Prelude.Text)
carrierGateway_carrierGatewayId :: Lens' CarrierGateway (Maybe Text)
carrierGateway_carrierGatewayId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CarrierGateway' {Maybe Text
carrierGatewayId :: Maybe Text
$sel:carrierGatewayId:CarrierGateway' :: CarrierGateway -> Maybe Text
carrierGatewayId} -> Maybe Text
carrierGatewayId) (\s :: CarrierGateway
s@CarrierGateway' {} Maybe Text
a -> CarrierGateway
s {$sel:carrierGatewayId:CarrierGateway' :: Maybe Text
carrierGatewayId = Maybe Text
a} :: CarrierGateway)

-- | The Amazon Web Services account ID of the owner of the carrier gateway.
carrierGateway_ownerId :: Lens.Lens' CarrierGateway (Prelude.Maybe Prelude.Text)
carrierGateway_ownerId :: Lens' CarrierGateway (Maybe Text)
carrierGateway_ownerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CarrierGateway' {Maybe Text
ownerId :: Maybe Text
$sel:ownerId:CarrierGateway' :: CarrierGateway -> Maybe Text
ownerId} -> Maybe Text
ownerId) (\s :: CarrierGateway
s@CarrierGateway' {} Maybe Text
a -> CarrierGateway
s {$sel:ownerId:CarrierGateway' :: Maybe Text
ownerId = Maybe Text
a} :: CarrierGateway)

-- | The state of the carrier gateway.
carrierGateway_state :: Lens.Lens' CarrierGateway (Prelude.Maybe CarrierGatewayState)
carrierGateway_state :: Lens' CarrierGateway (Maybe CarrierGatewayState)
carrierGateway_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CarrierGateway' {Maybe CarrierGatewayState
state :: Maybe CarrierGatewayState
$sel:state:CarrierGateway' :: CarrierGateway -> Maybe CarrierGatewayState
state} -> Maybe CarrierGatewayState
state) (\s :: CarrierGateway
s@CarrierGateway' {} Maybe CarrierGatewayState
a -> CarrierGateway
s {$sel:state:CarrierGateway' :: Maybe CarrierGatewayState
state = Maybe CarrierGatewayState
a} :: CarrierGateway)

-- | The tags assigned to the carrier gateway.
carrierGateway_tags :: Lens.Lens' CarrierGateway (Prelude.Maybe [Tag])
carrierGateway_tags :: Lens' CarrierGateway (Maybe [Tag])
carrierGateway_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CarrierGateway' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CarrierGateway' :: CarrierGateway -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CarrierGateway
s@CarrierGateway' {} Maybe [Tag]
a -> CarrierGateway
s {$sel:tags:CarrierGateway' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CarrierGateway) 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 associated with the carrier gateway.
carrierGateway_vpcId :: Lens.Lens' CarrierGateway (Prelude.Maybe Prelude.Text)
carrierGateway_vpcId :: Lens' CarrierGateway (Maybe Text)
carrierGateway_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CarrierGateway' {Maybe Text
vpcId :: Maybe Text
$sel:vpcId:CarrierGateway' :: CarrierGateway -> Maybe Text
vpcId} -> Maybe Text
vpcId) (\s :: CarrierGateway
s@CarrierGateway' {} Maybe Text
a -> CarrierGateway
s {$sel:vpcId:CarrierGateway' :: Maybe Text
vpcId = Maybe Text
a} :: CarrierGateway)

instance Data.FromXML CarrierGateway where
  parseXML :: [Node] -> Either String CarrierGateway
parseXML [Node]
x =
    Maybe Text
-> Maybe Text
-> Maybe CarrierGatewayState
-> Maybe [Tag]
-> Maybe Text
-> CarrierGateway
CarrierGateway'
      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
"carrierGatewayId")
      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
"ownerId")
      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
"state")
      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
"vpcId")

instance Prelude.Hashable CarrierGateway where
  hashWithSalt :: Int -> CarrierGateway -> Int
hashWithSalt Int
_salt CarrierGateway' {Maybe [Tag]
Maybe Text
Maybe CarrierGatewayState
vpcId :: Maybe Text
tags :: Maybe [Tag]
state :: Maybe CarrierGatewayState
ownerId :: Maybe Text
carrierGatewayId :: Maybe Text
$sel:vpcId:CarrierGateway' :: CarrierGateway -> Maybe Text
$sel:tags:CarrierGateway' :: CarrierGateway -> Maybe [Tag]
$sel:state:CarrierGateway' :: CarrierGateway -> Maybe CarrierGatewayState
$sel:ownerId:CarrierGateway' :: CarrierGateway -> Maybe Text
$sel:carrierGatewayId:CarrierGateway' :: CarrierGateway -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
carrierGatewayId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ownerId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CarrierGatewayState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vpcId

instance Prelude.NFData CarrierGateway where
  rnf :: CarrierGateway -> ()
rnf CarrierGateway' {Maybe [Tag]
Maybe Text
Maybe CarrierGatewayState
vpcId :: Maybe Text
tags :: Maybe [Tag]
state :: Maybe CarrierGatewayState
ownerId :: Maybe Text
carrierGatewayId :: Maybe Text
$sel:vpcId:CarrierGateway' :: CarrierGateway -> Maybe Text
$sel:tags:CarrierGateway' :: CarrierGateway -> Maybe [Tag]
$sel:state:CarrierGateway' :: CarrierGateway -> Maybe CarrierGatewayState
$sel:ownerId:CarrierGateway' :: CarrierGateway -> Maybe Text
$sel:carrierGatewayId:CarrierGateway' :: CarrierGateway -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
carrierGatewayId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ownerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CarrierGatewayState
state
      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
vpcId