{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- |
-- Module      : Gogol.Vault.Operations.Delete
-- Copyright   : (c) 2015-2025 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+gogol@gmail.com>
--               Toni Cebrián <toni@tonicebrian.com>
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a long-running operation. This method indicates that the client is no longer interested in the operation result. It does not cancel the operation. If the server doesn\'t support this method, it returns @google.rpc.Code.UNIMPLEMENTED@.
--
-- /See:/ <https://developers.google.com/vault Google Vault API Reference> for @vault.operations.delete@.
module Gogol.Vault.Operations.Delete
  ( -- * Resource
    VaultOperationsDeleteResource,

    -- ** Constructing a Request
    VaultOperationsDelete (..),
    newVaultOperationsDelete,
  )
where

import Gogol.Prelude qualified as Core
import Gogol.Vault.Types

-- | A resource alias for @vault.operations.delete@ method which the
-- 'VaultOperationsDelete' request conforms to.
type VaultOperationsDeleteResource =
  "v1"
    Core.:> Core.Capture "name" Core.Text
    Core.:> Core.QueryParam "$.xgafv" Xgafv
    Core.:> Core.QueryParam "access_token" Core.Text
    Core.:> Core.QueryParam "callback" Core.Text
    Core.:> Core.QueryParam "uploadType" Core.Text
    Core.:> Core.QueryParam "upload_protocol" Core.Text
    Core.:> Core.QueryParam "alt" Core.AltJSON
    Core.:> Core.Delete '[Core.JSON] Empty

-- | Deletes a long-running operation. This method indicates that the client is no longer interested in the operation result. It does not cancel the operation. If the server doesn\'t support this method, it returns @google.rpc.Code.UNIMPLEMENTED@.
--
-- /See:/ 'newVaultOperationsDelete' smart constructor.
data VaultOperationsDelete = VaultOperationsDelete
  { -- | V1 error format.
    VaultOperationsDelete -> Maybe Xgafv
xgafv :: (Core.Maybe Xgafv),
    -- | OAuth access token.
    VaultOperationsDelete -> Maybe Text
accessToken :: (Core.Maybe Core.Text),
    -- | JSONP
    VaultOperationsDelete -> Maybe Text
callback :: (Core.Maybe Core.Text),
    -- | The name of the operation resource to be deleted.
    VaultOperationsDelete -> Text
name :: Core.Text,
    -- | Legacy upload protocol for media (e.g. \"media\", \"multipart\").
    VaultOperationsDelete -> Maybe Text
uploadType :: (Core.Maybe Core.Text),
    -- | Upload protocol for media (e.g. \"raw\", \"multipart\").
    VaultOperationsDelete -> Maybe Text
uploadProtocol :: (Core.Maybe Core.Text)
  }
  deriving (VaultOperationsDelete -> VaultOperationsDelete -> Bool
(VaultOperationsDelete -> VaultOperationsDelete -> Bool)
-> (VaultOperationsDelete -> VaultOperationsDelete -> Bool)
-> Eq VaultOperationsDelete
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VaultOperationsDelete -> VaultOperationsDelete -> Bool
== :: VaultOperationsDelete -> VaultOperationsDelete -> Bool
$c/= :: VaultOperationsDelete -> VaultOperationsDelete -> Bool
/= :: VaultOperationsDelete -> VaultOperationsDelete -> Bool
Core.Eq, Int -> VaultOperationsDelete -> ShowS
[VaultOperationsDelete] -> ShowS
VaultOperationsDelete -> String
(Int -> VaultOperationsDelete -> ShowS)
-> (VaultOperationsDelete -> String)
-> ([VaultOperationsDelete] -> ShowS)
-> Show VaultOperationsDelete
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VaultOperationsDelete -> ShowS
showsPrec :: Int -> VaultOperationsDelete -> ShowS
$cshow :: VaultOperationsDelete -> String
show :: VaultOperationsDelete -> String
$cshowList :: [VaultOperationsDelete] -> ShowS
showList :: [VaultOperationsDelete] -> ShowS
Core.Show, (forall x. VaultOperationsDelete -> Rep VaultOperationsDelete x)
-> (forall x. Rep VaultOperationsDelete x -> VaultOperationsDelete)
-> Generic VaultOperationsDelete
forall x. Rep VaultOperationsDelete x -> VaultOperationsDelete
forall x. VaultOperationsDelete -> Rep VaultOperationsDelete x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VaultOperationsDelete -> Rep VaultOperationsDelete x
from :: forall x. VaultOperationsDelete -> Rep VaultOperationsDelete x
$cto :: forall x. Rep VaultOperationsDelete x -> VaultOperationsDelete
to :: forall x. Rep VaultOperationsDelete x -> VaultOperationsDelete
Core.Generic)

-- | Creates a value of 'VaultOperationsDelete' with the minimum fields required to make a request.
newVaultOperationsDelete ::
  -- |  The name of the operation resource to be deleted. See 'name'.
  Core.Text ->
  VaultOperationsDelete
newVaultOperationsDelete :: Text -> VaultOperationsDelete
newVaultOperationsDelete Text
name =
  VaultOperationsDelete
    { xgafv :: Maybe Xgafv
xgafv = Maybe Xgafv
forall a. Maybe a
Core.Nothing,
      accessToken :: Maybe Text
accessToken = Maybe Text
forall a. Maybe a
Core.Nothing,
      callback :: Maybe Text
callback = Maybe Text
forall a. Maybe a
Core.Nothing,
      name :: Text
name = Text
name,
      uploadType :: Maybe Text
uploadType = Maybe Text
forall a. Maybe a
Core.Nothing,
      uploadProtocol :: Maybe Text
uploadProtocol = Maybe Text
forall a. Maybe a
Core.Nothing
    }

instance Core.GoogleRequest VaultOperationsDelete where
  type Rs VaultOperationsDelete = Empty
  type Scopes VaultOperationsDelete = '[Ediscovery'FullControl]
  requestClient :: VaultOperationsDelete -> GClient (Rs VaultOperationsDelete)
requestClient VaultOperationsDelete {Maybe Text
Maybe Xgafv
Text
xgafv :: VaultOperationsDelete -> Maybe Xgafv
accessToken :: VaultOperationsDelete -> Maybe Text
callback :: VaultOperationsDelete -> Maybe Text
name :: VaultOperationsDelete -> Text
uploadType :: VaultOperationsDelete -> Maybe Text
uploadProtocol :: VaultOperationsDelete -> Maybe Text
xgafv :: Maybe Xgafv
accessToken :: Maybe Text
callback :: Maybe Text
name :: Text
uploadType :: Maybe Text
uploadProtocol :: Maybe Text
..} =
    Text
-> Maybe Xgafv
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe AltJSON
-> ServiceConfig
-> GClient Empty
go
      Text
name
      Maybe Xgafv
xgafv
      Maybe Text
accessToken
      Maybe Text
callback
      Maybe Text
uploadType
      Maybe Text
uploadProtocol
      (AltJSON -> Maybe AltJSON
forall a. a -> Maybe a
Core.Just AltJSON
Core.AltJSON)
      ServiceConfig
vaultService
    where
      go :: Fn VaultOperationsDeleteResource
go =
        Proxy VaultOperationsDeleteResource
-> Request -> Fn VaultOperationsDeleteResource
forall {k} (fn :: k).
GoogleClient fn =>
Proxy fn -> Request -> Fn fn
Core.buildClient
          (Proxy VaultOperationsDeleteResource
forall {k} (t :: k). Proxy t
Core.Proxy :: Core.Proxy VaultOperationsDeleteResource)
          Request
forall a. Monoid a => a
Core.mempty