{-# 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.Update
-- 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)
--
-- Updates the specified matter. This updates only the name and description of the matter, identified by matter ID. Changes to any other fields are ignored. Returns the default view of the matter.
--
-- /See:/ <https://developers.google.com/vault Google Vault API Reference> for @vault.matters.update@.
module Gogol.Vault.Matters.Update
  ( -- * Resource
    VaultMattersUpdateResource,

    -- ** Constructing a Request
    VaultMattersUpdate (..),
    newVaultMattersUpdate,
  )
where

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

-- | A resource alias for @vault.matters.update@ method which the
-- 'VaultMattersUpdate' request conforms to.
type VaultMattersUpdateResource =
  "v1"
    Core.:> "matters"
    Core.:> Core.Capture "matterId" 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.ReqBody '[Core.JSON] Matter
    Core.:> Core.Put '[Core.JSON] Matter

-- | Updates the specified matter. This updates only the name and description of the matter, identified by matter ID. Changes to any other fields are ignored. Returns the default view of the matter.
--
-- /See:/ 'newVaultMattersUpdate' smart constructor.
data VaultMattersUpdate = VaultMattersUpdate
  { -- | V1 error format.
    VaultMattersUpdate -> Maybe Xgafv
xgafv :: (Core.Maybe Xgafv),
    -- | OAuth access token.
    VaultMattersUpdate -> Maybe Text
accessToken :: (Core.Maybe Core.Text),
    -- | JSONP
    VaultMattersUpdate -> Maybe Text
callback :: (Core.Maybe Core.Text),
    -- | The matter ID.
    VaultMattersUpdate -> Text
matterId :: Core.Text,
    -- | Multipart request metadata.
    VaultMattersUpdate -> Matter
payload :: Matter,
    -- | Legacy upload protocol for media (e.g. \"media\", \"multipart\").
    VaultMattersUpdate -> Maybe Text
uploadType :: (Core.Maybe Core.Text),
    -- | Upload protocol for media (e.g. \"raw\", \"multipart\").
    VaultMattersUpdate -> Maybe Text
uploadProtocol :: (Core.Maybe Core.Text)
  }
  deriving (VaultMattersUpdate -> VaultMattersUpdate -> Bool
(VaultMattersUpdate -> VaultMattersUpdate -> Bool)
-> (VaultMattersUpdate -> VaultMattersUpdate -> Bool)
-> Eq VaultMattersUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VaultMattersUpdate -> VaultMattersUpdate -> Bool
== :: VaultMattersUpdate -> VaultMattersUpdate -> Bool
$c/= :: VaultMattersUpdate -> VaultMattersUpdate -> Bool
/= :: VaultMattersUpdate -> VaultMattersUpdate -> Bool
Core.Eq, Int -> VaultMattersUpdate -> ShowS
[VaultMattersUpdate] -> ShowS
VaultMattersUpdate -> String
(Int -> VaultMattersUpdate -> ShowS)
-> (VaultMattersUpdate -> String)
-> ([VaultMattersUpdate] -> ShowS)
-> Show VaultMattersUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VaultMattersUpdate -> ShowS
showsPrec :: Int -> VaultMattersUpdate -> ShowS
$cshow :: VaultMattersUpdate -> String
show :: VaultMattersUpdate -> String
$cshowList :: [VaultMattersUpdate] -> ShowS
showList :: [VaultMattersUpdate] -> ShowS
Core.Show, (forall x. VaultMattersUpdate -> Rep VaultMattersUpdate x)
-> (forall x. Rep VaultMattersUpdate x -> VaultMattersUpdate)
-> Generic VaultMattersUpdate
forall x. Rep VaultMattersUpdate x -> VaultMattersUpdate
forall x. VaultMattersUpdate -> Rep VaultMattersUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VaultMattersUpdate -> Rep VaultMattersUpdate x
from :: forall x. VaultMattersUpdate -> Rep VaultMattersUpdate x
$cto :: forall x. Rep VaultMattersUpdate x -> VaultMattersUpdate
to :: forall x. Rep VaultMattersUpdate x -> VaultMattersUpdate
Core.Generic)

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