{-# 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.DeprovisionByoipCidr
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Releases the specified address range that you provisioned for use with
-- your Amazon Web Services resources through bring your own IP addresses
-- (BYOIP) and deletes the corresponding address pool.
--
-- Before you can release an address range, you must stop advertising it
-- using WithdrawByoipCidr and you must not have any IP addresses allocated
-- from its address range.
module Amazonka.EC2.DeprovisionByoipCidr
  ( -- * Creating a Request
    DeprovisionByoipCidr (..),
    newDeprovisionByoipCidr,

    -- * Request Lenses
    deprovisionByoipCidr_dryRun,
    deprovisionByoipCidr_cidr,

    -- * Destructuring the Response
    DeprovisionByoipCidrResponse (..),
    newDeprovisionByoipCidrResponse,

    -- * Response Lenses
    deprovisionByoipCidrResponse_byoipCidr,
    deprovisionByoipCidrResponse_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:/ 'newDeprovisionByoipCidr' smart constructor.
data DeprovisionByoipCidr = DeprovisionByoipCidr'
  { -- | Checks 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@.
    DeprovisionByoipCidr -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The address range, in CIDR notation. The prefix must be the same prefix
    -- that you specified when you provisioned the address range.
    DeprovisionByoipCidr -> Text
cidr :: Prelude.Text
  }
  deriving (DeprovisionByoipCidr -> DeprovisionByoipCidr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeprovisionByoipCidr -> DeprovisionByoipCidr -> Bool
$c/= :: DeprovisionByoipCidr -> DeprovisionByoipCidr -> Bool
== :: DeprovisionByoipCidr -> DeprovisionByoipCidr -> Bool
$c== :: DeprovisionByoipCidr -> DeprovisionByoipCidr -> Bool
Prelude.Eq, ReadPrec [DeprovisionByoipCidr]
ReadPrec DeprovisionByoipCidr
Int -> ReadS DeprovisionByoipCidr
ReadS [DeprovisionByoipCidr]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeprovisionByoipCidr]
$creadListPrec :: ReadPrec [DeprovisionByoipCidr]
readPrec :: ReadPrec DeprovisionByoipCidr
$creadPrec :: ReadPrec DeprovisionByoipCidr
readList :: ReadS [DeprovisionByoipCidr]
$creadList :: ReadS [DeprovisionByoipCidr]
readsPrec :: Int -> ReadS DeprovisionByoipCidr
$creadsPrec :: Int -> ReadS DeprovisionByoipCidr
Prelude.Read, Int -> DeprovisionByoipCidr -> ShowS
[DeprovisionByoipCidr] -> ShowS
DeprovisionByoipCidr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeprovisionByoipCidr] -> ShowS
$cshowList :: [DeprovisionByoipCidr] -> ShowS
show :: DeprovisionByoipCidr -> String
$cshow :: DeprovisionByoipCidr -> String
showsPrec :: Int -> DeprovisionByoipCidr -> ShowS
$cshowsPrec :: Int -> DeprovisionByoipCidr -> ShowS
Prelude.Show, forall x. Rep DeprovisionByoipCidr x -> DeprovisionByoipCidr
forall x. DeprovisionByoipCidr -> Rep DeprovisionByoipCidr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeprovisionByoipCidr x -> DeprovisionByoipCidr
$cfrom :: forall x. DeprovisionByoipCidr -> Rep DeprovisionByoipCidr x
Prelude.Generic)

-- |
-- Create a value of 'DeprovisionByoipCidr' 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', 'deprovisionByoipCidr_dryRun' - Checks 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@.
--
-- 'cidr', 'deprovisionByoipCidr_cidr' - The address range, in CIDR notation. The prefix must be the same prefix
-- that you specified when you provisioned the address range.
newDeprovisionByoipCidr ::
  -- | 'cidr'
  Prelude.Text ->
  DeprovisionByoipCidr
newDeprovisionByoipCidr :: Text -> DeprovisionByoipCidr
newDeprovisionByoipCidr Text
pCidr_ =
  DeprovisionByoipCidr'
    { $sel:dryRun:DeprovisionByoipCidr' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:cidr:DeprovisionByoipCidr' :: Text
cidr = Text
pCidr_
    }

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

-- | The address range, in CIDR notation. The prefix must be the same prefix
-- that you specified when you provisioned the address range.
deprovisionByoipCidr_cidr :: Lens.Lens' DeprovisionByoipCidr Prelude.Text
deprovisionByoipCidr_cidr :: Lens' DeprovisionByoipCidr Text
deprovisionByoipCidr_cidr = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeprovisionByoipCidr' {Text
cidr :: Text
$sel:cidr:DeprovisionByoipCidr' :: DeprovisionByoipCidr -> Text
cidr} -> Text
cidr) (\s :: DeprovisionByoipCidr
s@DeprovisionByoipCidr' {} Text
a -> DeprovisionByoipCidr
s {$sel:cidr:DeprovisionByoipCidr' :: Text
cidr = Text
a} :: DeprovisionByoipCidr)

instance Core.AWSRequest DeprovisionByoipCidr where
  type
    AWSResponse DeprovisionByoipCidr =
      DeprovisionByoipCidrResponse
  request :: (Service -> Service)
-> DeprovisionByoipCidr -> Request DeprovisionByoipCidr
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 DeprovisionByoipCidr
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeprovisionByoipCidr)))
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 ByoipCidr -> Int -> DeprovisionByoipCidrResponse
DeprovisionByoipCidrResponse'
            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
"byoipCidr")
            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 DeprovisionByoipCidr where
  hashWithSalt :: Int -> DeprovisionByoipCidr -> Int
hashWithSalt Int
_salt DeprovisionByoipCidr' {Maybe Bool
Text
cidr :: Text
dryRun :: Maybe Bool
$sel:cidr:DeprovisionByoipCidr' :: DeprovisionByoipCidr -> Text
$sel:dryRun:DeprovisionByoipCidr' :: DeprovisionByoipCidr -> 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
cidr

instance Prelude.NFData DeprovisionByoipCidr where
  rnf :: DeprovisionByoipCidr -> ()
rnf DeprovisionByoipCidr' {Maybe Bool
Text
cidr :: Text
dryRun :: Maybe Bool
$sel:cidr:DeprovisionByoipCidr' :: DeprovisionByoipCidr -> Text
$sel:dryRun:DeprovisionByoipCidr' :: DeprovisionByoipCidr -> 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
cidr

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

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

instance Data.ToQuery DeprovisionByoipCidr where
  toQuery :: DeprovisionByoipCidr -> QueryString
toQuery DeprovisionByoipCidr' {Maybe Bool
Text
cidr :: Text
dryRun :: Maybe Bool
$sel:cidr:DeprovisionByoipCidr' :: DeprovisionByoipCidr -> Text
$sel:dryRun:DeprovisionByoipCidr' :: DeprovisionByoipCidr -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeprovisionByoipCidr" :: 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
"Cidr" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
cidr
      ]

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

-- |
-- Create a value of 'DeprovisionByoipCidrResponse' 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:
--
-- 'byoipCidr', 'deprovisionByoipCidrResponse_byoipCidr' - Information about the address range.
--
-- 'httpStatus', 'deprovisionByoipCidrResponse_httpStatus' - The response's http status code.
newDeprovisionByoipCidrResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeprovisionByoipCidrResponse
newDeprovisionByoipCidrResponse :: Int -> DeprovisionByoipCidrResponse
newDeprovisionByoipCidrResponse Int
pHttpStatus_ =
  DeprovisionByoipCidrResponse'
    { $sel:byoipCidr:DeprovisionByoipCidrResponse' :: Maybe ByoipCidr
byoipCidr =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeprovisionByoipCidrResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the address range.
deprovisionByoipCidrResponse_byoipCidr :: Lens.Lens' DeprovisionByoipCidrResponse (Prelude.Maybe ByoipCidr)
deprovisionByoipCidrResponse_byoipCidr :: Lens' DeprovisionByoipCidrResponse (Maybe ByoipCidr)
deprovisionByoipCidrResponse_byoipCidr = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeprovisionByoipCidrResponse' {Maybe ByoipCidr
byoipCidr :: Maybe ByoipCidr
$sel:byoipCidr:DeprovisionByoipCidrResponse' :: DeprovisionByoipCidrResponse -> Maybe ByoipCidr
byoipCidr} -> Maybe ByoipCidr
byoipCidr) (\s :: DeprovisionByoipCidrResponse
s@DeprovisionByoipCidrResponse' {} Maybe ByoipCidr
a -> DeprovisionByoipCidrResponse
s {$sel:byoipCidr:DeprovisionByoipCidrResponse' :: Maybe ByoipCidr
byoipCidr = Maybe ByoipCidr
a} :: DeprovisionByoipCidrResponse)

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

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