{-# 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.EC2.AllocateIpamPoolCidr
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Allocate a CIDR from an IPAM pool. In IPAM, an allocation is a CIDR
-- assignment from an IPAM pool to another resource or IPAM pool. For more
-- information, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/allocate-cidrs-ipam.html Allocate CIDRs>
-- in the /Amazon VPC IPAM User Guide/.
module Amazonka.EC2.AllocateIpamPoolCidr
  ( -- * Creating a Request
    AllocateIpamPoolCidr (..),
    newAllocateIpamPoolCidr,

    -- * Request Lenses
    allocateIpamPoolCidr_cidr,
    allocateIpamPoolCidr_clientToken,
    allocateIpamPoolCidr_description,
    allocateIpamPoolCidr_disallowedCidrs,
    allocateIpamPoolCidr_dryRun,
    allocateIpamPoolCidr_netmaskLength,
    allocateIpamPoolCidr_previewNextCidr,
    allocateIpamPoolCidr_ipamPoolId,

    -- * Destructuring the Response
    AllocateIpamPoolCidrResponse (..),
    newAllocateIpamPoolCidrResponse,

    -- * Response Lenses
    allocateIpamPoolCidrResponse_ipamPoolAllocation,
    allocateIpamPoolCidrResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newAllocateIpamPoolCidr' smart constructor.
data AllocateIpamPoolCidr = AllocateIpamPoolCidr'
  { -- | The CIDR you would like to allocate from the IPAM pool. Note the
    -- following:
    --
    -- -   If there is no DefaultNetmaskLength allocation rule set on the pool,
    --     you must specify either the NetmaskLength or the CIDR.
    --
    -- -   If the DefaultNetmaskLength allocation rule is set on the pool, you
    --     can specify either the NetmaskLength or the CIDR and the
    --     DefaultNetmaskLength allocation rule will be ignored.
    --
    -- Possible values: Any available IPv4 or IPv6 CIDR.
    AllocateIpamPoolCidr -> Maybe Text
cidr :: Prelude.Maybe Prelude.Text,
    -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
    AllocateIpamPoolCidr -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description for the allocation.
    AllocateIpamPoolCidr -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Exclude a particular CIDR range from being returned by the pool.
    -- Disallowed CIDRs are only allowed if using netmask length for
    -- allocation.
    AllocateIpamPoolCidr -> Maybe [Text]
disallowedCidrs :: Prelude.Maybe [Prelude.Text],
    -- | A check for whether you have the required permissions for the action
    -- without actually making the request and provides an error response. If
    -- you have the required permissions, the error response is
    -- @DryRunOperation@. Otherwise, it is @UnauthorizedOperation@.
    AllocateIpamPoolCidr -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The netmask length of the CIDR you would like to allocate from the IPAM
    -- pool. Note the following:
    --
    -- -   If there is no DefaultNetmaskLength allocation rule set on the pool,
    --     you must specify either the NetmaskLength or the CIDR.
    --
    -- -   If the DefaultNetmaskLength allocation rule is set on the pool, you
    --     can specify either the NetmaskLength or the CIDR and the
    --     DefaultNetmaskLength allocation rule will be ignored.
    --
    -- Possible netmask lengths for IPv4 addresses are 0 - 32. Possible netmask
    -- lengths for IPv6 addresses are 0 - 128.
    AllocateIpamPoolCidr -> Maybe Int
netmaskLength :: Prelude.Maybe Prelude.Int,
    -- | A preview of the next available CIDR in a pool.
    AllocateIpamPoolCidr -> Maybe Bool
previewNextCidr :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the IPAM pool from which you would like to allocate a CIDR.
    AllocateIpamPoolCidr -> Text
ipamPoolId :: Prelude.Text
  }
  deriving (AllocateIpamPoolCidr -> AllocateIpamPoolCidr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllocateIpamPoolCidr -> AllocateIpamPoolCidr -> Bool
$c/= :: AllocateIpamPoolCidr -> AllocateIpamPoolCidr -> Bool
== :: AllocateIpamPoolCidr -> AllocateIpamPoolCidr -> Bool
$c== :: AllocateIpamPoolCidr -> AllocateIpamPoolCidr -> Bool
Prelude.Eq, ReadPrec [AllocateIpamPoolCidr]
ReadPrec AllocateIpamPoolCidr
Int -> ReadS AllocateIpamPoolCidr
ReadS [AllocateIpamPoolCidr]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AllocateIpamPoolCidr]
$creadListPrec :: ReadPrec [AllocateIpamPoolCidr]
readPrec :: ReadPrec AllocateIpamPoolCidr
$creadPrec :: ReadPrec AllocateIpamPoolCidr
readList :: ReadS [AllocateIpamPoolCidr]
$creadList :: ReadS [AllocateIpamPoolCidr]
readsPrec :: Int -> ReadS AllocateIpamPoolCidr
$creadsPrec :: Int -> ReadS AllocateIpamPoolCidr
Prelude.Read, Int -> AllocateIpamPoolCidr -> ShowS
[AllocateIpamPoolCidr] -> ShowS
AllocateIpamPoolCidr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllocateIpamPoolCidr] -> ShowS
$cshowList :: [AllocateIpamPoolCidr] -> ShowS
show :: AllocateIpamPoolCidr -> String
$cshow :: AllocateIpamPoolCidr -> String
showsPrec :: Int -> AllocateIpamPoolCidr -> ShowS
$cshowsPrec :: Int -> AllocateIpamPoolCidr -> ShowS
Prelude.Show, forall x. Rep AllocateIpamPoolCidr x -> AllocateIpamPoolCidr
forall x. AllocateIpamPoolCidr -> Rep AllocateIpamPoolCidr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AllocateIpamPoolCidr x -> AllocateIpamPoolCidr
$cfrom :: forall x. AllocateIpamPoolCidr -> Rep AllocateIpamPoolCidr x
Prelude.Generic)

-- |
-- Create a value of 'AllocateIpamPoolCidr' 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:
--
-- 'cidr', 'allocateIpamPoolCidr_cidr' - The CIDR you would like to allocate from the IPAM pool. Note the
-- following:
--
-- -   If there is no DefaultNetmaskLength allocation rule set on the pool,
--     you must specify either the NetmaskLength or the CIDR.
--
-- -   If the DefaultNetmaskLength allocation rule is set on the pool, you
--     can specify either the NetmaskLength or the CIDR and the
--     DefaultNetmaskLength allocation rule will be ignored.
--
-- Possible values: Any available IPv4 or IPv6 CIDR.
--
-- 'clientToken', 'allocateIpamPoolCidr_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
--
-- 'description', 'allocateIpamPoolCidr_description' - A description for the allocation.
--
-- 'disallowedCidrs', 'allocateIpamPoolCidr_disallowedCidrs' - Exclude a particular CIDR range from being returned by the pool.
-- Disallowed CIDRs are only allowed if using netmask length for
-- allocation.
--
-- 'dryRun', 'allocateIpamPoolCidr_dryRun' - A check for whether you have the required permissions for the action
-- without actually making the request and provides an error response. If
-- you have the required permissions, the error response is
-- @DryRunOperation@. Otherwise, it is @UnauthorizedOperation@.
--
-- 'netmaskLength', 'allocateIpamPoolCidr_netmaskLength' - The netmask length of the CIDR you would like to allocate from the IPAM
-- pool. Note the following:
--
-- -   If there is no DefaultNetmaskLength allocation rule set on the pool,
--     you must specify either the NetmaskLength or the CIDR.
--
-- -   If the DefaultNetmaskLength allocation rule is set on the pool, you
--     can specify either the NetmaskLength or the CIDR and the
--     DefaultNetmaskLength allocation rule will be ignored.
--
-- Possible netmask lengths for IPv4 addresses are 0 - 32. Possible netmask
-- lengths for IPv6 addresses are 0 - 128.
--
-- 'previewNextCidr', 'allocateIpamPoolCidr_previewNextCidr' - A preview of the next available CIDR in a pool.
--
-- 'ipamPoolId', 'allocateIpamPoolCidr_ipamPoolId' - The ID of the IPAM pool from which you would like to allocate a CIDR.
newAllocateIpamPoolCidr ::
  -- | 'ipamPoolId'
  Prelude.Text ->
  AllocateIpamPoolCidr
newAllocateIpamPoolCidr :: Text -> AllocateIpamPoolCidr
newAllocateIpamPoolCidr Text
pIpamPoolId_ =
  AllocateIpamPoolCidr'
    { $sel:cidr:AllocateIpamPoolCidr' :: Maybe Text
cidr = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:AllocateIpamPoolCidr' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:AllocateIpamPoolCidr' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:disallowedCidrs:AllocateIpamPoolCidr' :: Maybe [Text]
disallowedCidrs = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:AllocateIpamPoolCidr' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:netmaskLength:AllocateIpamPoolCidr' :: Maybe Int
netmaskLength = forall a. Maybe a
Prelude.Nothing,
      $sel:previewNextCidr:AllocateIpamPoolCidr' :: Maybe Bool
previewNextCidr = forall a. Maybe a
Prelude.Nothing,
      $sel:ipamPoolId:AllocateIpamPoolCidr' :: Text
ipamPoolId = Text
pIpamPoolId_
    }

-- | The CIDR you would like to allocate from the IPAM pool. Note the
-- following:
--
-- -   If there is no DefaultNetmaskLength allocation rule set on the pool,
--     you must specify either the NetmaskLength or the CIDR.
--
-- -   If the DefaultNetmaskLength allocation rule is set on the pool, you
--     can specify either the NetmaskLength or the CIDR and the
--     DefaultNetmaskLength allocation rule will be ignored.
--
-- Possible values: Any available IPv4 or IPv6 CIDR.
allocateIpamPoolCidr_cidr :: Lens.Lens' AllocateIpamPoolCidr (Prelude.Maybe Prelude.Text)
allocateIpamPoolCidr_cidr :: Lens' AllocateIpamPoolCidr (Maybe Text)
allocateIpamPoolCidr_cidr = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateIpamPoolCidr' {Maybe Text
cidr :: Maybe Text
$sel:cidr:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Text
cidr} -> Maybe Text
cidr) (\s :: AllocateIpamPoolCidr
s@AllocateIpamPoolCidr' {} Maybe Text
a -> AllocateIpamPoolCidr
s {$sel:cidr:AllocateIpamPoolCidr' :: Maybe Text
cidr = Maybe Text
a} :: AllocateIpamPoolCidr)

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
allocateIpamPoolCidr_clientToken :: Lens.Lens' AllocateIpamPoolCidr (Prelude.Maybe Prelude.Text)
allocateIpamPoolCidr_clientToken :: Lens' AllocateIpamPoolCidr (Maybe Text)
allocateIpamPoolCidr_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateIpamPoolCidr' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: AllocateIpamPoolCidr
s@AllocateIpamPoolCidr' {} Maybe Text
a -> AllocateIpamPoolCidr
s {$sel:clientToken:AllocateIpamPoolCidr' :: Maybe Text
clientToken = Maybe Text
a} :: AllocateIpamPoolCidr)

-- | A description for the allocation.
allocateIpamPoolCidr_description :: Lens.Lens' AllocateIpamPoolCidr (Prelude.Maybe Prelude.Text)
allocateIpamPoolCidr_description :: Lens' AllocateIpamPoolCidr (Maybe Text)
allocateIpamPoolCidr_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateIpamPoolCidr' {Maybe Text
description :: Maybe Text
$sel:description:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Text
description} -> Maybe Text
description) (\s :: AllocateIpamPoolCidr
s@AllocateIpamPoolCidr' {} Maybe Text
a -> AllocateIpamPoolCidr
s {$sel:description:AllocateIpamPoolCidr' :: Maybe Text
description = Maybe Text
a} :: AllocateIpamPoolCidr)

-- | Exclude a particular CIDR range from being returned by the pool.
-- Disallowed CIDRs are only allowed if using netmask length for
-- allocation.
allocateIpamPoolCidr_disallowedCidrs :: Lens.Lens' AllocateIpamPoolCidr (Prelude.Maybe [Prelude.Text])
allocateIpamPoolCidr_disallowedCidrs :: Lens' AllocateIpamPoolCidr (Maybe [Text])
allocateIpamPoolCidr_disallowedCidrs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateIpamPoolCidr' {Maybe [Text]
disallowedCidrs :: Maybe [Text]
$sel:disallowedCidrs:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe [Text]
disallowedCidrs} -> Maybe [Text]
disallowedCidrs) (\s :: AllocateIpamPoolCidr
s@AllocateIpamPoolCidr' {} Maybe [Text]
a -> AllocateIpamPoolCidr
s {$sel:disallowedCidrs:AllocateIpamPoolCidr' :: Maybe [Text]
disallowedCidrs = Maybe [Text]
a} :: AllocateIpamPoolCidr) 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

-- | A check for whether you have the required permissions for the action
-- without actually making the request and provides an error response. If
-- you have the required permissions, the error response is
-- @DryRunOperation@. Otherwise, it is @UnauthorizedOperation@.
allocateIpamPoolCidr_dryRun :: Lens.Lens' AllocateIpamPoolCidr (Prelude.Maybe Prelude.Bool)
allocateIpamPoolCidr_dryRun :: Lens' AllocateIpamPoolCidr (Maybe Bool)
allocateIpamPoolCidr_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateIpamPoolCidr' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: AllocateIpamPoolCidr
s@AllocateIpamPoolCidr' {} Maybe Bool
a -> AllocateIpamPoolCidr
s {$sel:dryRun:AllocateIpamPoolCidr' :: Maybe Bool
dryRun = Maybe Bool
a} :: AllocateIpamPoolCidr)

-- | The netmask length of the CIDR you would like to allocate from the IPAM
-- pool. Note the following:
--
-- -   If there is no DefaultNetmaskLength allocation rule set on the pool,
--     you must specify either the NetmaskLength or the CIDR.
--
-- -   If the DefaultNetmaskLength allocation rule is set on the pool, you
--     can specify either the NetmaskLength or the CIDR and the
--     DefaultNetmaskLength allocation rule will be ignored.
--
-- Possible netmask lengths for IPv4 addresses are 0 - 32. Possible netmask
-- lengths for IPv6 addresses are 0 - 128.
allocateIpamPoolCidr_netmaskLength :: Lens.Lens' AllocateIpamPoolCidr (Prelude.Maybe Prelude.Int)
allocateIpamPoolCidr_netmaskLength :: Lens' AllocateIpamPoolCidr (Maybe Int)
allocateIpamPoolCidr_netmaskLength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateIpamPoolCidr' {Maybe Int
netmaskLength :: Maybe Int
$sel:netmaskLength:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Int
netmaskLength} -> Maybe Int
netmaskLength) (\s :: AllocateIpamPoolCidr
s@AllocateIpamPoolCidr' {} Maybe Int
a -> AllocateIpamPoolCidr
s {$sel:netmaskLength:AllocateIpamPoolCidr' :: Maybe Int
netmaskLength = Maybe Int
a} :: AllocateIpamPoolCidr)

-- | A preview of the next available CIDR in a pool.
allocateIpamPoolCidr_previewNextCidr :: Lens.Lens' AllocateIpamPoolCidr (Prelude.Maybe Prelude.Bool)
allocateIpamPoolCidr_previewNextCidr :: Lens' AllocateIpamPoolCidr (Maybe Bool)
allocateIpamPoolCidr_previewNextCidr = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateIpamPoolCidr' {Maybe Bool
previewNextCidr :: Maybe Bool
$sel:previewNextCidr:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Bool
previewNextCidr} -> Maybe Bool
previewNextCidr) (\s :: AllocateIpamPoolCidr
s@AllocateIpamPoolCidr' {} Maybe Bool
a -> AllocateIpamPoolCidr
s {$sel:previewNextCidr:AllocateIpamPoolCidr' :: Maybe Bool
previewNextCidr = Maybe Bool
a} :: AllocateIpamPoolCidr)

-- | The ID of the IPAM pool from which you would like to allocate a CIDR.
allocateIpamPoolCidr_ipamPoolId :: Lens.Lens' AllocateIpamPoolCidr Prelude.Text
allocateIpamPoolCidr_ipamPoolId :: Lens' AllocateIpamPoolCidr Text
allocateIpamPoolCidr_ipamPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateIpamPoolCidr' {Text
ipamPoolId :: Text
$sel:ipamPoolId:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Text
ipamPoolId} -> Text
ipamPoolId) (\s :: AllocateIpamPoolCidr
s@AllocateIpamPoolCidr' {} Text
a -> AllocateIpamPoolCidr
s {$sel:ipamPoolId:AllocateIpamPoolCidr' :: Text
ipamPoolId = Text
a} :: AllocateIpamPoolCidr)

instance Core.AWSRequest AllocateIpamPoolCidr where
  type
    AWSResponse AllocateIpamPoolCidr =
      AllocateIpamPoolCidrResponse
  request :: (Service -> Service)
-> AllocateIpamPoolCidr -> Request AllocateIpamPoolCidr
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy AllocateIpamPoolCidr
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AllocateIpamPoolCidr)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe IpamPoolAllocation -> Int -> AllocateIpamPoolCidrResponse
AllocateIpamPoolCidrResponse'
            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
"ipamPoolAllocation")
            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 AllocateIpamPoolCidr where
  hashWithSalt :: Int -> AllocateIpamPoolCidr -> Int
hashWithSalt Int
_salt AllocateIpamPoolCidr' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Text
ipamPoolId :: Text
previewNextCidr :: Maybe Bool
netmaskLength :: Maybe Int
dryRun :: Maybe Bool
disallowedCidrs :: Maybe [Text]
description :: Maybe Text
clientToken :: Maybe Text
cidr :: Maybe Text
$sel:ipamPoolId:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Text
$sel:previewNextCidr:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Bool
$sel:netmaskLength:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Int
$sel:dryRun:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Bool
$sel:disallowedCidrs:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe [Text]
$sel:description:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Text
$sel:clientToken:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Text
$sel:cidr:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cidr
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
disallowedCidrs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
netmaskLength
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
previewNextCidr
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ipamPoolId

instance Prelude.NFData AllocateIpamPoolCidr where
  rnf :: AllocateIpamPoolCidr -> ()
rnf AllocateIpamPoolCidr' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Text
ipamPoolId :: Text
previewNextCidr :: Maybe Bool
netmaskLength :: Maybe Int
dryRun :: Maybe Bool
disallowedCidrs :: Maybe [Text]
description :: Maybe Text
clientToken :: Maybe Text
cidr :: Maybe Text
$sel:ipamPoolId:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Text
$sel:previewNextCidr:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Bool
$sel:netmaskLength:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Int
$sel:dryRun:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Bool
$sel:disallowedCidrs:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe [Text]
$sel:description:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Text
$sel:clientToken:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Text
$sel:cidr:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cidr
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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]
disallowedCidrs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
netmaskLength
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
previewNextCidr
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ipamPoolId

instance Data.ToHeaders AllocateIpamPoolCidr where
  toHeaders :: AllocateIpamPoolCidr -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath AllocateIpamPoolCidr where
  toPath :: AllocateIpamPoolCidr -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery AllocateIpamPoolCidr where
  toQuery :: AllocateIpamPoolCidr -> QueryString
toQuery AllocateIpamPoolCidr' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Text
ipamPoolId :: Text
previewNextCidr :: Maybe Bool
netmaskLength :: Maybe Int
dryRun :: Maybe Bool
disallowedCidrs :: Maybe [Text]
description :: Maybe Text
clientToken :: Maybe Text
cidr :: Maybe Text
$sel:ipamPoolId:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Text
$sel:previewNextCidr:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Bool
$sel:netmaskLength:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Int
$sel:dryRun:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Bool
$sel:disallowedCidrs:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe [Text]
$sel:description:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Text
$sel:clientToken:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Text
$sel:cidr:AllocateIpamPoolCidr' :: AllocateIpamPoolCidr -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"AllocateIpamPoolCidr" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"Cidr" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
cidr,
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"DisallowedCidr"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
disallowedCidrs
          ),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"NetmaskLength" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
netmaskLength,
        ByteString
"PreviewNextCidr" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
previewNextCidr,
        ByteString
"IpamPoolId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
ipamPoolId
      ]

-- | /See:/ 'newAllocateIpamPoolCidrResponse' smart constructor.
data AllocateIpamPoolCidrResponse = AllocateIpamPoolCidrResponse'
  { -- | Information about the allocation created.
    AllocateIpamPoolCidrResponse -> Maybe IpamPoolAllocation
ipamPoolAllocation :: Prelude.Maybe IpamPoolAllocation,
    -- | The response's http status code.
    AllocateIpamPoolCidrResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AllocateIpamPoolCidrResponse
-> AllocateIpamPoolCidrResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllocateIpamPoolCidrResponse
-> AllocateIpamPoolCidrResponse -> Bool
$c/= :: AllocateIpamPoolCidrResponse
-> AllocateIpamPoolCidrResponse -> Bool
== :: AllocateIpamPoolCidrResponse
-> AllocateIpamPoolCidrResponse -> Bool
$c== :: AllocateIpamPoolCidrResponse
-> AllocateIpamPoolCidrResponse -> Bool
Prelude.Eq, ReadPrec [AllocateIpamPoolCidrResponse]
ReadPrec AllocateIpamPoolCidrResponse
Int -> ReadS AllocateIpamPoolCidrResponse
ReadS [AllocateIpamPoolCidrResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AllocateIpamPoolCidrResponse]
$creadListPrec :: ReadPrec [AllocateIpamPoolCidrResponse]
readPrec :: ReadPrec AllocateIpamPoolCidrResponse
$creadPrec :: ReadPrec AllocateIpamPoolCidrResponse
readList :: ReadS [AllocateIpamPoolCidrResponse]
$creadList :: ReadS [AllocateIpamPoolCidrResponse]
readsPrec :: Int -> ReadS AllocateIpamPoolCidrResponse
$creadsPrec :: Int -> ReadS AllocateIpamPoolCidrResponse
Prelude.Read, Int -> AllocateIpamPoolCidrResponse -> ShowS
[AllocateIpamPoolCidrResponse] -> ShowS
AllocateIpamPoolCidrResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllocateIpamPoolCidrResponse] -> ShowS
$cshowList :: [AllocateIpamPoolCidrResponse] -> ShowS
show :: AllocateIpamPoolCidrResponse -> String
$cshow :: AllocateIpamPoolCidrResponse -> String
showsPrec :: Int -> AllocateIpamPoolCidrResponse -> ShowS
$cshowsPrec :: Int -> AllocateIpamPoolCidrResponse -> ShowS
Prelude.Show, forall x.
Rep AllocateIpamPoolCidrResponse x -> AllocateIpamPoolCidrResponse
forall x.
AllocateIpamPoolCidrResponse -> Rep AllocateIpamPoolCidrResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AllocateIpamPoolCidrResponse x -> AllocateIpamPoolCidrResponse
$cfrom :: forall x.
AllocateIpamPoolCidrResponse -> Rep AllocateIpamPoolCidrResponse x
Prelude.Generic)

-- |
-- Create a value of 'AllocateIpamPoolCidrResponse' 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:
--
-- 'ipamPoolAllocation', 'allocateIpamPoolCidrResponse_ipamPoolAllocation' - Information about the allocation created.
--
-- 'httpStatus', 'allocateIpamPoolCidrResponse_httpStatus' - The response's http status code.
newAllocateIpamPoolCidrResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AllocateIpamPoolCidrResponse
newAllocateIpamPoolCidrResponse :: Int -> AllocateIpamPoolCidrResponse
newAllocateIpamPoolCidrResponse Int
pHttpStatus_ =
  AllocateIpamPoolCidrResponse'
    { $sel:ipamPoolAllocation:AllocateIpamPoolCidrResponse' :: Maybe IpamPoolAllocation
ipamPoolAllocation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AllocateIpamPoolCidrResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the allocation created.
allocateIpamPoolCidrResponse_ipamPoolAllocation :: Lens.Lens' AllocateIpamPoolCidrResponse (Prelude.Maybe IpamPoolAllocation)
allocateIpamPoolCidrResponse_ipamPoolAllocation :: Lens' AllocateIpamPoolCidrResponse (Maybe IpamPoolAllocation)
allocateIpamPoolCidrResponse_ipamPoolAllocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateIpamPoolCidrResponse' {Maybe IpamPoolAllocation
ipamPoolAllocation :: Maybe IpamPoolAllocation
$sel:ipamPoolAllocation:AllocateIpamPoolCidrResponse' :: AllocateIpamPoolCidrResponse -> Maybe IpamPoolAllocation
ipamPoolAllocation} -> Maybe IpamPoolAllocation
ipamPoolAllocation) (\s :: AllocateIpamPoolCidrResponse
s@AllocateIpamPoolCidrResponse' {} Maybe IpamPoolAllocation
a -> AllocateIpamPoolCidrResponse
s {$sel:ipamPoolAllocation:AllocateIpamPoolCidrResponse' :: Maybe IpamPoolAllocation
ipamPoolAllocation = Maybe IpamPoolAllocation
a} :: AllocateIpamPoolCidrResponse)

-- | The response's http status code.
allocateIpamPoolCidrResponse_httpStatus :: Lens.Lens' AllocateIpamPoolCidrResponse Prelude.Int
allocateIpamPoolCidrResponse_httpStatus :: Lens' AllocateIpamPoolCidrResponse Int
allocateIpamPoolCidrResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateIpamPoolCidrResponse' {Int
httpStatus :: Int
$sel:httpStatus:AllocateIpamPoolCidrResponse' :: AllocateIpamPoolCidrResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: AllocateIpamPoolCidrResponse
s@AllocateIpamPoolCidrResponse' {} Int
a -> AllocateIpamPoolCidrResponse
s {$sel:httpStatus:AllocateIpamPoolCidrResponse' :: Int
httpStatus = Int
a} :: AllocateIpamPoolCidrResponse)

instance Prelude.NFData AllocateIpamPoolCidrResponse where
  rnf :: AllocateIpamPoolCidrResponse -> ()
rnf AllocateIpamPoolCidrResponse' {Int
Maybe IpamPoolAllocation
httpStatus :: Int
ipamPoolAllocation :: Maybe IpamPoolAllocation
$sel:httpStatus:AllocateIpamPoolCidrResponse' :: AllocateIpamPoolCidrResponse -> Int
$sel:ipamPoolAllocation:AllocateIpamPoolCidrResponse' :: AllocateIpamPoolCidrResponse -> Maybe IpamPoolAllocation
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe IpamPoolAllocation
ipamPoolAllocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus