{-# 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.Matters.Holds.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)
--
-- Removes the specified hold and releases the accounts or organizational unit covered by the hold. If the data is not preserved by another hold or retention rule, it might be purged.
--
-- /See:/ <https://developers.google.com/vault Google Vault API Reference> for @vault.matters.holds.delete@.
module Gogol.Vault.Matters.Holds.Delete
  ( -- * Resource
    VaultMattersHoldsDeleteResource,

    -- ** Constructing a Request
    VaultMattersHoldsDelete (..),
    newVaultMattersHoldsDelete,
  )
where

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

-- | A resource alias for @vault.matters.holds.delete@ method which the
-- 'VaultMattersHoldsDelete' request conforms to.
type VaultMattersHoldsDeleteResource =
  "v1"
    Core.:> "matters"
    Core.:> Core.Capture "matterId" Core.Text
    Core.:> "holds"
    Core.:> Core.Capture "holdId" 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

-- | Removes the specified hold and releases the accounts or organizational unit covered by the hold. If the data is not preserved by another hold or retention rule, it might be purged.
--
-- /See:/ 'newVaultMattersHoldsDelete' smart constructor.
data VaultMattersHoldsDelete = VaultMattersHoldsDelete
  { -- | V1 error format.
    VaultMattersHoldsDelete -> Maybe Xgafv
xgafv :: (Core.Maybe Xgafv),
    -- | OAuth access token.
    VaultMattersHoldsDelete -> Maybe Text
accessToken :: (Core.Maybe Core.Text),
    -- | JSONP
    VaultMattersHoldsDelete -> Maybe Text
callback :: (Core.Maybe Core.Text),
    -- | The hold ID.
    VaultMattersHoldsDelete -> Text
holdId :: Core.Text,
    -- | The matter ID.
    VaultMattersHoldsDelete -> Text
matterId :: Core.Text,
    -- | Legacy upload protocol for media (e.g. \"media\", \"multipart\").
    VaultMattersHoldsDelete -> Maybe Text
uploadType :: (Core.Maybe Core.Text),
    -- | Upload protocol for media (e.g. \"raw\", \"multipart\").
    VaultMattersHoldsDelete -> Maybe Text
uploadProtocol :: (Core.Maybe Core.Text)
  }
  deriving (VaultMattersHoldsDelete -> VaultMattersHoldsDelete -> Bool
(VaultMattersHoldsDelete -> VaultMattersHoldsDelete -> Bool)
-> (VaultMattersHoldsDelete -> VaultMattersHoldsDelete -> Bool)
-> Eq VaultMattersHoldsDelete
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VaultMattersHoldsDelete -> VaultMattersHoldsDelete -> Bool
== :: VaultMattersHoldsDelete -> VaultMattersHoldsDelete -> Bool
$c/= :: VaultMattersHoldsDelete -> VaultMattersHoldsDelete -> Bool
/= :: VaultMattersHoldsDelete -> VaultMattersHoldsDelete -> Bool
Core.Eq, Int -> VaultMattersHoldsDelete -> ShowS
[VaultMattersHoldsDelete] -> ShowS
VaultMattersHoldsDelete -> String
(Int -> VaultMattersHoldsDelete -> ShowS)
-> (VaultMattersHoldsDelete -> String)
-> ([VaultMattersHoldsDelete] -> ShowS)
-> Show VaultMattersHoldsDelete
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VaultMattersHoldsDelete -> ShowS
showsPrec :: Int -> VaultMattersHoldsDelete -> ShowS
$cshow :: VaultMattersHoldsDelete -> String
show :: VaultMattersHoldsDelete -> String
$cshowList :: [VaultMattersHoldsDelete] -> ShowS
showList :: [VaultMattersHoldsDelete] -> ShowS
Core.Show, (forall x.
 VaultMattersHoldsDelete -> Rep VaultMattersHoldsDelete x)
-> (forall x.
    Rep VaultMattersHoldsDelete x -> VaultMattersHoldsDelete)
-> Generic VaultMattersHoldsDelete
forall x. Rep VaultMattersHoldsDelete x -> VaultMattersHoldsDelete
forall x. VaultMattersHoldsDelete -> Rep VaultMattersHoldsDelete x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VaultMattersHoldsDelete -> Rep VaultMattersHoldsDelete x
from :: forall x. VaultMattersHoldsDelete -> Rep VaultMattersHoldsDelete x
$cto :: forall x. Rep VaultMattersHoldsDelete x -> VaultMattersHoldsDelete
to :: forall x. Rep VaultMattersHoldsDelete x -> VaultMattersHoldsDelete
Core.Generic)

-- | Creates a value of 'VaultMattersHoldsDelete' with the minimum fields required to make a request.
newVaultMattersHoldsDelete ::
  -- |  The hold ID. See 'holdId'.
  Core.Text ->
  -- |  The matter ID. See 'matterId'.
  Core.Text ->
  VaultMattersHoldsDelete
newVaultMattersHoldsDelete :: Text -> Text -> VaultMattersHoldsDelete
newVaultMattersHoldsDelete Text
holdId Text
matterId =
  VaultMattersHoldsDelete
    { 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,
      holdId :: Text
holdId = Text
holdId,
      matterId :: Text
matterId = Text
matterId,
      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 VaultMattersHoldsDelete where
  type Rs VaultMattersHoldsDelete = Empty
  type Scopes VaultMattersHoldsDelete = '[Ediscovery'FullControl]
  requestClient :: VaultMattersHoldsDelete -> GClient (Rs VaultMattersHoldsDelete)
requestClient VaultMattersHoldsDelete {Maybe Text
Maybe Xgafv
Text
xgafv :: VaultMattersHoldsDelete -> Maybe Xgafv
accessToken :: VaultMattersHoldsDelete -> Maybe Text
callback :: VaultMattersHoldsDelete -> Maybe Text
holdId :: VaultMattersHoldsDelete -> Text
matterId :: VaultMattersHoldsDelete -> Text
uploadType :: VaultMattersHoldsDelete -> Maybe Text
uploadProtocol :: VaultMattersHoldsDelete -> Maybe Text
xgafv :: Maybe Xgafv
accessToken :: Maybe Text
callback :: Maybe Text
holdId :: Text
matterId :: Text
uploadType :: Maybe Text
uploadProtocol :: Maybe Text
..} =
    Text
-> Text
-> Maybe Xgafv
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe AltJSON
-> ServiceConfig
-> GClient Empty
go
      Text
matterId
      Text
holdId
      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 VaultMattersHoldsDeleteResource
go =
        Proxy VaultMattersHoldsDeleteResource
-> Request -> Fn VaultMattersHoldsDeleteResource
forall {k} (fn :: k).
GoogleClient fn =>
Proxy fn -> Request -> Fn fn
Core.buildClient
          (Proxy VaultMattersHoldsDeleteResource
forall {k} (t :: k). Proxy t
Core.Proxy :: Core.Proxy VaultMattersHoldsDeleteResource)
          Request
forall a. Monoid a => a
Core.mempty