{-# 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.ReleaseIpamPoolAllocation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Release an allocation within an IPAM pool. You can only use this action
-- to release manual allocations. To remove an allocation for a resource
-- without deleting the resource, set its monitored state to false using
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_ModifyIpamResourceCidr.html ModifyIpamResourceCidr>.
-- For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/release-pool-alloc-ipam.html Release an allocation>
-- in the /Amazon VPC IPAM User Guide/.
module Amazonka.EC2.ReleaseIpamPoolAllocation
  ( -- * Creating a Request
    ReleaseIpamPoolAllocation (..),
    newReleaseIpamPoolAllocation,

    -- * Request Lenses
    releaseIpamPoolAllocation_dryRun,
    releaseIpamPoolAllocation_ipamPoolId,
    releaseIpamPoolAllocation_cidr,
    releaseIpamPoolAllocation_ipamPoolAllocationId,

    -- * Destructuring the Response
    ReleaseIpamPoolAllocationResponse (..),
    newReleaseIpamPoolAllocationResponse,

    -- * Response Lenses
    releaseIpamPoolAllocationResponse_success,
    releaseIpamPoolAllocationResponse_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:/ 'newReleaseIpamPoolAllocation' smart constructor.
data ReleaseIpamPoolAllocation = ReleaseIpamPoolAllocation'
  { -- | 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@.
    ReleaseIpamPoolAllocation -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the IPAM pool which contains the allocation you want to
    -- release.
    ReleaseIpamPoolAllocation -> Text
ipamPoolId :: Prelude.Text,
    -- | The CIDR of the allocation you want to release.
    ReleaseIpamPoolAllocation -> Text
cidr :: Prelude.Text,
    -- | The ID of the allocation.
    ReleaseIpamPoolAllocation -> Text
ipamPoolAllocationId :: Prelude.Text
  }
  deriving (ReleaseIpamPoolAllocation -> ReleaseIpamPoolAllocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReleaseIpamPoolAllocation -> ReleaseIpamPoolAllocation -> Bool
$c/= :: ReleaseIpamPoolAllocation -> ReleaseIpamPoolAllocation -> Bool
== :: ReleaseIpamPoolAllocation -> ReleaseIpamPoolAllocation -> Bool
$c== :: ReleaseIpamPoolAllocation -> ReleaseIpamPoolAllocation -> Bool
Prelude.Eq, ReadPrec [ReleaseIpamPoolAllocation]
ReadPrec ReleaseIpamPoolAllocation
Int -> ReadS ReleaseIpamPoolAllocation
ReadS [ReleaseIpamPoolAllocation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReleaseIpamPoolAllocation]
$creadListPrec :: ReadPrec [ReleaseIpamPoolAllocation]
readPrec :: ReadPrec ReleaseIpamPoolAllocation
$creadPrec :: ReadPrec ReleaseIpamPoolAllocation
readList :: ReadS [ReleaseIpamPoolAllocation]
$creadList :: ReadS [ReleaseIpamPoolAllocation]
readsPrec :: Int -> ReadS ReleaseIpamPoolAllocation
$creadsPrec :: Int -> ReadS ReleaseIpamPoolAllocation
Prelude.Read, Int -> ReleaseIpamPoolAllocation -> ShowS
[ReleaseIpamPoolAllocation] -> ShowS
ReleaseIpamPoolAllocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReleaseIpamPoolAllocation] -> ShowS
$cshowList :: [ReleaseIpamPoolAllocation] -> ShowS
show :: ReleaseIpamPoolAllocation -> String
$cshow :: ReleaseIpamPoolAllocation -> String
showsPrec :: Int -> ReleaseIpamPoolAllocation -> ShowS
$cshowsPrec :: Int -> ReleaseIpamPoolAllocation -> ShowS
Prelude.Show, forall x.
Rep ReleaseIpamPoolAllocation x -> ReleaseIpamPoolAllocation
forall x.
ReleaseIpamPoolAllocation -> Rep ReleaseIpamPoolAllocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ReleaseIpamPoolAllocation x -> ReleaseIpamPoolAllocation
$cfrom :: forall x.
ReleaseIpamPoolAllocation -> Rep ReleaseIpamPoolAllocation x
Prelude.Generic)

-- |
-- Create a value of 'ReleaseIpamPoolAllocation' 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:
--
-- 'dryRun', 'releaseIpamPoolAllocation_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@.
--
-- 'ipamPoolId', 'releaseIpamPoolAllocation_ipamPoolId' - The ID of the IPAM pool which contains the allocation you want to
-- release.
--
-- 'cidr', 'releaseIpamPoolAllocation_cidr' - The CIDR of the allocation you want to release.
--
-- 'ipamPoolAllocationId', 'releaseIpamPoolAllocation_ipamPoolAllocationId' - The ID of the allocation.
newReleaseIpamPoolAllocation ::
  -- | 'ipamPoolId'
  Prelude.Text ->
  -- | 'cidr'
  Prelude.Text ->
  -- | 'ipamPoolAllocationId'
  Prelude.Text ->
  ReleaseIpamPoolAllocation
newReleaseIpamPoolAllocation :: Text -> Text -> Text -> ReleaseIpamPoolAllocation
newReleaseIpamPoolAllocation
  Text
pIpamPoolId_
  Text
pCidr_
  Text
pIpamPoolAllocationId_ =
    ReleaseIpamPoolAllocation'
      { $sel:dryRun:ReleaseIpamPoolAllocation' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:ipamPoolId:ReleaseIpamPoolAllocation' :: Text
ipamPoolId = Text
pIpamPoolId_,
        $sel:cidr:ReleaseIpamPoolAllocation' :: Text
cidr = Text
pCidr_,
        $sel:ipamPoolAllocationId:ReleaseIpamPoolAllocation' :: Text
ipamPoolAllocationId = Text
pIpamPoolAllocationId_
      }

-- | 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@.
releaseIpamPoolAllocation_dryRun :: Lens.Lens' ReleaseIpamPoolAllocation (Prelude.Maybe Prelude.Bool)
releaseIpamPoolAllocation_dryRun :: Lens' ReleaseIpamPoolAllocation (Maybe Bool)
releaseIpamPoolAllocation_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReleaseIpamPoolAllocation' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ReleaseIpamPoolAllocation
s@ReleaseIpamPoolAllocation' {} Maybe Bool
a -> ReleaseIpamPoolAllocation
s {$sel:dryRun:ReleaseIpamPoolAllocation' :: Maybe Bool
dryRun = Maybe Bool
a} :: ReleaseIpamPoolAllocation)

-- | The ID of the IPAM pool which contains the allocation you want to
-- release.
releaseIpamPoolAllocation_ipamPoolId :: Lens.Lens' ReleaseIpamPoolAllocation Prelude.Text
releaseIpamPoolAllocation_ipamPoolId :: Lens' ReleaseIpamPoolAllocation Text
releaseIpamPoolAllocation_ipamPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReleaseIpamPoolAllocation' {Text
ipamPoolId :: Text
$sel:ipamPoolId:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Text
ipamPoolId} -> Text
ipamPoolId) (\s :: ReleaseIpamPoolAllocation
s@ReleaseIpamPoolAllocation' {} Text
a -> ReleaseIpamPoolAllocation
s {$sel:ipamPoolId:ReleaseIpamPoolAllocation' :: Text
ipamPoolId = Text
a} :: ReleaseIpamPoolAllocation)

-- | The CIDR of the allocation you want to release.
releaseIpamPoolAllocation_cidr :: Lens.Lens' ReleaseIpamPoolAllocation Prelude.Text
releaseIpamPoolAllocation_cidr :: Lens' ReleaseIpamPoolAllocation Text
releaseIpamPoolAllocation_cidr = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReleaseIpamPoolAllocation' {Text
cidr :: Text
$sel:cidr:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Text
cidr} -> Text
cidr) (\s :: ReleaseIpamPoolAllocation
s@ReleaseIpamPoolAllocation' {} Text
a -> ReleaseIpamPoolAllocation
s {$sel:cidr:ReleaseIpamPoolAllocation' :: Text
cidr = Text
a} :: ReleaseIpamPoolAllocation)

-- | The ID of the allocation.
releaseIpamPoolAllocation_ipamPoolAllocationId :: Lens.Lens' ReleaseIpamPoolAllocation Prelude.Text
releaseIpamPoolAllocation_ipamPoolAllocationId :: Lens' ReleaseIpamPoolAllocation Text
releaseIpamPoolAllocation_ipamPoolAllocationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReleaseIpamPoolAllocation' {Text
ipamPoolAllocationId :: Text
$sel:ipamPoolAllocationId:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Text
ipamPoolAllocationId} -> Text
ipamPoolAllocationId) (\s :: ReleaseIpamPoolAllocation
s@ReleaseIpamPoolAllocation' {} Text
a -> ReleaseIpamPoolAllocation
s {$sel:ipamPoolAllocationId:ReleaseIpamPoolAllocation' :: Text
ipamPoolAllocationId = Text
a} :: ReleaseIpamPoolAllocation)

instance Core.AWSRequest ReleaseIpamPoolAllocation where
  type
    AWSResponse ReleaseIpamPoolAllocation =
      ReleaseIpamPoolAllocationResponse
  request :: (Service -> Service)
-> ReleaseIpamPoolAllocation -> Request ReleaseIpamPoolAllocation
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 ReleaseIpamPoolAllocation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ReleaseIpamPoolAllocation)))
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 Bool -> Int -> ReleaseIpamPoolAllocationResponse
ReleaseIpamPoolAllocationResponse'
            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
"success")
            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 ReleaseIpamPoolAllocation where
  hashWithSalt :: Int -> ReleaseIpamPoolAllocation -> Int
hashWithSalt Int
_salt ReleaseIpamPoolAllocation' {Maybe Bool
Text
ipamPoolAllocationId :: Text
cidr :: Text
ipamPoolId :: Text
dryRun :: Maybe Bool
$sel:ipamPoolAllocationId:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Text
$sel:cidr:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Text
$sel:ipamPoolId:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Text
$sel:dryRun:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ipamPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
cidr
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ipamPoolAllocationId

instance Prelude.NFData ReleaseIpamPoolAllocation where
  rnf :: ReleaseIpamPoolAllocation -> ()
rnf ReleaseIpamPoolAllocation' {Maybe Bool
Text
ipamPoolAllocationId :: Text
cidr :: Text
ipamPoolId :: Text
dryRun :: Maybe Bool
$sel:ipamPoolAllocationId:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Text
$sel:cidr:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Text
$sel:ipamPoolId:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Text
$sel:dryRun:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Maybe Bool
..} =
    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 Text
ipamPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
cidr
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ipamPoolAllocationId

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

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

instance Data.ToQuery ReleaseIpamPoolAllocation where
  toQuery :: ReleaseIpamPoolAllocation -> QueryString
toQuery ReleaseIpamPoolAllocation' {Maybe Bool
Text
ipamPoolAllocationId :: Text
cidr :: Text
ipamPoolId :: Text
dryRun :: Maybe Bool
$sel:ipamPoolAllocationId:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Text
$sel:cidr:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Text
$sel:ipamPoolId:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Text
$sel:dryRun:ReleaseIpamPoolAllocation' :: ReleaseIpamPoolAllocation -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ReleaseIpamPoolAllocation" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"IpamPoolId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
ipamPoolId,
        ByteString
"Cidr" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
cidr,
        ByteString
"IpamPoolAllocationId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
ipamPoolAllocationId
      ]

-- | /See:/ 'newReleaseIpamPoolAllocationResponse' smart constructor.
data ReleaseIpamPoolAllocationResponse = ReleaseIpamPoolAllocationResponse'
  { -- | Indicates if the release was successful.
    ReleaseIpamPoolAllocationResponse -> Maybe Bool
success :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    ReleaseIpamPoolAllocationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ReleaseIpamPoolAllocationResponse
-> ReleaseIpamPoolAllocationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReleaseIpamPoolAllocationResponse
-> ReleaseIpamPoolAllocationResponse -> Bool
$c/= :: ReleaseIpamPoolAllocationResponse
-> ReleaseIpamPoolAllocationResponse -> Bool
== :: ReleaseIpamPoolAllocationResponse
-> ReleaseIpamPoolAllocationResponse -> Bool
$c== :: ReleaseIpamPoolAllocationResponse
-> ReleaseIpamPoolAllocationResponse -> Bool
Prelude.Eq, ReadPrec [ReleaseIpamPoolAllocationResponse]
ReadPrec ReleaseIpamPoolAllocationResponse
Int -> ReadS ReleaseIpamPoolAllocationResponse
ReadS [ReleaseIpamPoolAllocationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReleaseIpamPoolAllocationResponse]
$creadListPrec :: ReadPrec [ReleaseIpamPoolAllocationResponse]
readPrec :: ReadPrec ReleaseIpamPoolAllocationResponse
$creadPrec :: ReadPrec ReleaseIpamPoolAllocationResponse
readList :: ReadS [ReleaseIpamPoolAllocationResponse]
$creadList :: ReadS [ReleaseIpamPoolAllocationResponse]
readsPrec :: Int -> ReadS ReleaseIpamPoolAllocationResponse
$creadsPrec :: Int -> ReadS ReleaseIpamPoolAllocationResponse
Prelude.Read, Int -> ReleaseIpamPoolAllocationResponse -> ShowS
[ReleaseIpamPoolAllocationResponse] -> ShowS
ReleaseIpamPoolAllocationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReleaseIpamPoolAllocationResponse] -> ShowS
$cshowList :: [ReleaseIpamPoolAllocationResponse] -> ShowS
show :: ReleaseIpamPoolAllocationResponse -> String
$cshow :: ReleaseIpamPoolAllocationResponse -> String
showsPrec :: Int -> ReleaseIpamPoolAllocationResponse -> ShowS
$cshowsPrec :: Int -> ReleaseIpamPoolAllocationResponse -> ShowS
Prelude.Show, forall x.
Rep ReleaseIpamPoolAllocationResponse x
-> ReleaseIpamPoolAllocationResponse
forall x.
ReleaseIpamPoolAllocationResponse
-> Rep ReleaseIpamPoolAllocationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ReleaseIpamPoolAllocationResponse x
-> ReleaseIpamPoolAllocationResponse
$cfrom :: forall x.
ReleaseIpamPoolAllocationResponse
-> Rep ReleaseIpamPoolAllocationResponse x
Prelude.Generic)

-- |
-- Create a value of 'ReleaseIpamPoolAllocationResponse' 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:
--
-- 'success', 'releaseIpamPoolAllocationResponse_success' - Indicates if the release was successful.
--
-- 'httpStatus', 'releaseIpamPoolAllocationResponse_httpStatus' - The response's http status code.
newReleaseIpamPoolAllocationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ReleaseIpamPoolAllocationResponse
newReleaseIpamPoolAllocationResponse :: Int -> ReleaseIpamPoolAllocationResponse
newReleaseIpamPoolAllocationResponse Int
pHttpStatus_ =
  ReleaseIpamPoolAllocationResponse'
    { $sel:success:ReleaseIpamPoolAllocationResponse' :: Maybe Bool
success =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ReleaseIpamPoolAllocationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Indicates if the release was successful.
releaseIpamPoolAllocationResponse_success :: Lens.Lens' ReleaseIpamPoolAllocationResponse (Prelude.Maybe Prelude.Bool)
releaseIpamPoolAllocationResponse_success :: Lens' ReleaseIpamPoolAllocationResponse (Maybe Bool)
releaseIpamPoolAllocationResponse_success = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReleaseIpamPoolAllocationResponse' {Maybe Bool
success :: Maybe Bool
$sel:success:ReleaseIpamPoolAllocationResponse' :: ReleaseIpamPoolAllocationResponse -> Maybe Bool
success} -> Maybe Bool
success) (\s :: ReleaseIpamPoolAllocationResponse
s@ReleaseIpamPoolAllocationResponse' {} Maybe Bool
a -> ReleaseIpamPoolAllocationResponse
s {$sel:success:ReleaseIpamPoolAllocationResponse' :: Maybe Bool
success = Maybe Bool
a} :: ReleaseIpamPoolAllocationResponse)

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

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