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

-- | Describes an IPv4 address pool.
--
-- /See:/ 'newPublicIpv4Pool' smart constructor.
data PublicIpv4Pool = PublicIpv4Pool'
  { -- | A description of the address pool.
    PublicIpv4Pool -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The name of the location from which the address pool is advertised. A
    -- network border group is a unique set of Availability Zones or Local
    -- Zones from where Amazon Web Services advertises public IP addresses.
    PublicIpv4Pool -> Maybe Text
networkBorderGroup :: Prelude.Maybe Prelude.Text,
    -- | The address ranges.
    PublicIpv4Pool -> Maybe [PublicIpv4PoolRange]
poolAddressRanges :: Prelude.Maybe [PublicIpv4PoolRange],
    -- | The ID of the address pool.
    PublicIpv4Pool -> Maybe Text
poolId :: Prelude.Maybe Prelude.Text,
    -- | Any tags for the address pool.
    PublicIpv4Pool -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The total number of addresses.
    PublicIpv4Pool -> Maybe Int
totalAddressCount :: Prelude.Maybe Prelude.Int,
    -- | The total number of available addresses.
    PublicIpv4Pool -> Maybe Int
totalAvailableAddressCount :: Prelude.Maybe Prelude.Int
  }
  deriving (PublicIpv4Pool -> PublicIpv4Pool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicIpv4Pool -> PublicIpv4Pool -> Bool
$c/= :: PublicIpv4Pool -> PublicIpv4Pool -> Bool
== :: PublicIpv4Pool -> PublicIpv4Pool -> Bool
$c== :: PublicIpv4Pool -> PublicIpv4Pool -> Bool
Prelude.Eq, ReadPrec [PublicIpv4Pool]
ReadPrec PublicIpv4Pool
Int -> ReadS PublicIpv4Pool
ReadS [PublicIpv4Pool]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PublicIpv4Pool]
$creadListPrec :: ReadPrec [PublicIpv4Pool]
readPrec :: ReadPrec PublicIpv4Pool
$creadPrec :: ReadPrec PublicIpv4Pool
readList :: ReadS [PublicIpv4Pool]
$creadList :: ReadS [PublicIpv4Pool]
readsPrec :: Int -> ReadS PublicIpv4Pool
$creadsPrec :: Int -> ReadS PublicIpv4Pool
Prelude.Read, Int -> PublicIpv4Pool -> ShowS
[PublicIpv4Pool] -> ShowS
PublicIpv4Pool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicIpv4Pool] -> ShowS
$cshowList :: [PublicIpv4Pool] -> ShowS
show :: PublicIpv4Pool -> String
$cshow :: PublicIpv4Pool -> String
showsPrec :: Int -> PublicIpv4Pool -> ShowS
$cshowsPrec :: Int -> PublicIpv4Pool -> ShowS
Prelude.Show, forall x. Rep PublicIpv4Pool x -> PublicIpv4Pool
forall x. PublicIpv4Pool -> Rep PublicIpv4Pool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PublicIpv4Pool x -> PublicIpv4Pool
$cfrom :: forall x. PublicIpv4Pool -> Rep PublicIpv4Pool x
Prelude.Generic)

-- |
-- Create a value of 'PublicIpv4Pool' 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:
--
-- 'description', 'publicIpv4Pool_description' - A description of the address pool.
--
-- 'networkBorderGroup', 'publicIpv4Pool_networkBorderGroup' - The name of the location from which the address pool is advertised. A
-- network border group is a unique set of Availability Zones or Local
-- Zones from where Amazon Web Services advertises public IP addresses.
--
-- 'poolAddressRanges', 'publicIpv4Pool_poolAddressRanges' - The address ranges.
--
-- 'poolId', 'publicIpv4Pool_poolId' - The ID of the address pool.
--
-- 'tags', 'publicIpv4Pool_tags' - Any tags for the address pool.
--
-- 'totalAddressCount', 'publicIpv4Pool_totalAddressCount' - The total number of addresses.
--
-- 'totalAvailableAddressCount', 'publicIpv4Pool_totalAvailableAddressCount' - The total number of available addresses.
newPublicIpv4Pool ::
  PublicIpv4Pool
newPublicIpv4Pool :: PublicIpv4Pool
newPublicIpv4Pool =
  PublicIpv4Pool'
    { $sel:description:PublicIpv4Pool' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:networkBorderGroup:PublicIpv4Pool' :: Maybe Text
networkBorderGroup = forall a. Maybe a
Prelude.Nothing,
      $sel:poolAddressRanges:PublicIpv4Pool' :: Maybe [PublicIpv4PoolRange]
poolAddressRanges = forall a. Maybe a
Prelude.Nothing,
      $sel:poolId:PublicIpv4Pool' :: Maybe Text
poolId = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:PublicIpv4Pool' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:totalAddressCount:PublicIpv4Pool' :: Maybe Int
totalAddressCount = forall a. Maybe a
Prelude.Nothing,
      $sel:totalAvailableAddressCount:PublicIpv4Pool' :: Maybe Int
totalAvailableAddressCount = forall a. Maybe a
Prelude.Nothing
    }

-- | A description of the address pool.
publicIpv4Pool_description :: Lens.Lens' PublicIpv4Pool (Prelude.Maybe Prelude.Text)
publicIpv4Pool_description :: Lens' PublicIpv4Pool (Maybe Text)
publicIpv4Pool_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PublicIpv4Pool' {Maybe Text
description :: Maybe Text
$sel:description:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Text
description} -> Maybe Text
description) (\s :: PublicIpv4Pool
s@PublicIpv4Pool' {} Maybe Text
a -> PublicIpv4Pool
s {$sel:description:PublicIpv4Pool' :: Maybe Text
description = Maybe Text
a} :: PublicIpv4Pool)

-- | The name of the location from which the address pool is advertised. A
-- network border group is a unique set of Availability Zones or Local
-- Zones from where Amazon Web Services advertises public IP addresses.
publicIpv4Pool_networkBorderGroup :: Lens.Lens' PublicIpv4Pool (Prelude.Maybe Prelude.Text)
publicIpv4Pool_networkBorderGroup :: Lens' PublicIpv4Pool (Maybe Text)
publicIpv4Pool_networkBorderGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PublicIpv4Pool' {Maybe Text
networkBorderGroup :: Maybe Text
$sel:networkBorderGroup:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Text
networkBorderGroup} -> Maybe Text
networkBorderGroup) (\s :: PublicIpv4Pool
s@PublicIpv4Pool' {} Maybe Text
a -> PublicIpv4Pool
s {$sel:networkBorderGroup:PublicIpv4Pool' :: Maybe Text
networkBorderGroup = Maybe Text
a} :: PublicIpv4Pool)

-- | The address ranges.
publicIpv4Pool_poolAddressRanges :: Lens.Lens' PublicIpv4Pool (Prelude.Maybe [PublicIpv4PoolRange])
publicIpv4Pool_poolAddressRanges :: Lens' PublicIpv4Pool (Maybe [PublicIpv4PoolRange])
publicIpv4Pool_poolAddressRanges = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PublicIpv4Pool' {Maybe [PublicIpv4PoolRange]
poolAddressRanges :: Maybe [PublicIpv4PoolRange]
$sel:poolAddressRanges:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe [PublicIpv4PoolRange]
poolAddressRanges} -> Maybe [PublicIpv4PoolRange]
poolAddressRanges) (\s :: PublicIpv4Pool
s@PublicIpv4Pool' {} Maybe [PublicIpv4PoolRange]
a -> PublicIpv4Pool
s {$sel:poolAddressRanges:PublicIpv4Pool' :: Maybe [PublicIpv4PoolRange]
poolAddressRanges = Maybe [PublicIpv4PoolRange]
a} :: PublicIpv4Pool) 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 address pool.
publicIpv4Pool_poolId :: Lens.Lens' PublicIpv4Pool (Prelude.Maybe Prelude.Text)
publicIpv4Pool_poolId :: Lens' PublicIpv4Pool (Maybe Text)
publicIpv4Pool_poolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PublicIpv4Pool' {Maybe Text
poolId :: Maybe Text
$sel:poolId:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Text
poolId} -> Maybe Text
poolId) (\s :: PublicIpv4Pool
s@PublicIpv4Pool' {} Maybe Text
a -> PublicIpv4Pool
s {$sel:poolId:PublicIpv4Pool' :: Maybe Text
poolId = Maybe Text
a} :: PublicIpv4Pool)

-- | Any tags for the address pool.
publicIpv4Pool_tags :: Lens.Lens' PublicIpv4Pool (Prelude.Maybe [Tag])
publicIpv4Pool_tags :: Lens' PublicIpv4Pool (Maybe [Tag])
publicIpv4Pool_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PublicIpv4Pool' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: PublicIpv4Pool
s@PublicIpv4Pool' {} Maybe [Tag]
a -> PublicIpv4Pool
s {$sel:tags:PublicIpv4Pool' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: PublicIpv4Pool) 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 total number of addresses.
publicIpv4Pool_totalAddressCount :: Lens.Lens' PublicIpv4Pool (Prelude.Maybe Prelude.Int)
publicIpv4Pool_totalAddressCount :: Lens' PublicIpv4Pool (Maybe Int)
publicIpv4Pool_totalAddressCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PublicIpv4Pool' {Maybe Int
totalAddressCount :: Maybe Int
$sel:totalAddressCount:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Int
totalAddressCount} -> Maybe Int
totalAddressCount) (\s :: PublicIpv4Pool
s@PublicIpv4Pool' {} Maybe Int
a -> PublicIpv4Pool
s {$sel:totalAddressCount:PublicIpv4Pool' :: Maybe Int
totalAddressCount = Maybe Int
a} :: PublicIpv4Pool)

-- | The total number of available addresses.
publicIpv4Pool_totalAvailableAddressCount :: Lens.Lens' PublicIpv4Pool (Prelude.Maybe Prelude.Int)
publicIpv4Pool_totalAvailableAddressCount :: Lens' PublicIpv4Pool (Maybe Int)
publicIpv4Pool_totalAvailableAddressCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PublicIpv4Pool' {Maybe Int
totalAvailableAddressCount :: Maybe Int
$sel:totalAvailableAddressCount:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Int
totalAvailableAddressCount} -> Maybe Int
totalAvailableAddressCount) (\s :: PublicIpv4Pool
s@PublicIpv4Pool' {} Maybe Int
a -> PublicIpv4Pool
s {$sel:totalAvailableAddressCount:PublicIpv4Pool' :: Maybe Int
totalAvailableAddressCount = Maybe Int
a} :: PublicIpv4Pool)

instance Data.FromXML PublicIpv4Pool where
  parseXML :: [Node] -> Either String PublicIpv4Pool
parseXML [Node]
x =
    Maybe Text
-> Maybe Text
-> Maybe [PublicIpv4PoolRange]
-> Maybe Text
-> Maybe [Tag]
-> Maybe Int
-> Maybe Int
-> PublicIpv4Pool
PublicIpv4Pool'
      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
"description")
      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
"networkBorderGroup")
      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
"poolAddressRangeSet"
                      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
"poolId")
      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
"totalAddressCount")
      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
"totalAvailableAddressCount")

instance Prelude.Hashable PublicIpv4Pool where
  hashWithSalt :: Int -> PublicIpv4Pool -> Int
hashWithSalt Int
_salt PublicIpv4Pool' {Maybe Int
Maybe [PublicIpv4PoolRange]
Maybe [Tag]
Maybe Text
totalAvailableAddressCount :: Maybe Int
totalAddressCount :: Maybe Int
tags :: Maybe [Tag]
poolId :: Maybe Text
poolAddressRanges :: Maybe [PublicIpv4PoolRange]
networkBorderGroup :: Maybe Text
description :: Maybe Text
$sel:totalAvailableAddressCount:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Int
$sel:totalAddressCount:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Int
$sel:tags:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe [Tag]
$sel:poolId:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Text
$sel:poolAddressRanges:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe [PublicIpv4PoolRange]
$sel:networkBorderGroup:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Text
$sel:description:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
networkBorderGroup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PublicIpv4PoolRange]
poolAddressRanges
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
poolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
totalAddressCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
totalAvailableAddressCount

instance Prelude.NFData PublicIpv4Pool where
  rnf :: PublicIpv4Pool -> ()
rnf PublicIpv4Pool' {Maybe Int
Maybe [PublicIpv4PoolRange]
Maybe [Tag]
Maybe Text
totalAvailableAddressCount :: Maybe Int
totalAddressCount :: Maybe Int
tags :: Maybe [Tag]
poolId :: Maybe Text
poolAddressRanges :: Maybe [PublicIpv4PoolRange]
networkBorderGroup :: Maybe Text
description :: Maybe Text
$sel:totalAvailableAddressCount:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Int
$sel:totalAddressCount:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Int
$sel:tags:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe [Tag]
$sel:poolId:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Text
$sel:poolAddressRanges:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe [PublicIpv4PoolRange]
$sel:networkBorderGroup:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Text
$sel:description:PublicIpv4Pool' :: PublicIpv4Pool -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
networkBorderGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PublicIpv4PoolRange]
poolAddressRanges
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
poolId
      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 Int
totalAddressCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
totalAvailableAddressCount