{-# 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.DeleteCoipPool
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a pool of customer-owned IP (CoIP) addresses.
module Amazonka.EC2.DeleteCoipPool
  ( -- * Creating a Request
    DeleteCoipPool (..),
    newDeleteCoipPool,

    -- * Request Lenses
    deleteCoipPool_dryRun,
    deleteCoipPool_coipPoolId,

    -- * Destructuring the Response
    DeleteCoipPoolResponse (..),
    newDeleteCoipPoolResponse,

    -- * Response Lenses
    deleteCoipPoolResponse_coipPool,
    deleteCoipPoolResponse_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:/ 'newDeleteCoipPool' smart constructor.
data DeleteCoipPool = DeleteCoipPool'
  { -- | 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@.
    DeleteCoipPool -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the CoIP pool that you want to delete.
    DeleteCoipPool -> Text
coipPoolId :: Prelude.Text
  }
  deriving (DeleteCoipPool -> DeleteCoipPool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteCoipPool -> DeleteCoipPool -> Bool
$c/= :: DeleteCoipPool -> DeleteCoipPool -> Bool
== :: DeleteCoipPool -> DeleteCoipPool -> Bool
$c== :: DeleteCoipPool -> DeleteCoipPool -> Bool
Prelude.Eq, ReadPrec [DeleteCoipPool]
ReadPrec DeleteCoipPool
Int -> ReadS DeleteCoipPool
ReadS [DeleteCoipPool]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteCoipPool]
$creadListPrec :: ReadPrec [DeleteCoipPool]
readPrec :: ReadPrec DeleteCoipPool
$creadPrec :: ReadPrec DeleteCoipPool
readList :: ReadS [DeleteCoipPool]
$creadList :: ReadS [DeleteCoipPool]
readsPrec :: Int -> ReadS DeleteCoipPool
$creadsPrec :: Int -> ReadS DeleteCoipPool
Prelude.Read, Int -> DeleteCoipPool -> ShowS
[DeleteCoipPool] -> ShowS
DeleteCoipPool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteCoipPool] -> ShowS
$cshowList :: [DeleteCoipPool] -> ShowS
show :: DeleteCoipPool -> String
$cshow :: DeleteCoipPool -> String
showsPrec :: Int -> DeleteCoipPool -> ShowS
$cshowsPrec :: Int -> DeleteCoipPool -> ShowS
Prelude.Show, forall x. Rep DeleteCoipPool x -> DeleteCoipPool
forall x. DeleteCoipPool -> Rep DeleteCoipPool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteCoipPool x -> DeleteCoipPool
$cfrom :: forall x. DeleteCoipPool -> Rep DeleteCoipPool x
Prelude.Generic)

-- |
-- Create a value of 'DeleteCoipPool' 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', 'deleteCoipPool_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@.
--
-- 'coipPoolId', 'deleteCoipPool_coipPoolId' - The ID of the CoIP pool that you want to delete.
newDeleteCoipPool ::
  -- | 'coipPoolId'
  Prelude.Text ->
  DeleteCoipPool
newDeleteCoipPool :: Text -> DeleteCoipPool
newDeleteCoipPool Text
pCoipPoolId_ =
  DeleteCoipPool'
    { $sel:dryRun:DeleteCoipPool' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:coipPoolId:DeleteCoipPool' :: Text
coipPoolId = Text
pCoipPoolId_
    }

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

-- | The ID of the CoIP pool that you want to delete.
deleteCoipPool_coipPoolId :: Lens.Lens' DeleteCoipPool Prelude.Text
deleteCoipPool_coipPoolId :: Lens' DeleteCoipPool Text
deleteCoipPool_coipPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteCoipPool' {Text
coipPoolId :: Text
$sel:coipPoolId:DeleteCoipPool' :: DeleteCoipPool -> Text
coipPoolId} -> Text
coipPoolId) (\s :: DeleteCoipPool
s@DeleteCoipPool' {} Text
a -> DeleteCoipPool
s {$sel:coipPoolId:DeleteCoipPool' :: Text
coipPoolId = Text
a} :: DeleteCoipPool)

instance Core.AWSRequest DeleteCoipPool where
  type
    AWSResponse DeleteCoipPool =
      DeleteCoipPoolResponse
  request :: (Service -> Service) -> DeleteCoipPool -> Request DeleteCoipPool
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 DeleteCoipPool
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteCoipPool)))
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 CoipPool -> Int -> DeleteCoipPoolResponse
DeleteCoipPoolResponse'
            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
"coipPool")
            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 DeleteCoipPool where
  hashWithSalt :: Int -> DeleteCoipPool -> Int
hashWithSalt Int
_salt DeleteCoipPool' {Maybe Bool
Text
coipPoolId :: Text
dryRun :: Maybe Bool
$sel:coipPoolId:DeleteCoipPool' :: DeleteCoipPool -> Text
$sel:dryRun:DeleteCoipPool' :: DeleteCoipPool -> 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
coipPoolId

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

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

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

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

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

-- |
-- Create a value of 'DeleteCoipPoolResponse' 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:
--
-- 'coipPool', 'deleteCoipPoolResponse_coipPool' - Information about the CoIP address pool.
--
-- 'httpStatus', 'deleteCoipPoolResponse_httpStatus' - The response's http status code.
newDeleteCoipPoolResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteCoipPoolResponse
newDeleteCoipPoolResponse :: Int -> DeleteCoipPoolResponse
newDeleteCoipPoolResponse Int
pHttpStatus_ =
  DeleteCoipPoolResponse'
    { $sel:coipPool:DeleteCoipPoolResponse' :: Maybe CoipPool
coipPool = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteCoipPoolResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the CoIP address pool.
deleteCoipPoolResponse_coipPool :: Lens.Lens' DeleteCoipPoolResponse (Prelude.Maybe CoipPool)
deleteCoipPoolResponse_coipPool :: Lens' DeleteCoipPoolResponse (Maybe CoipPool)
deleteCoipPoolResponse_coipPool = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteCoipPoolResponse' {Maybe CoipPool
coipPool :: Maybe CoipPool
$sel:coipPool:DeleteCoipPoolResponse' :: DeleteCoipPoolResponse -> Maybe CoipPool
coipPool} -> Maybe CoipPool
coipPool) (\s :: DeleteCoipPoolResponse
s@DeleteCoipPoolResponse' {} Maybe CoipPool
a -> DeleteCoipPoolResponse
s {$sel:coipPool:DeleteCoipPoolResponse' :: Maybe CoipPool
coipPool = Maybe CoipPool
a} :: DeleteCoipPoolResponse)

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

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