{-# 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.DeleteIpamScope
-- 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 the scope for an IPAM. You cannot delete the default scopes.
--
-- For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/delete-scope-ipam.html Delete a scope>
-- in the /Amazon VPC IPAM User Guide/.
module Amazonka.EC2.DeleteIpamScope
  ( -- * Creating a Request
    DeleteIpamScope (..),
    newDeleteIpamScope,

    -- * Request Lenses
    deleteIpamScope_dryRun,
    deleteIpamScope_ipamScopeId,

    -- * Destructuring the Response
    DeleteIpamScopeResponse (..),
    newDeleteIpamScopeResponse,

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

-- |
-- Create a value of 'DeleteIpamScope' 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', 'deleteIpamScope_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@.
--
-- 'ipamScopeId', 'deleteIpamScope_ipamScopeId' - The ID of the scope to delete.
newDeleteIpamScope ::
  -- | 'ipamScopeId'
  Prelude.Text ->
  DeleteIpamScope
newDeleteIpamScope :: Text -> DeleteIpamScope
newDeleteIpamScope Text
pIpamScopeId_ =
  DeleteIpamScope'
    { $sel:dryRun:DeleteIpamScope' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:ipamScopeId:DeleteIpamScope' :: Text
ipamScopeId = Text
pIpamScopeId_
    }

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

-- | The ID of the scope to delete.
deleteIpamScope_ipamScopeId :: Lens.Lens' DeleteIpamScope Prelude.Text
deleteIpamScope_ipamScopeId :: Lens' DeleteIpamScope Text
deleteIpamScope_ipamScopeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIpamScope' {Text
ipamScopeId :: Text
$sel:ipamScopeId:DeleteIpamScope' :: DeleteIpamScope -> Text
ipamScopeId} -> Text
ipamScopeId) (\s :: DeleteIpamScope
s@DeleteIpamScope' {} Text
a -> DeleteIpamScope
s {$sel:ipamScopeId:DeleteIpamScope' :: Text
ipamScopeId = Text
a} :: DeleteIpamScope)

instance Core.AWSRequest DeleteIpamScope where
  type
    AWSResponse DeleteIpamScope =
      DeleteIpamScopeResponse
  request :: (Service -> Service) -> DeleteIpamScope -> Request DeleteIpamScope
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 DeleteIpamScope
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteIpamScope)))
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 IpamScope -> Int -> DeleteIpamScopeResponse
DeleteIpamScopeResponse'
            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
"ipamScope")
            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 DeleteIpamScope where
  hashWithSalt :: Int -> DeleteIpamScope -> Int
hashWithSalt Int
_salt DeleteIpamScope' {Maybe Bool
Text
ipamScopeId :: Text
dryRun :: Maybe Bool
$sel:ipamScopeId:DeleteIpamScope' :: DeleteIpamScope -> Text
$sel:dryRun:DeleteIpamScope' :: DeleteIpamScope -> 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
ipamScopeId

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

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

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

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

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

-- |
-- Create a value of 'DeleteIpamScopeResponse' 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:
--
-- 'ipamScope', 'deleteIpamScopeResponse_ipamScope' - Information about the results of the deletion.
--
-- 'httpStatus', 'deleteIpamScopeResponse_httpStatus' - The response's http status code.
newDeleteIpamScopeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteIpamScopeResponse
newDeleteIpamScopeResponse :: Int -> DeleteIpamScopeResponse
newDeleteIpamScopeResponse Int
pHttpStatus_ =
  DeleteIpamScopeResponse'
    { $sel:ipamScope:DeleteIpamScopeResponse' :: Maybe IpamScope
ipamScope =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteIpamScopeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the results of the deletion.
deleteIpamScopeResponse_ipamScope :: Lens.Lens' DeleteIpamScopeResponse (Prelude.Maybe IpamScope)
deleteIpamScopeResponse_ipamScope :: Lens' DeleteIpamScopeResponse (Maybe IpamScope)
deleteIpamScopeResponse_ipamScope = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIpamScopeResponse' {Maybe IpamScope
ipamScope :: Maybe IpamScope
$sel:ipamScope:DeleteIpamScopeResponse' :: DeleteIpamScopeResponse -> Maybe IpamScope
ipamScope} -> Maybe IpamScope
ipamScope) (\s :: DeleteIpamScopeResponse
s@DeleteIpamScopeResponse' {} Maybe IpamScope
a -> DeleteIpamScopeResponse
s {$sel:ipamScope:DeleteIpamScopeResponse' :: Maybe IpamScope
ipamScope = Maybe IpamScope
a} :: DeleteIpamScopeResponse)

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

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