{-# 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.DeleteClientVpnEndpoint
-- 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 Client VPN endpoint. You must disassociate all
-- target networks before you can delete a Client VPN endpoint.
module Amazonka.EC2.DeleteClientVpnEndpoint
  ( -- * Creating a Request
    DeleteClientVpnEndpoint (..),
    newDeleteClientVpnEndpoint,

    -- * Request Lenses
    deleteClientVpnEndpoint_dryRun,
    deleteClientVpnEndpoint_clientVpnEndpointId,

    -- * Destructuring the Response
    DeleteClientVpnEndpointResponse (..),
    newDeleteClientVpnEndpointResponse,

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

-- |
-- Create a value of 'DeleteClientVpnEndpoint' 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', 'deleteClientVpnEndpoint_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@.
--
-- 'clientVpnEndpointId', 'deleteClientVpnEndpoint_clientVpnEndpointId' - The ID of the Client VPN to be deleted.
newDeleteClientVpnEndpoint ::
  -- | 'clientVpnEndpointId'
  Prelude.Text ->
  DeleteClientVpnEndpoint
newDeleteClientVpnEndpoint :: Text -> DeleteClientVpnEndpoint
newDeleteClientVpnEndpoint Text
pClientVpnEndpointId_ =
  DeleteClientVpnEndpoint'
    { $sel:dryRun:DeleteClientVpnEndpoint' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:clientVpnEndpointId:DeleteClientVpnEndpoint' :: Text
clientVpnEndpointId = Text
pClientVpnEndpointId_
    }

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

-- | The ID of the Client VPN to be deleted.
deleteClientVpnEndpoint_clientVpnEndpointId :: Lens.Lens' DeleteClientVpnEndpoint Prelude.Text
deleteClientVpnEndpoint_clientVpnEndpointId :: Lens' DeleteClientVpnEndpoint Text
deleteClientVpnEndpoint_clientVpnEndpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteClientVpnEndpoint' {Text
clientVpnEndpointId :: Text
$sel:clientVpnEndpointId:DeleteClientVpnEndpoint' :: DeleteClientVpnEndpoint -> Text
clientVpnEndpointId} -> Text
clientVpnEndpointId) (\s :: DeleteClientVpnEndpoint
s@DeleteClientVpnEndpoint' {} Text
a -> DeleteClientVpnEndpoint
s {$sel:clientVpnEndpointId:DeleteClientVpnEndpoint' :: Text
clientVpnEndpointId = Text
a} :: DeleteClientVpnEndpoint)

instance Core.AWSRequest DeleteClientVpnEndpoint where
  type
    AWSResponse DeleteClientVpnEndpoint =
      DeleteClientVpnEndpointResponse
  request :: (Service -> Service)
-> DeleteClientVpnEndpoint -> Request DeleteClientVpnEndpoint
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 DeleteClientVpnEndpoint
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteClientVpnEndpoint)))
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 ClientVpnEndpointStatus
-> Int -> DeleteClientVpnEndpointResponse
DeleteClientVpnEndpointResponse'
            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
"status")
            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 DeleteClientVpnEndpoint where
  hashWithSalt :: Int -> DeleteClientVpnEndpoint -> Int
hashWithSalt Int
_salt DeleteClientVpnEndpoint' {Maybe Bool
Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
$sel:clientVpnEndpointId:DeleteClientVpnEndpoint' :: DeleteClientVpnEndpoint -> Text
$sel:dryRun:DeleteClientVpnEndpoint' :: DeleteClientVpnEndpoint -> 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
clientVpnEndpointId

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

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

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

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

-- | /See:/ 'newDeleteClientVpnEndpointResponse' smart constructor.
data DeleteClientVpnEndpointResponse = DeleteClientVpnEndpointResponse'
  { -- | The current state of the Client VPN endpoint.
    DeleteClientVpnEndpointResponse -> Maybe ClientVpnEndpointStatus
status :: Prelude.Maybe ClientVpnEndpointStatus,
    -- | The response's http status code.
    DeleteClientVpnEndpointResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteClientVpnEndpointResponse
-> DeleteClientVpnEndpointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteClientVpnEndpointResponse
-> DeleteClientVpnEndpointResponse -> Bool
$c/= :: DeleteClientVpnEndpointResponse
-> DeleteClientVpnEndpointResponse -> Bool
== :: DeleteClientVpnEndpointResponse
-> DeleteClientVpnEndpointResponse -> Bool
$c== :: DeleteClientVpnEndpointResponse
-> DeleteClientVpnEndpointResponse -> Bool
Prelude.Eq, ReadPrec [DeleteClientVpnEndpointResponse]
ReadPrec DeleteClientVpnEndpointResponse
Int -> ReadS DeleteClientVpnEndpointResponse
ReadS [DeleteClientVpnEndpointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteClientVpnEndpointResponse]
$creadListPrec :: ReadPrec [DeleteClientVpnEndpointResponse]
readPrec :: ReadPrec DeleteClientVpnEndpointResponse
$creadPrec :: ReadPrec DeleteClientVpnEndpointResponse
readList :: ReadS [DeleteClientVpnEndpointResponse]
$creadList :: ReadS [DeleteClientVpnEndpointResponse]
readsPrec :: Int -> ReadS DeleteClientVpnEndpointResponse
$creadsPrec :: Int -> ReadS DeleteClientVpnEndpointResponse
Prelude.Read, Int -> DeleteClientVpnEndpointResponse -> ShowS
[DeleteClientVpnEndpointResponse] -> ShowS
DeleteClientVpnEndpointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteClientVpnEndpointResponse] -> ShowS
$cshowList :: [DeleteClientVpnEndpointResponse] -> ShowS
show :: DeleteClientVpnEndpointResponse -> String
$cshow :: DeleteClientVpnEndpointResponse -> String
showsPrec :: Int -> DeleteClientVpnEndpointResponse -> ShowS
$cshowsPrec :: Int -> DeleteClientVpnEndpointResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteClientVpnEndpointResponse x
-> DeleteClientVpnEndpointResponse
forall x.
DeleteClientVpnEndpointResponse
-> Rep DeleteClientVpnEndpointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteClientVpnEndpointResponse x
-> DeleteClientVpnEndpointResponse
$cfrom :: forall x.
DeleteClientVpnEndpointResponse
-> Rep DeleteClientVpnEndpointResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteClientVpnEndpointResponse' 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:
--
-- 'status', 'deleteClientVpnEndpointResponse_status' - The current state of the Client VPN endpoint.
--
-- 'httpStatus', 'deleteClientVpnEndpointResponse_httpStatus' - The response's http status code.
newDeleteClientVpnEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteClientVpnEndpointResponse
newDeleteClientVpnEndpointResponse :: Int -> DeleteClientVpnEndpointResponse
newDeleteClientVpnEndpointResponse Int
pHttpStatus_ =
  DeleteClientVpnEndpointResponse'
    { $sel:status:DeleteClientVpnEndpointResponse' :: Maybe ClientVpnEndpointStatus
status =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteClientVpnEndpointResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The current state of the Client VPN endpoint.
deleteClientVpnEndpointResponse_status :: Lens.Lens' DeleteClientVpnEndpointResponse (Prelude.Maybe ClientVpnEndpointStatus)
deleteClientVpnEndpointResponse_status :: Lens'
  DeleteClientVpnEndpointResponse (Maybe ClientVpnEndpointStatus)
deleteClientVpnEndpointResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteClientVpnEndpointResponse' {Maybe ClientVpnEndpointStatus
status :: Maybe ClientVpnEndpointStatus
$sel:status:DeleteClientVpnEndpointResponse' :: DeleteClientVpnEndpointResponse -> Maybe ClientVpnEndpointStatus
status} -> Maybe ClientVpnEndpointStatus
status) (\s :: DeleteClientVpnEndpointResponse
s@DeleteClientVpnEndpointResponse' {} Maybe ClientVpnEndpointStatus
a -> DeleteClientVpnEndpointResponse
s {$sel:status:DeleteClientVpnEndpointResponse' :: Maybe ClientVpnEndpointStatus
status = Maybe ClientVpnEndpointStatus
a} :: DeleteClientVpnEndpointResponse)

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

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