{-# 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.DeleteIpam
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Delete an IPAM. Deleting an IPAM removes all monitored data associated
-- with the IPAM including the historical data for CIDRs.
--
-- For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/delete-ipam.html Delete an IPAM>
-- in the /Amazon VPC IPAM User Guide/.
module Amazonka.EC2.DeleteIpam
  ( -- * Creating a Request
    DeleteIpam (..),
    newDeleteIpam,

    -- * Request Lenses
    deleteIpam_cascade,
    deleteIpam_dryRun,
    deleteIpam_ipamId,

    -- * Destructuring the Response
    DeleteIpamResponse (..),
    newDeleteIpamResponse,

    -- * Response Lenses
    deleteIpamResponse_ipam,
    deleteIpamResponse_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:/ 'newDeleteIpam' smart constructor.
data DeleteIpam = DeleteIpam'
  { -- | Enables you to quickly delete an IPAM, private scopes, pools in private
    -- scopes, and any allocations in the pools in private scopes. You cannot
    -- delete the IPAM with this option if there is a pool in your public
    -- scope. If you use this option, IPAM does the following:
    --
    -- -   Deallocates any CIDRs allocated to VPC resources (such as VPCs) in
    --     pools in private scopes.
    --
    --     No VPC resources are deleted as a result of enabling this option.
    --     The CIDR associated with the resource will no longer be allocated
    --     from an IPAM pool, but the CIDR itself will remain unchanged.
    --
    -- -   Deprovisions all IPv4 CIDRs provisioned to IPAM pools in private
    --     scopes.
    --
    -- -   Deletes all IPAM pools in private scopes.
    --
    -- -   Deletes all non-default private scopes in the IPAM.
    --
    -- -   Deletes the default public and private scopes and the IPAM.
    DeleteIpam -> Maybe Bool
cascade :: Prelude.Maybe Prelude.Bool,
    -- | 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@.
    DeleteIpam -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the IPAM to delete.
    DeleteIpam -> Text
ipamId :: Prelude.Text
  }
  deriving (DeleteIpam -> DeleteIpam -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteIpam -> DeleteIpam -> Bool
$c/= :: DeleteIpam -> DeleteIpam -> Bool
== :: DeleteIpam -> DeleteIpam -> Bool
$c== :: DeleteIpam -> DeleteIpam -> Bool
Prelude.Eq, ReadPrec [DeleteIpam]
ReadPrec DeleteIpam
Int -> ReadS DeleteIpam
ReadS [DeleteIpam]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteIpam]
$creadListPrec :: ReadPrec [DeleteIpam]
readPrec :: ReadPrec DeleteIpam
$creadPrec :: ReadPrec DeleteIpam
readList :: ReadS [DeleteIpam]
$creadList :: ReadS [DeleteIpam]
readsPrec :: Int -> ReadS DeleteIpam
$creadsPrec :: Int -> ReadS DeleteIpam
Prelude.Read, Int -> DeleteIpam -> ShowS
[DeleteIpam] -> ShowS
DeleteIpam -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteIpam] -> ShowS
$cshowList :: [DeleteIpam] -> ShowS
show :: DeleteIpam -> String
$cshow :: DeleteIpam -> String
showsPrec :: Int -> DeleteIpam -> ShowS
$cshowsPrec :: Int -> DeleteIpam -> ShowS
Prelude.Show, forall x. Rep DeleteIpam x -> DeleteIpam
forall x. DeleteIpam -> Rep DeleteIpam x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteIpam x -> DeleteIpam
$cfrom :: forall x. DeleteIpam -> Rep DeleteIpam x
Prelude.Generic)

-- |
-- Create a value of 'DeleteIpam' 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:
--
-- 'cascade', 'deleteIpam_cascade' - Enables you to quickly delete an IPAM, private scopes, pools in private
-- scopes, and any allocations in the pools in private scopes. You cannot
-- delete the IPAM with this option if there is a pool in your public
-- scope. If you use this option, IPAM does the following:
--
-- -   Deallocates any CIDRs allocated to VPC resources (such as VPCs) in
--     pools in private scopes.
--
--     No VPC resources are deleted as a result of enabling this option.
--     The CIDR associated with the resource will no longer be allocated
--     from an IPAM pool, but the CIDR itself will remain unchanged.
--
-- -   Deprovisions all IPv4 CIDRs provisioned to IPAM pools in private
--     scopes.
--
-- -   Deletes all IPAM pools in private scopes.
--
-- -   Deletes all non-default private scopes in the IPAM.
--
-- -   Deletes the default public and private scopes and the IPAM.
--
-- 'dryRun', 'deleteIpam_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@.
--
-- 'ipamId', 'deleteIpam_ipamId' - The ID of the IPAM to delete.
newDeleteIpam ::
  -- | 'ipamId'
  Prelude.Text ->
  DeleteIpam
newDeleteIpam :: Text -> DeleteIpam
newDeleteIpam Text
pIpamId_ =
  DeleteIpam'
    { $sel:cascade:DeleteIpam' :: Maybe Bool
cascade = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:DeleteIpam' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:ipamId:DeleteIpam' :: Text
ipamId = Text
pIpamId_
    }

-- | Enables you to quickly delete an IPAM, private scopes, pools in private
-- scopes, and any allocations in the pools in private scopes. You cannot
-- delete the IPAM with this option if there is a pool in your public
-- scope. If you use this option, IPAM does the following:
--
-- -   Deallocates any CIDRs allocated to VPC resources (such as VPCs) in
--     pools in private scopes.
--
--     No VPC resources are deleted as a result of enabling this option.
--     The CIDR associated with the resource will no longer be allocated
--     from an IPAM pool, but the CIDR itself will remain unchanged.
--
-- -   Deprovisions all IPv4 CIDRs provisioned to IPAM pools in private
--     scopes.
--
-- -   Deletes all IPAM pools in private scopes.
--
-- -   Deletes all non-default private scopes in the IPAM.
--
-- -   Deletes the default public and private scopes and the IPAM.
deleteIpam_cascade :: Lens.Lens' DeleteIpam (Prelude.Maybe Prelude.Bool)
deleteIpam_cascade :: Lens' DeleteIpam (Maybe Bool)
deleteIpam_cascade = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIpam' {Maybe Bool
cascade :: Maybe Bool
$sel:cascade:DeleteIpam' :: DeleteIpam -> Maybe Bool
cascade} -> Maybe Bool
cascade) (\s :: DeleteIpam
s@DeleteIpam' {} Maybe Bool
a -> DeleteIpam
s {$sel:cascade:DeleteIpam' :: Maybe Bool
cascade = Maybe Bool
a} :: DeleteIpam)

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

-- | The ID of the IPAM to delete.
deleteIpam_ipamId :: Lens.Lens' DeleteIpam Prelude.Text
deleteIpam_ipamId :: Lens' DeleteIpam Text
deleteIpam_ipamId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIpam' {Text
ipamId :: Text
$sel:ipamId:DeleteIpam' :: DeleteIpam -> Text
ipamId} -> Text
ipamId) (\s :: DeleteIpam
s@DeleteIpam' {} Text
a -> DeleteIpam
s {$sel:ipamId:DeleteIpam' :: Text
ipamId = Text
a} :: DeleteIpam)

instance Core.AWSRequest DeleteIpam where
  type AWSResponse DeleteIpam = DeleteIpamResponse
  request :: (Service -> Service) -> DeleteIpam -> Request DeleteIpam
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 DeleteIpam
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteIpam)))
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 Ipam -> Int -> DeleteIpamResponse
DeleteIpamResponse'
            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
"ipam")
            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 DeleteIpam where
  hashWithSalt :: Int -> DeleteIpam -> Int
hashWithSalt Int
_salt DeleteIpam' {Maybe Bool
Text
ipamId :: Text
dryRun :: Maybe Bool
cascade :: Maybe Bool
$sel:ipamId:DeleteIpam' :: DeleteIpam -> Text
$sel:dryRun:DeleteIpam' :: DeleteIpam -> Maybe Bool
$sel:cascade:DeleteIpam' :: DeleteIpam -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
cascade
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ipamId

instance Prelude.NFData DeleteIpam where
  rnf :: DeleteIpam -> ()
rnf DeleteIpam' {Maybe Bool
Text
ipamId :: Text
dryRun :: Maybe Bool
cascade :: Maybe Bool
$sel:ipamId:DeleteIpam' :: DeleteIpam -> Text
$sel:dryRun:DeleteIpam' :: DeleteIpam -> Maybe Bool
$sel:cascade:DeleteIpam' :: DeleteIpam -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
cascade
      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 Text
ipamId

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

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

instance Data.ToQuery DeleteIpam where
  toQuery :: DeleteIpam -> QueryString
toQuery DeleteIpam' {Maybe Bool
Text
ipamId :: Text
dryRun :: Maybe Bool
cascade :: Maybe Bool
$sel:ipamId:DeleteIpam' :: DeleteIpam -> Text
$sel:dryRun:DeleteIpam' :: DeleteIpam -> Maybe Bool
$sel:cascade:DeleteIpam' :: DeleteIpam -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteIpam" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"Cascade" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
cascade,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"IpamId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
ipamId
      ]

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

-- |
-- Create a value of 'DeleteIpamResponse' 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:
--
-- 'ipam', 'deleteIpamResponse_ipam' - Information about the results of the deletion.
--
-- 'httpStatus', 'deleteIpamResponse_httpStatus' - The response's http status code.
newDeleteIpamResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteIpamResponse
newDeleteIpamResponse :: Int -> DeleteIpamResponse
newDeleteIpamResponse Int
pHttpStatus_ =
  DeleteIpamResponse'
    { $sel:ipam:DeleteIpamResponse' :: Maybe Ipam
ipam = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteIpamResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the results of the deletion.
deleteIpamResponse_ipam :: Lens.Lens' DeleteIpamResponse (Prelude.Maybe Ipam)
deleteIpamResponse_ipam :: Lens' DeleteIpamResponse (Maybe Ipam)
deleteIpamResponse_ipam = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIpamResponse' {Maybe Ipam
ipam :: Maybe Ipam
$sel:ipam:DeleteIpamResponse' :: DeleteIpamResponse -> Maybe Ipam
ipam} -> Maybe Ipam
ipam) (\s :: DeleteIpamResponse
s@DeleteIpamResponse' {} Maybe Ipam
a -> DeleteIpamResponse
s {$sel:ipam:DeleteIpamResponse' :: Maybe Ipam
ipam = Maybe Ipam
a} :: DeleteIpamResponse)

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

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