{-# 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.EFS.DeleteAccessPoint
-- 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 the specified access point. After deletion is complete, new
-- clients can no longer connect to the access points. Clients connected to
-- the access point at the time of deletion will continue to function until
-- they terminate their connection.
--
-- This operation requires permissions for the
-- @elasticfilesystem:DeleteAccessPoint@ action.
module Amazonka.EFS.DeleteAccessPoint
  ( -- * Creating a Request
    DeleteAccessPoint (..),
    newDeleteAccessPoint,

    -- * Request Lenses
    deleteAccessPoint_accessPointId,

    -- * Destructuring the Response
    DeleteAccessPointResponse (..),
    newDeleteAccessPointResponse,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EFS.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDeleteAccessPoint' smart constructor.
data DeleteAccessPoint = DeleteAccessPoint'
  { -- | The ID of the access point that you want to delete.
    DeleteAccessPoint -> Text
accessPointId :: Prelude.Text
  }
  deriving (DeleteAccessPoint -> DeleteAccessPoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteAccessPoint -> DeleteAccessPoint -> Bool
$c/= :: DeleteAccessPoint -> DeleteAccessPoint -> Bool
== :: DeleteAccessPoint -> DeleteAccessPoint -> Bool
$c== :: DeleteAccessPoint -> DeleteAccessPoint -> Bool
Prelude.Eq, ReadPrec [DeleteAccessPoint]
ReadPrec DeleteAccessPoint
Int -> ReadS DeleteAccessPoint
ReadS [DeleteAccessPoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteAccessPoint]
$creadListPrec :: ReadPrec [DeleteAccessPoint]
readPrec :: ReadPrec DeleteAccessPoint
$creadPrec :: ReadPrec DeleteAccessPoint
readList :: ReadS [DeleteAccessPoint]
$creadList :: ReadS [DeleteAccessPoint]
readsPrec :: Int -> ReadS DeleteAccessPoint
$creadsPrec :: Int -> ReadS DeleteAccessPoint
Prelude.Read, Int -> DeleteAccessPoint -> ShowS
[DeleteAccessPoint] -> ShowS
DeleteAccessPoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteAccessPoint] -> ShowS
$cshowList :: [DeleteAccessPoint] -> ShowS
show :: DeleteAccessPoint -> String
$cshow :: DeleteAccessPoint -> String
showsPrec :: Int -> DeleteAccessPoint -> ShowS
$cshowsPrec :: Int -> DeleteAccessPoint -> ShowS
Prelude.Show, forall x. Rep DeleteAccessPoint x -> DeleteAccessPoint
forall x. DeleteAccessPoint -> Rep DeleteAccessPoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteAccessPoint x -> DeleteAccessPoint
$cfrom :: forall x. DeleteAccessPoint -> Rep DeleteAccessPoint x
Prelude.Generic)

-- |
-- Create a value of 'DeleteAccessPoint' 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:
--
-- 'accessPointId', 'deleteAccessPoint_accessPointId' - The ID of the access point that you want to delete.
newDeleteAccessPoint ::
  -- | 'accessPointId'
  Prelude.Text ->
  DeleteAccessPoint
newDeleteAccessPoint :: Text -> DeleteAccessPoint
newDeleteAccessPoint Text
pAccessPointId_ =
  DeleteAccessPoint' {$sel:accessPointId:DeleteAccessPoint' :: Text
accessPointId = Text
pAccessPointId_}

-- | The ID of the access point that you want to delete.
deleteAccessPoint_accessPointId :: Lens.Lens' DeleteAccessPoint Prelude.Text
deleteAccessPoint_accessPointId :: Lens' DeleteAccessPoint Text
deleteAccessPoint_accessPointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAccessPoint' {Text
accessPointId :: Text
$sel:accessPointId:DeleteAccessPoint' :: DeleteAccessPoint -> Text
accessPointId} -> Text
accessPointId) (\s :: DeleteAccessPoint
s@DeleteAccessPoint' {} Text
a -> DeleteAccessPoint
s {$sel:accessPointId:DeleteAccessPoint' :: Text
accessPointId = Text
a} :: DeleteAccessPoint)

instance Core.AWSRequest DeleteAccessPoint where
  type
    AWSResponse DeleteAccessPoint =
      DeleteAccessPointResponse
  request :: (Service -> Service)
-> DeleteAccessPoint -> Request DeleteAccessPoint
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteAccessPoint
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteAccessPoint)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteAccessPointResponse
DeleteAccessPointResponse'

instance Prelude.Hashable DeleteAccessPoint where
  hashWithSalt :: Int -> DeleteAccessPoint -> Int
hashWithSalt Int
_salt DeleteAccessPoint' {Text
accessPointId :: Text
$sel:accessPointId:DeleteAccessPoint' :: DeleteAccessPoint -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accessPointId

instance Prelude.NFData DeleteAccessPoint where
  rnf :: DeleteAccessPoint -> ()
rnf DeleteAccessPoint' {Text
accessPointId :: Text
$sel:accessPointId:DeleteAccessPoint' :: DeleteAccessPoint -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
accessPointId

instance Data.ToHeaders DeleteAccessPoint where
  toHeaders :: DeleteAccessPoint -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DeleteAccessPoint where
  toPath :: DeleteAccessPoint -> ByteString
toPath DeleteAccessPoint' {Text
accessPointId :: Text
$sel:accessPointId:DeleteAccessPoint' :: DeleteAccessPoint -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2015-02-01/access-points/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
accessPointId
      ]

instance Data.ToQuery DeleteAccessPoint where
  toQuery :: DeleteAccessPoint -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newDeleteAccessPointResponse' smart constructor.
data DeleteAccessPointResponse = DeleteAccessPointResponse'
  {
  }
  deriving (DeleteAccessPointResponse -> DeleteAccessPointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteAccessPointResponse -> DeleteAccessPointResponse -> Bool
$c/= :: DeleteAccessPointResponse -> DeleteAccessPointResponse -> Bool
== :: DeleteAccessPointResponse -> DeleteAccessPointResponse -> Bool
$c== :: DeleteAccessPointResponse -> DeleteAccessPointResponse -> Bool
Prelude.Eq, ReadPrec [DeleteAccessPointResponse]
ReadPrec DeleteAccessPointResponse
Int -> ReadS DeleteAccessPointResponse
ReadS [DeleteAccessPointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteAccessPointResponse]
$creadListPrec :: ReadPrec [DeleteAccessPointResponse]
readPrec :: ReadPrec DeleteAccessPointResponse
$creadPrec :: ReadPrec DeleteAccessPointResponse
readList :: ReadS [DeleteAccessPointResponse]
$creadList :: ReadS [DeleteAccessPointResponse]
readsPrec :: Int -> ReadS DeleteAccessPointResponse
$creadsPrec :: Int -> ReadS DeleteAccessPointResponse
Prelude.Read, Int -> DeleteAccessPointResponse -> ShowS
[DeleteAccessPointResponse] -> ShowS
DeleteAccessPointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteAccessPointResponse] -> ShowS
$cshowList :: [DeleteAccessPointResponse] -> ShowS
show :: DeleteAccessPointResponse -> String
$cshow :: DeleteAccessPointResponse -> String
showsPrec :: Int -> DeleteAccessPointResponse -> ShowS
$cshowsPrec :: Int -> DeleteAccessPointResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteAccessPointResponse x -> DeleteAccessPointResponse
forall x.
DeleteAccessPointResponse -> Rep DeleteAccessPointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteAccessPointResponse x -> DeleteAccessPointResponse
$cfrom :: forall x.
DeleteAccessPointResponse -> Rep DeleteAccessPointResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteAccessPointResponse' 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.
newDeleteAccessPointResponse ::
  DeleteAccessPointResponse
newDeleteAccessPointResponse :: DeleteAccessPointResponse
newDeleteAccessPointResponse =
  DeleteAccessPointResponse
DeleteAccessPointResponse'

instance Prelude.NFData DeleteAccessPointResponse where
  rnf :: DeleteAccessPointResponse -> ()
rnf DeleteAccessPointResponse
_ = ()