{-# 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.WithdrawByoipCidr
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stops advertising an address range that is provisioned as an address
-- pool.
--
-- You can perform this operation at most once every 10 seconds, even if
-- you specify different address ranges each time.
--
-- It can take a few minutes before traffic to the specified addresses
-- stops routing to Amazon Web Services because of BGP propagation delays.
module Amazonka.EC2.WithdrawByoipCidr
  ( -- * Creating a Request
    WithdrawByoipCidr (..),
    newWithdrawByoipCidr,

    -- * Request Lenses
    withdrawByoipCidr_dryRun,
    withdrawByoipCidr_cidr,

    -- * Destructuring the Response
    WithdrawByoipCidrResponse (..),
    newWithdrawByoipCidrResponse,

    -- * Response Lenses
    withdrawByoipCidrResponse_byoipCidr,
    withdrawByoipCidrResponse_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:/ 'newWithdrawByoipCidr' smart constructor.
data WithdrawByoipCidr = WithdrawByoipCidr'
  { -- | 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@.
    WithdrawByoipCidr -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The address range, in CIDR notation.
    WithdrawByoipCidr -> Text
cidr :: Prelude.Text
  }
  deriving (WithdrawByoipCidr -> WithdrawByoipCidr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithdrawByoipCidr -> WithdrawByoipCidr -> Bool
$c/= :: WithdrawByoipCidr -> WithdrawByoipCidr -> Bool
== :: WithdrawByoipCidr -> WithdrawByoipCidr -> Bool
$c== :: WithdrawByoipCidr -> WithdrawByoipCidr -> Bool
Prelude.Eq, ReadPrec [WithdrawByoipCidr]
ReadPrec WithdrawByoipCidr
Int -> ReadS WithdrawByoipCidr
ReadS [WithdrawByoipCidr]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WithdrawByoipCidr]
$creadListPrec :: ReadPrec [WithdrawByoipCidr]
readPrec :: ReadPrec WithdrawByoipCidr
$creadPrec :: ReadPrec WithdrawByoipCidr
readList :: ReadS [WithdrawByoipCidr]
$creadList :: ReadS [WithdrawByoipCidr]
readsPrec :: Int -> ReadS WithdrawByoipCidr
$creadsPrec :: Int -> ReadS WithdrawByoipCidr
Prelude.Read, Int -> WithdrawByoipCidr -> ShowS
[WithdrawByoipCidr] -> ShowS
WithdrawByoipCidr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithdrawByoipCidr] -> ShowS
$cshowList :: [WithdrawByoipCidr] -> ShowS
show :: WithdrawByoipCidr -> String
$cshow :: WithdrawByoipCidr -> String
showsPrec :: Int -> WithdrawByoipCidr -> ShowS
$cshowsPrec :: Int -> WithdrawByoipCidr -> ShowS
Prelude.Show, forall x. Rep WithdrawByoipCidr x -> WithdrawByoipCidr
forall x. WithdrawByoipCidr -> Rep WithdrawByoipCidr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WithdrawByoipCidr x -> WithdrawByoipCidr
$cfrom :: forall x. WithdrawByoipCidr -> Rep WithdrawByoipCidr x
Prelude.Generic)

-- |
-- Create a value of 'WithdrawByoipCidr' 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', 'withdrawByoipCidr_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', 'withdrawByoipCidr_cidr' - The address range, in CIDR notation.
newWithdrawByoipCidr ::
  -- | 'cidr'
  Prelude.Text ->
  WithdrawByoipCidr
newWithdrawByoipCidr :: Text -> WithdrawByoipCidr
newWithdrawByoipCidr Text
pCidr_ =
  WithdrawByoipCidr'
    { $sel:dryRun:WithdrawByoipCidr' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:cidr:WithdrawByoipCidr' :: 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@.
withdrawByoipCidr_dryRun :: Lens.Lens' WithdrawByoipCidr (Prelude.Maybe Prelude.Bool)
withdrawByoipCidr_dryRun :: Lens' WithdrawByoipCidr (Maybe Bool)
withdrawByoipCidr_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WithdrawByoipCidr' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:WithdrawByoipCidr' :: WithdrawByoipCidr -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: WithdrawByoipCidr
s@WithdrawByoipCidr' {} Maybe Bool
a -> WithdrawByoipCidr
s {$sel:dryRun:WithdrawByoipCidr' :: Maybe Bool
dryRun = Maybe Bool
a} :: WithdrawByoipCidr)

-- | The address range, in CIDR notation.
withdrawByoipCidr_cidr :: Lens.Lens' WithdrawByoipCidr Prelude.Text
withdrawByoipCidr_cidr :: Lens' WithdrawByoipCidr Text
withdrawByoipCidr_cidr = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WithdrawByoipCidr' {Text
cidr :: Text
$sel:cidr:WithdrawByoipCidr' :: WithdrawByoipCidr -> Text
cidr} -> Text
cidr) (\s :: WithdrawByoipCidr
s@WithdrawByoipCidr' {} Text
a -> WithdrawByoipCidr
s {$sel:cidr:WithdrawByoipCidr' :: Text
cidr = Text
a} :: WithdrawByoipCidr)

instance Core.AWSRequest WithdrawByoipCidr where
  type
    AWSResponse WithdrawByoipCidr =
      WithdrawByoipCidrResponse
  request :: (Service -> Service)
-> WithdrawByoipCidr -> Request WithdrawByoipCidr
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 WithdrawByoipCidr
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse WithdrawByoipCidr)))
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 -> WithdrawByoipCidrResponse
WithdrawByoipCidrResponse'
            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 WithdrawByoipCidr where
  hashWithSalt :: Int -> WithdrawByoipCidr -> Int
hashWithSalt Int
_salt WithdrawByoipCidr' {Maybe Bool
Text
cidr :: Text
dryRun :: Maybe Bool
$sel:cidr:WithdrawByoipCidr' :: WithdrawByoipCidr -> Text
$sel:dryRun:WithdrawByoipCidr' :: WithdrawByoipCidr -> 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 WithdrawByoipCidr where
  rnf :: WithdrawByoipCidr -> ()
rnf WithdrawByoipCidr' {Maybe Bool
Text
cidr :: Text
dryRun :: Maybe Bool
$sel:cidr:WithdrawByoipCidr' :: WithdrawByoipCidr -> Text
$sel:dryRun:WithdrawByoipCidr' :: WithdrawByoipCidr -> 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 WithdrawByoipCidr where
  toHeaders :: WithdrawByoipCidr -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery WithdrawByoipCidr where
  toQuery :: WithdrawByoipCidr -> QueryString
toQuery WithdrawByoipCidr' {Maybe Bool
Text
cidr :: Text
dryRun :: Maybe Bool
$sel:cidr:WithdrawByoipCidr' :: WithdrawByoipCidr -> Text
$sel:dryRun:WithdrawByoipCidr' :: WithdrawByoipCidr -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"WithdrawByoipCidr" :: 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:/ 'newWithdrawByoipCidrResponse' smart constructor.
data WithdrawByoipCidrResponse = WithdrawByoipCidrResponse'
  { -- | Information about the address pool.
    WithdrawByoipCidrResponse -> Maybe ByoipCidr
byoipCidr :: Prelude.Maybe ByoipCidr,
    -- | The response's http status code.
    WithdrawByoipCidrResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (WithdrawByoipCidrResponse -> WithdrawByoipCidrResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithdrawByoipCidrResponse -> WithdrawByoipCidrResponse -> Bool
$c/= :: WithdrawByoipCidrResponse -> WithdrawByoipCidrResponse -> Bool
== :: WithdrawByoipCidrResponse -> WithdrawByoipCidrResponse -> Bool
$c== :: WithdrawByoipCidrResponse -> WithdrawByoipCidrResponse -> Bool
Prelude.Eq, ReadPrec [WithdrawByoipCidrResponse]
ReadPrec WithdrawByoipCidrResponse
Int -> ReadS WithdrawByoipCidrResponse
ReadS [WithdrawByoipCidrResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WithdrawByoipCidrResponse]
$creadListPrec :: ReadPrec [WithdrawByoipCidrResponse]
readPrec :: ReadPrec WithdrawByoipCidrResponse
$creadPrec :: ReadPrec WithdrawByoipCidrResponse
readList :: ReadS [WithdrawByoipCidrResponse]
$creadList :: ReadS [WithdrawByoipCidrResponse]
readsPrec :: Int -> ReadS WithdrawByoipCidrResponse
$creadsPrec :: Int -> ReadS WithdrawByoipCidrResponse
Prelude.Read, Int -> WithdrawByoipCidrResponse -> ShowS
[WithdrawByoipCidrResponse] -> ShowS
WithdrawByoipCidrResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithdrawByoipCidrResponse] -> ShowS
$cshowList :: [WithdrawByoipCidrResponse] -> ShowS
show :: WithdrawByoipCidrResponse -> String
$cshow :: WithdrawByoipCidrResponse -> String
showsPrec :: Int -> WithdrawByoipCidrResponse -> ShowS
$cshowsPrec :: Int -> WithdrawByoipCidrResponse -> ShowS
Prelude.Show, forall x.
Rep WithdrawByoipCidrResponse x -> WithdrawByoipCidrResponse
forall x.
WithdrawByoipCidrResponse -> Rep WithdrawByoipCidrResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep WithdrawByoipCidrResponse x -> WithdrawByoipCidrResponse
$cfrom :: forall x.
WithdrawByoipCidrResponse -> Rep WithdrawByoipCidrResponse x
Prelude.Generic)

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

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

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

instance Prelude.NFData WithdrawByoipCidrResponse where
  rnf :: WithdrawByoipCidrResponse -> ()
rnf WithdrawByoipCidrResponse' {Int
Maybe ByoipCidr
httpStatus :: Int
byoipCidr :: Maybe ByoipCidr
$sel:httpStatus:WithdrawByoipCidrResponse' :: WithdrawByoipCidrResponse -> Int
$sel:byoipCidr:WithdrawByoipCidrResponse' :: WithdrawByoipCidrResponse -> 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