{-# 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.Internal.Product
-- 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)
module Gogol.Vault.Internal.Product
  ( -- * AccountCount
    AccountCount (..),
    newAccountCount,

    -- * AccountCountError
    AccountCountError (..),
    newAccountCountError,

    -- * AccountInfo
    AccountInfo (..),
    newAccountInfo,

    -- * AddHeldAccountResult
    AddHeldAccountResult (..),
    newAddHeldAccountResult,

    -- * AddHeldAccountsRequest
    AddHeldAccountsRequest (..),
    newAddHeldAccountsRequest,

    -- * AddHeldAccountsResponse
    AddHeldAccountsResponse (..),
    newAddHeldAccountsResponse,

    -- * AddMatterPermissionsRequest
    AddMatterPermissionsRequest (..),
    newAddMatterPermissionsRequest,

    -- * CalendarExportOptions
    CalendarExportOptions (..),
    newCalendarExportOptions,

    -- * CalendarOptions
    CalendarOptions (..),
    newCalendarOptions,

    -- * CancelOperationRequest
    CancelOperationRequest (..),
    newCancelOperationRequest,

    -- * CloseMatterRequest
    CloseMatterRequest (..),
    newCloseMatterRequest,

    -- * CloseMatterResponse
    CloseMatterResponse (..),
    newCloseMatterResponse,

    -- * CloudStorageFile
    CloudStorageFile (..),
    newCloudStorageFile,

    -- * CloudStorageSink
    CloudStorageSink (..),
    newCloudStorageSink,

    -- * CorpusQuery
    CorpusQuery (..),
    newCorpusQuery,

    -- * CountArtifactsMetadata
    CountArtifactsMetadata (..),
    newCountArtifactsMetadata,

    -- * CountArtifactsRequest
    CountArtifactsRequest (..),
    newCountArtifactsRequest,

    -- * CountArtifactsResponse
    CountArtifactsResponse (..),
    newCountArtifactsResponse,

    -- * DriveDocumentIds
    DriveDocumentIds (..),
    newDriveDocumentIds,

    -- * DriveDocumentInfo
    DriveDocumentInfo (..),
    newDriveDocumentInfo,

    -- * DriveExportOptions
    DriveExportOptions (..),
    newDriveExportOptions,

    -- * DriveOptions
    DriveOptions (..),
    newDriveOptions,

    -- * Empty
    Empty (..),
    newEmpty,

    -- * Export
    Export (..),
    newExport,

    -- * ExportOptions
    ExportOptions (..),
    newExportOptions,

    -- * ExportStats
    ExportStats (..),
    newExportStats,

    -- * GeminiExportOptions
    GeminiExportOptions (..),
    newGeminiExportOptions,

    -- * GeminiOptions
    GeminiOptions (..),
    newGeminiOptions,

    -- * GroupsCountResult
    GroupsCountResult (..),
    newGroupsCountResult,

    -- * GroupsExportOptions
    GroupsExportOptions (..),
    newGroupsExportOptions,

    -- * HangoutsChatExportOptions
    HangoutsChatExportOptions (..),
    newHangoutsChatExportOptions,

    -- * HangoutsChatInfo
    HangoutsChatInfo (..),
    newHangoutsChatInfo,

    -- * HangoutsChatOptions
    HangoutsChatOptions (..),
    newHangoutsChatOptions,

    -- * HeldAccount
    HeldAccount (..),
    newHeldAccount,

    -- * HeldCalendarQuery
    HeldCalendarQuery (..),
    newHeldCalendarQuery,

    -- * HeldDriveQuery
    HeldDriveQuery (..),
    newHeldDriveQuery,

    -- * HeldGroupsQuery
    HeldGroupsQuery (..),
    newHeldGroupsQuery,

    -- * HeldHangoutsChatQuery
    HeldHangoutsChatQuery (..),
    newHeldHangoutsChatQuery,

    -- * HeldMailQuery
    HeldMailQuery (..),
    newHeldMailQuery,

    -- * HeldOrgUnit
    HeldOrgUnit (..),
    newHeldOrgUnit,

    -- * HeldVoiceQuery
    HeldVoiceQuery (..),
    newHeldVoiceQuery,

    -- * Hold
    Hold (..),
    newHold,

    -- * ListExportsResponse
    ListExportsResponse (..),
    newListExportsResponse,

    -- * ListHeldAccountsResponse
    ListHeldAccountsResponse (..),
    newListHeldAccountsResponse,

    -- * ListHoldsResponse
    ListHoldsResponse (..),
    newListHoldsResponse,

    -- * ListMattersResponse
    ListMattersResponse (..),
    newListMattersResponse,

    -- * ListOperationsResponse
    ListOperationsResponse (..),
    newListOperationsResponse,

    -- * ListSavedQueriesResponse
    ListSavedQueriesResponse (..),
    newListSavedQueriesResponse,

    -- * MailCountResult
    MailCountResult (..),
    newMailCountResult,

    -- * MailExportOptions
    MailExportOptions (..),
    newMailExportOptions,

    -- * MailOptions
    MailOptions (..),
    newMailOptions,

    -- * Matter
    Matter (..),
    newMatter,

    -- * MatterPermission
    MatterPermission (..),
    newMatterPermission,

    -- * Operation
    Operation (..),
    newOperation,

    -- * Operation_Metadata
    Operation_Metadata (..),
    newOperation_Metadata,

    -- * Operation_Response
    Operation_Response (..),
    newOperation_Response,

    -- * OrgUnitInfo
    OrgUnitInfo (..),
    newOrgUnitInfo,

    -- * Query
    Query (..),
    newQuery,

    -- * RemoveHeldAccountsRequest
    RemoveHeldAccountsRequest (..),
    newRemoveHeldAccountsRequest,

    -- * RemoveHeldAccountsResponse
    RemoveHeldAccountsResponse (..),
    newRemoveHeldAccountsResponse,

    -- * RemoveMatterPermissionsRequest
    RemoveMatterPermissionsRequest (..),
    newRemoveMatterPermissionsRequest,

    -- * ReopenMatterRequest
    ReopenMatterRequest (..),
    newReopenMatterRequest,

    -- * ReopenMatterResponse
    ReopenMatterResponse (..),
    newReopenMatterResponse,

    -- * SavedQuery
    SavedQuery (..),
    newSavedQuery,

    -- * SharedDriveInfo
    SharedDriveInfo (..),
    newSharedDriveInfo,

    -- * SitesUrlInfo
    SitesUrlInfo (..),
    newSitesUrlInfo,

    -- * Status
    Status (..),
    newStatus,

    -- * Status_DetailsItem
    Status_DetailsItem (..),
    newStatus_DetailsItem,

    -- * TeamDriveInfo
    TeamDriveInfo (..),
    newTeamDriveInfo,

    -- * UndeleteMatterRequest
    UndeleteMatterRequest (..),
    newUndeleteMatterRequest,

    -- * UserInfo
    UserInfo (..),
    newUserInfo,

    -- * VoiceExportOptions
    VoiceExportOptions (..),
    newVoiceExportOptions,

    -- * VoiceOptions
    VoiceOptions (..),
    newVoiceOptions,
  )
where

import Gogol.Prelude qualified as Core
import Gogol.Vault.Internal.Sum

-- | The results count for each account.
--
-- /See:/ 'newAccountCount' smart constructor.
data AccountCount = AccountCount
  { -- | Account owner.
    AccountCount -> Maybe UserInfo
account :: (Core.Maybe UserInfo),
    -- | The number of results (messages or files) found for this account.
    AccountCount -> Maybe Int64
count :: (Core.Maybe Core.Int64)
  }
  deriving (AccountCount -> AccountCount -> Bool
(AccountCount -> AccountCount -> Bool)
-> (AccountCount -> AccountCount -> Bool) -> Eq AccountCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccountCount -> AccountCount -> Bool
== :: AccountCount -> AccountCount -> Bool
$c/= :: AccountCount -> AccountCount -> Bool
/= :: AccountCount -> AccountCount -> Bool
Core.Eq, Int -> AccountCount -> ShowS
[AccountCount] -> ShowS
AccountCount -> String
(Int -> AccountCount -> ShowS)
-> (AccountCount -> String)
-> ([AccountCount] -> ShowS)
-> Show AccountCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccountCount -> ShowS
showsPrec :: Int -> AccountCount -> ShowS
$cshow :: AccountCount -> String
show :: AccountCount -> String
$cshowList :: [AccountCount] -> ShowS
showList :: [AccountCount] -> ShowS
Core.Show, (forall x. AccountCount -> Rep AccountCount x)
-> (forall x. Rep AccountCount x -> AccountCount)
-> Generic AccountCount
forall x. Rep AccountCount x -> AccountCount
forall x. AccountCount -> Rep AccountCount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccountCount -> Rep AccountCount x
from :: forall x. AccountCount -> Rep AccountCount x
$cto :: forall x. Rep AccountCount x -> AccountCount
to :: forall x. Rep AccountCount x -> AccountCount
Core.Generic)

-- | Creates a value of 'AccountCount' with the minimum fields required to make a request.
newAccountCount ::
  AccountCount
newAccountCount :: AccountCount
newAccountCount =
  AccountCount {account :: Maybe UserInfo
account = Maybe UserInfo
forall a. Maybe a
Core.Nothing, count :: Maybe Int64
count = Maybe Int64
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON AccountCount where
  parseJSON :: Value -> Parser AccountCount
parseJSON =
    String
-> (Object -> Parser AccountCount) -> Value -> Parser AccountCount
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"AccountCount"
      ( \Object
o ->
          Maybe UserInfo -> Maybe Int64 -> AccountCount
AccountCount
            (Maybe UserInfo -> Maybe Int64 -> AccountCount)
-> Parser (Maybe UserInfo) -> Parser (Maybe Int64 -> AccountCount)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe UserInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"account")
            Parser (Maybe Int64 -> AccountCount)
-> Parser (Maybe Int64) -> Parser AccountCount
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe (AsText Int64))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"count" Parser (Maybe (AsText Int64))
-> (Maybe (AsText Int64) -> Maybe Int64) -> Parser (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Core.<&> (AsText Int64 -> Int64) -> Maybe (AsText Int64) -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.fmap AsText Int64 -> Int64
forall a. AsText a -> a
Core.fromAsText)
      )

instance Core.ToJSON AccountCount where
  toJSON :: AccountCount -> Value
toJSON AccountCount {Maybe Int64
Maybe UserInfo
account :: AccountCount -> Maybe UserInfo
count :: AccountCount -> Maybe Int64
account :: Maybe UserInfo
count :: Maybe Int64
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"account" Core..=) (UserInfo -> Pair) -> Maybe UserInfo -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe UserInfo
account,
            (Key
"count" Core..=) (AsText Int64 -> Pair) -> (Int64 -> AsText Int64) -> Int64 -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
Core.. Int64 -> AsText Int64
forall a. a -> AsText a
Core.AsText (Int64 -> Pair) -> Maybe Int64 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int64
count
          ]
      )

-- | An error that occurred when querying a specific account
--
-- /See:/ 'newAccountCountError' smart constructor.
data AccountCountError = AccountCountError
  { -- | Account owner.
    AccountCountError -> Maybe UserInfo
account :: (Core.Maybe UserInfo),
    -- | Account query error.
    AccountCountError -> Maybe AccountCountError_ErrorType
errorType :: (Core.Maybe AccountCountError_ErrorType)
  }
  deriving (AccountCountError -> AccountCountError -> Bool
(AccountCountError -> AccountCountError -> Bool)
-> (AccountCountError -> AccountCountError -> Bool)
-> Eq AccountCountError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccountCountError -> AccountCountError -> Bool
== :: AccountCountError -> AccountCountError -> Bool
$c/= :: AccountCountError -> AccountCountError -> Bool
/= :: AccountCountError -> AccountCountError -> Bool
Core.Eq, Int -> AccountCountError -> ShowS
[AccountCountError] -> ShowS
AccountCountError -> String
(Int -> AccountCountError -> ShowS)
-> (AccountCountError -> String)
-> ([AccountCountError] -> ShowS)
-> Show AccountCountError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccountCountError -> ShowS
showsPrec :: Int -> AccountCountError -> ShowS
$cshow :: AccountCountError -> String
show :: AccountCountError -> String
$cshowList :: [AccountCountError] -> ShowS
showList :: [AccountCountError] -> ShowS
Core.Show, (forall x. AccountCountError -> Rep AccountCountError x)
-> (forall x. Rep AccountCountError x -> AccountCountError)
-> Generic AccountCountError
forall x. Rep AccountCountError x -> AccountCountError
forall x. AccountCountError -> Rep AccountCountError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccountCountError -> Rep AccountCountError x
from :: forall x. AccountCountError -> Rep AccountCountError x
$cto :: forall x. Rep AccountCountError x -> AccountCountError
to :: forall x. Rep AccountCountError x -> AccountCountError
Core.Generic)

-- | Creates a value of 'AccountCountError' with the minimum fields required to make a request.
newAccountCountError ::
  AccountCountError
newAccountCountError :: AccountCountError
newAccountCountError =
  AccountCountError
    { account :: Maybe UserInfo
account = Maybe UserInfo
forall a. Maybe a
Core.Nothing,
      errorType :: Maybe AccountCountError_ErrorType
errorType = Maybe AccountCountError_ErrorType
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON AccountCountError where
  parseJSON :: Value -> Parser AccountCountError
parseJSON =
    String
-> (Object -> Parser AccountCountError)
-> Value
-> Parser AccountCountError
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"AccountCountError"
      ( \Object
o ->
          Maybe UserInfo
-> Maybe AccountCountError_ErrorType -> AccountCountError
AccountCountError
            (Maybe UserInfo
 -> Maybe AccountCountError_ErrorType -> AccountCountError)
-> Parser (Maybe UserInfo)
-> Parser (Maybe AccountCountError_ErrorType -> AccountCountError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe UserInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"account")
            Parser (Maybe AccountCountError_ErrorType -> AccountCountError)
-> Parser (Maybe AccountCountError_ErrorType)
-> Parser AccountCountError
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe AccountCountError_ErrorType)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"errorType")
      )

instance Core.ToJSON AccountCountError where
  toJSON :: AccountCountError -> Value
toJSON AccountCountError {Maybe AccountCountError_ErrorType
Maybe UserInfo
account :: AccountCountError -> Maybe UserInfo
errorType :: AccountCountError -> Maybe AccountCountError_ErrorType
account :: Maybe UserInfo
errorType :: Maybe AccountCountError_ErrorType
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"account" Core..=) (UserInfo -> Pair) -> Maybe UserInfo -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe UserInfo
account,
            (Key
"errorType" Core..=) (AccountCountError_ErrorType -> Pair)
-> Maybe AccountCountError_ErrorType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe AccountCountError_ErrorType
errorType
          ]
      )

-- | The accounts to search
--
-- /See:/ 'newAccountInfo' smart constructor.
newtype AccountInfo = AccountInfo
  { -- | A set of accounts to search.
    AccountInfo -> Maybe [Text]
emails :: (Core.Maybe [Core.Text])
  }
  deriving (AccountInfo -> AccountInfo -> Bool
(AccountInfo -> AccountInfo -> Bool)
-> (AccountInfo -> AccountInfo -> Bool) -> Eq AccountInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccountInfo -> AccountInfo -> Bool
== :: AccountInfo -> AccountInfo -> Bool
$c/= :: AccountInfo -> AccountInfo -> Bool
/= :: AccountInfo -> AccountInfo -> Bool
Core.Eq, Int -> AccountInfo -> ShowS
[AccountInfo] -> ShowS
AccountInfo -> String
(Int -> AccountInfo -> ShowS)
-> (AccountInfo -> String)
-> ([AccountInfo] -> ShowS)
-> Show AccountInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccountInfo -> ShowS
showsPrec :: Int -> AccountInfo -> ShowS
$cshow :: AccountInfo -> String
show :: AccountInfo -> String
$cshowList :: [AccountInfo] -> ShowS
showList :: [AccountInfo] -> ShowS
Core.Show, (forall x. AccountInfo -> Rep AccountInfo x)
-> (forall x. Rep AccountInfo x -> AccountInfo)
-> Generic AccountInfo
forall x. Rep AccountInfo x -> AccountInfo
forall x. AccountInfo -> Rep AccountInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccountInfo -> Rep AccountInfo x
from :: forall x. AccountInfo -> Rep AccountInfo x
$cto :: forall x. Rep AccountInfo x -> AccountInfo
to :: forall x. Rep AccountInfo x -> AccountInfo
Core.Generic)

-- | Creates a value of 'AccountInfo' with the minimum fields required to make a request.
newAccountInfo ::
  AccountInfo
newAccountInfo :: AccountInfo
newAccountInfo = AccountInfo {emails :: Maybe [Text]
emails = Maybe [Text]
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON AccountInfo where
  parseJSON :: Value -> Parser AccountInfo
parseJSON =
    String
-> (Object -> Parser AccountInfo) -> Value -> Parser AccountInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"AccountInfo"
      (\Object
o -> Maybe [Text] -> AccountInfo
AccountInfo (Maybe [Text] -> AccountInfo)
-> Parser (Maybe [Text]) -> Parser AccountInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"emails"))

instance Core.ToJSON AccountInfo where
  toJSON :: AccountInfo -> Value
toJSON AccountInfo {Maybe [Text]
emails :: AccountInfo -> Maybe [Text]
emails :: Maybe [Text]
..} =
    [Pair] -> Value
Core.object ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"emails" Core..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Text]
emails])

-- | The status of each account creation, and the __HeldAccount__, if successful.
--
-- /See:/ 'newAddHeldAccountResult' smart constructor.
data AddHeldAccountResult = AddHeldAccountResult
  { -- | Returned when the account was successfully created.
    AddHeldAccountResult -> Maybe HeldAccount
account :: (Core.Maybe HeldAccount),
    -- | Reports the request status. If it failed, returns an error message.
    AddHeldAccountResult -> Maybe Status
status :: (Core.Maybe Status)
  }
  deriving (AddHeldAccountResult -> AddHeldAccountResult -> Bool
(AddHeldAccountResult -> AddHeldAccountResult -> Bool)
-> (AddHeldAccountResult -> AddHeldAccountResult -> Bool)
-> Eq AddHeldAccountResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddHeldAccountResult -> AddHeldAccountResult -> Bool
== :: AddHeldAccountResult -> AddHeldAccountResult -> Bool
$c/= :: AddHeldAccountResult -> AddHeldAccountResult -> Bool
/= :: AddHeldAccountResult -> AddHeldAccountResult -> Bool
Core.Eq, Int -> AddHeldAccountResult -> ShowS
[AddHeldAccountResult] -> ShowS
AddHeldAccountResult -> String
(Int -> AddHeldAccountResult -> ShowS)
-> (AddHeldAccountResult -> String)
-> ([AddHeldAccountResult] -> ShowS)
-> Show AddHeldAccountResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddHeldAccountResult -> ShowS
showsPrec :: Int -> AddHeldAccountResult -> ShowS
$cshow :: AddHeldAccountResult -> String
show :: AddHeldAccountResult -> String
$cshowList :: [AddHeldAccountResult] -> ShowS
showList :: [AddHeldAccountResult] -> ShowS
Core.Show, (forall x. AddHeldAccountResult -> Rep AddHeldAccountResult x)
-> (forall x. Rep AddHeldAccountResult x -> AddHeldAccountResult)
-> Generic AddHeldAccountResult
forall x. Rep AddHeldAccountResult x -> AddHeldAccountResult
forall x. AddHeldAccountResult -> Rep AddHeldAccountResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddHeldAccountResult -> Rep AddHeldAccountResult x
from :: forall x. AddHeldAccountResult -> Rep AddHeldAccountResult x
$cto :: forall x. Rep AddHeldAccountResult x -> AddHeldAccountResult
to :: forall x. Rep AddHeldAccountResult x -> AddHeldAccountResult
Core.Generic)

-- | Creates a value of 'AddHeldAccountResult' with the minimum fields required to make a request.
newAddHeldAccountResult ::
  AddHeldAccountResult
newAddHeldAccountResult :: AddHeldAccountResult
newAddHeldAccountResult =
  AddHeldAccountResult
    { account :: Maybe HeldAccount
account = Maybe HeldAccount
forall a. Maybe a
Core.Nothing,
      status :: Maybe Status
status = Maybe Status
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON AddHeldAccountResult where
  parseJSON :: Value -> Parser AddHeldAccountResult
parseJSON =
    String
-> (Object -> Parser AddHeldAccountResult)
-> Value
-> Parser AddHeldAccountResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"AddHeldAccountResult"
      ( \Object
o ->
          Maybe HeldAccount -> Maybe Status -> AddHeldAccountResult
AddHeldAccountResult
            (Maybe HeldAccount -> Maybe Status -> AddHeldAccountResult)
-> Parser (Maybe HeldAccount)
-> Parser (Maybe Status -> AddHeldAccountResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe HeldAccount)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"account")
            Parser (Maybe Status -> AddHeldAccountResult)
-> Parser (Maybe Status) -> Parser AddHeldAccountResult
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Status)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"status")
      )

instance Core.ToJSON AddHeldAccountResult where
  toJSON :: AddHeldAccountResult -> Value
toJSON AddHeldAccountResult {Maybe Status
Maybe HeldAccount
account :: AddHeldAccountResult -> Maybe HeldAccount
status :: AddHeldAccountResult -> Maybe Status
account :: Maybe HeldAccount
status :: Maybe Status
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"account" Core..=) (HeldAccount -> Pair) -> Maybe HeldAccount -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe HeldAccount
account,
            (Key
"status" Core..=) (Status -> Pair) -> Maybe Status -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Status
status
          ]
      )

-- | Add a list of accounts to a hold.
--
-- /See:/ 'newAddHeldAccountsRequest' smart constructor.
data AddHeldAccountsRequest = AddHeldAccountsRequest
  { -- | A comma-separated list of the account IDs of the accounts to add to the hold. Specify either __emails__ or **account_ids**, but not both.
    AddHeldAccountsRequest -> Maybe [Text]
accountIds :: (Core.Maybe [Core.Text]),
    -- | A comma-separated list of the emails of the accounts to add to the hold. Specify either __emails__ or **account_ids**, but not both.
    AddHeldAccountsRequest -> Maybe [Text]
emails :: (Core.Maybe [Core.Text])
  }
  deriving (AddHeldAccountsRequest -> AddHeldAccountsRequest -> Bool
(AddHeldAccountsRequest -> AddHeldAccountsRequest -> Bool)
-> (AddHeldAccountsRequest -> AddHeldAccountsRequest -> Bool)
-> Eq AddHeldAccountsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddHeldAccountsRequest -> AddHeldAccountsRequest -> Bool
== :: AddHeldAccountsRequest -> AddHeldAccountsRequest -> Bool
$c/= :: AddHeldAccountsRequest -> AddHeldAccountsRequest -> Bool
/= :: AddHeldAccountsRequest -> AddHeldAccountsRequest -> Bool
Core.Eq, Int -> AddHeldAccountsRequest -> ShowS
[AddHeldAccountsRequest] -> ShowS
AddHeldAccountsRequest -> String
(Int -> AddHeldAccountsRequest -> ShowS)
-> (AddHeldAccountsRequest -> String)
-> ([AddHeldAccountsRequest] -> ShowS)
-> Show AddHeldAccountsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddHeldAccountsRequest -> ShowS
showsPrec :: Int -> AddHeldAccountsRequest -> ShowS
$cshow :: AddHeldAccountsRequest -> String
show :: AddHeldAccountsRequest -> String
$cshowList :: [AddHeldAccountsRequest] -> ShowS
showList :: [AddHeldAccountsRequest] -> ShowS
Core.Show, (forall x. AddHeldAccountsRequest -> Rep AddHeldAccountsRequest x)
-> (forall x.
    Rep AddHeldAccountsRequest x -> AddHeldAccountsRequest)
-> Generic AddHeldAccountsRequest
forall x. Rep AddHeldAccountsRequest x -> AddHeldAccountsRequest
forall x. AddHeldAccountsRequest -> Rep AddHeldAccountsRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddHeldAccountsRequest -> Rep AddHeldAccountsRequest x
from :: forall x. AddHeldAccountsRequest -> Rep AddHeldAccountsRequest x
$cto :: forall x. Rep AddHeldAccountsRequest x -> AddHeldAccountsRequest
to :: forall x. Rep AddHeldAccountsRequest x -> AddHeldAccountsRequest
Core.Generic)

-- | Creates a value of 'AddHeldAccountsRequest' with the minimum fields required to make a request.
newAddHeldAccountsRequest ::
  AddHeldAccountsRequest
newAddHeldAccountsRequest :: AddHeldAccountsRequest
newAddHeldAccountsRequest =
  AddHeldAccountsRequest
    { accountIds :: Maybe [Text]
accountIds = Maybe [Text]
forall a. Maybe a
Core.Nothing,
      emails :: Maybe [Text]
emails = Maybe [Text]
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON AddHeldAccountsRequest where
  parseJSON :: Value -> Parser AddHeldAccountsRequest
parseJSON =
    String
-> (Object -> Parser AddHeldAccountsRequest)
-> Value
-> Parser AddHeldAccountsRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"AddHeldAccountsRequest"
      ( \Object
o ->
          Maybe [Text] -> Maybe [Text] -> AddHeldAccountsRequest
AddHeldAccountsRequest
            (Maybe [Text] -> Maybe [Text] -> AddHeldAccountsRequest)
-> Parser (Maybe [Text])
-> Parser (Maybe [Text] -> AddHeldAccountsRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"accountIds")
            Parser (Maybe [Text] -> AddHeldAccountsRequest)
-> Parser (Maybe [Text]) -> Parser AddHeldAccountsRequest
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"emails")
      )

instance Core.ToJSON AddHeldAccountsRequest where
  toJSON :: AddHeldAccountsRequest -> Value
toJSON AddHeldAccountsRequest {Maybe [Text]
accountIds :: AddHeldAccountsRequest -> Maybe [Text]
emails :: AddHeldAccountsRequest -> Maybe [Text]
accountIds :: Maybe [Text]
emails :: Maybe [Text]
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"accountIds" Core..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Text]
accountIds,
            (Key
"emails" Core..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Text]
emails
          ]
      )

-- | Response for batch create held accounts.
--
-- /See:/ 'newAddHeldAccountsResponse' smart constructor.
newtype AddHeldAccountsResponse = AddHeldAccountsResponse
  { -- | The list of responses, in the same order as the batch request.
    AddHeldAccountsResponse -> Maybe [AddHeldAccountResult]
responses :: (Core.Maybe [AddHeldAccountResult])
  }
  deriving (AddHeldAccountsResponse -> AddHeldAccountsResponse -> Bool
(AddHeldAccountsResponse -> AddHeldAccountsResponse -> Bool)
-> (AddHeldAccountsResponse -> AddHeldAccountsResponse -> Bool)
-> Eq AddHeldAccountsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddHeldAccountsResponse -> AddHeldAccountsResponse -> Bool
== :: AddHeldAccountsResponse -> AddHeldAccountsResponse -> Bool
$c/= :: AddHeldAccountsResponse -> AddHeldAccountsResponse -> Bool
/= :: AddHeldAccountsResponse -> AddHeldAccountsResponse -> Bool
Core.Eq, Int -> AddHeldAccountsResponse -> ShowS
[AddHeldAccountsResponse] -> ShowS
AddHeldAccountsResponse -> String
(Int -> AddHeldAccountsResponse -> ShowS)
-> (AddHeldAccountsResponse -> String)
-> ([AddHeldAccountsResponse] -> ShowS)
-> Show AddHeldAccountsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddHeldAccountsResponse -> ShowS
showsPrec :: Int -> AddHeldAccountsResponse -> ShowS
$cshow :: AddHeldAccountsResponse -> String
show :: AddHeldAccountsResponse -> String
$cshowList :: [AddHeldAccountsResponse] -> ShowS
showList :: [AddHeldAccountsResponse] -> ShowS
Core.Show, (forall x.
 AddHeldAccountsResponse -> Rep AddHeldAccountsResponse x)
-> (forall x.
    Rep AddHeldAccountsResponse x -> AddHeldAccountsResponse)
-> Generic AddHeldAccountsResponse
forall x. Rep AddHeldAccountsResponse x -> AddHeldAccountsResponse
forall x. AddHeldAccountsResponse -> Rep AddHeldAccountsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddHeldAccountsResponse -> Rep AddHeldAccountsResponse x
from :: forall x. AddHeldAccountsResponse -> Rep AddHeldAccountsResponse x
$cto :: forall x. Rep AddHeldAccountsResponse x -> AddHeldAccountsResponse
to :: forall x. Rep AddHeldAccountsResponse x -> AddHeldAccountsResponse
Core.Generic)

-- | Creates a value of 'AddHeldAccountsResponse' with the minimum fields required to make a request.
newAddHeldAccountsResponse ::
  AddHeldAccountsResponse
newAddHeldAccountsResponse :: AddHeldAccountsResponse
newAddHeldAccountsResponse =
  AddHeldAccountsResponse {responses :: Maybe [AddHeldAccountResult]
responses = Maybe [AddHeldAccountResult]
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON AddHeldAccountsResponse where
  parseJSON :: Value -> Parser AddHeldAccountsResponse
parseJSON =
    String
-> (Object -> Parser AddHeldAccountsResponse)
-> Value
-> Parser AddHeldAccountsResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"AddHeldAccountsResponse"
      (\Object
o -> Maybe [AddHeldAccountResult] -> AddHeldAccountsResponse
AddHeldAccountsResponse (Maybe [AddHeldAccountResult] -> AddHeldAccountsResponse)
-> Parser (Maybe [AddHeldAccountResult])
-> Parser AddHeldAccountsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [AddHeldAccountResult])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"responses"))

instance Core.ToJSON AddHeldAccountsResponse where
  toJSON :: AddHeldAccountsResponse -> Value
toJSON AddHeldAccountsResponse {Maybe [AddHeldAccountResult]
responses :: AddHeldAccountsResponse -> Maybe [AddHeldAccountResult]
responses :: Maybe [AddHeldAccountResult]
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"responses" Core..=) ([AddHeldAccountResult] -> Pair)
-> Maybe [AddHeldAccountResult] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [AddHeldAccountResult]
responses])

-- | Add an account with the permission specified. The role cannot be owner. If an account already has a role in the matter, the existing role is overwritten.
--
-- /See:/ 'newAddMatterPermissionsRequest' smart constructor.
data AddMatterPermissionsRequest = AddMatterPermissionsRequest
  { -- | Only relevant if __sendEmails__ is __true__. To CC the requestor in the email message, set to __true__. To not CC requestor, set to __false__.
    AddMatterPermissionsRequest -> Maybe Bool
ccMe :: (Core.Maybe Core.Bool),
    -- | The account and its role to add.
    AddMatterPermissionsRequest -> Maybe MatterPermission
matterPermission :: (Core.Maybe MatterPermission),
    -- | To send a notification email to the added account, set to __true__. To not send a notification email, set to __false__.
    AddMatterPermissionsRequest -> Maybe Bool
sendEmails :: (Core.Maybe Core.Bool)
  }
  deriving (AddMatterPermissionsRequest -> AddMatterPermissionsRequest -> Bool
(AddMatterPermissionsRequest
 -> AddMatterPermissionsRequest -> Bool)
-> (AddMatterPermissionsRequest
    -> AddMatterPermissionsRequest -> Bool)
-> Eq AddMatterPermissionsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddMatterPermissionsRequest -> AddMatterPermissionsRequest -> Bool
== :: AddMatterPermissionsRequest -> AddMatterPermissionsRequest -> Bool
$c/= :: AddMatterPermissionsRequest -> AddMatterPermissionsRequest -> Bool
/= :: AddMatterPermissionsRequest -> AddMatterPermissionsRequest -> Bool
Core.Eq, Int -> AddMatterPermissionsRequest -> ShowS
[AddMatterPermissionsRequest] -> ShowS
AddMatterPermissionsRequest -> String
(Int -> AddMatterPermissionsRequest -> ShowS)
-> (AddMatterPermissionsRequest -> String)
-> ([AddMatterPermissionsRequest] -> ShowS)
-> Show AddMatterPermissionsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddMatterPermissionsRequest -> ShowS
showsPrec :: Int -> AddMatterPermissionsRequest -> ShowS
$cshow :: AddMatterPermissionsRequest -> String
show :: AddMatterPermissionsRequest -> String
$cshowList :: [AddMatterPermissionsRequest] -> ShowS
showList :: [AddMatterPermissionsRequest] -> ShowS
Core.Show, (forall x.
 AddMatterPermissionsRequest -> Rep AddMatterPermissionsRequest x)
-> (forall x.
    Rep AddMatterPermissionsRequest x -> AddMatterPermissionsRequest)
-> Generic AddMatterPermissionsRequest
forall x.
Rep AddMatterPermissionsRequest x -> AddMatterPermissionsRequest
forall x.
AddMatterPermissionsRequest -> Rep AddMatterPermissionsRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
AddMatterPermissionsRequest -> Rep AddMatterPermissionsRequest x
from :: forall x.
AddMatterPermissionsRequest -> Rep AddMatterPermissionsRequest x
$cto :: forall x.
Rep AddMatterPermissionsRequest x -> AddMatterPermissionsRequest
to :: forall x.
Rep AddMatterPermissionsRequest x -> AddMatterPermissionsRequest
Core.Generic)

-- | Creates a value of 'AddMatterPermissionsRequest' with the minimum fields required to make a request.
newAddMatterPermissionsRequest ::
  AddMatterPermissionsRequest
newAddMatterPermissionsRequest :: AddMatterPermissionsRequest
newAddMatterPermissionsRequest =
  AddMatterPermissionsRequest
    { ccMe :: Maybe Bool
ccMe = Maybe Bool
forall a. Maybe a
Core.Nothing,
      matterPermission :: Maybe MatterPermission
matterPermission = Maybe MatterPermission
forall a. Maybe a
Core.Nothing,
      sendEmails :: Maybe Bool
sendEmails = Maybe Bool
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON AddMatterPermissionsRequest where
  parseJSON :: Value -> Parser AddMatterPermissionsRequest
parseJSON =
    String
-> (Object -> Parser AddMatterPermissionsRequest)
-> Value
-> Parser AddMatterPermissionsRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"AddMatterPermissionsRequest"
      ( \Object
o ->
          Maybe Bool
-> Maybe MatterPermission
-> Maybe Bool
-> AddMatterPermissionsRequest
AddMatterPermissionsRequest
            (Maybe Bool
 -> Maybe MatterPermission
 -> Maybe Bool
 -> AddMatterPermissionsRequest)
-> Parser (Maybe Bool)
-> Parser
     (Maybe MatterPermission
      -> Maybe Bool -> AddMatterPermissionsRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"ccMe")
            Parser
  (Maybe MatterPermission
   -> Maybe Bool -> AddMatterPermissionsRequest)
-> Parser (Maybe MatterPermission)
-> Parser (Maybe Bool -> AddMatterPermissionsRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe MatterPermission)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"matterPermission")
            Parser (Maybe Bool -> AddMatterPermissionsRequest)
-> Parser (Maybe Bool) -> Parser AddMatterPermissionsRequest
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"sendEmails")
      )

instance Core.ToJSON AddMatterPermissionsRequest where
  toJSON :: AddMatterPermissionsRequest -> Value
toJSON AddMatterPermissionsRequest {Maybe Bool
Maybe MatterPermission
ccMe :: AddMatterPermissionsRequest -> Maybe Bool
matterPermission :: AddMatterPermissionsRequest -> Maybe MatterPermission
sendEmails :: AddMatterPermissionsRequest -> Maybe Bool
ccMe :: Maybe Bool
matterPermission :: Maybe MatterPermission
sendEmails :: Maybe Bool
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"ccMe" Core..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Bool
ccMe,
            (Key
"matterPermission" Core..=) (MatterPermission -> Pair) -> Maybe MatterPermission -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe MatterPermission
matterPermission,
            (Key
"sendEmails" Core..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Bool
sendEmails
          ]
      )

-- | The options for Calendar exports.
--
-- /See:/ 'newCalendarExportOptions' smart constructor.
newtype CalendarExportOptions = CalendarExportOptions
  { -- | The file format for exported text messages.
    CalendarExportOptions -> Maybe CalendarExportOptions_ExportFormat
exportFormat :: (Core.Maybe CalendarExportOptions_ExportFormat)
  }
  deriving (CalendarExportOptions -> CalendarExportOptions -> Bool
(CalendarExportOptions -> CalendarExportOptions -> Bool)
-> (CalendarExportOptions -> CalendarExportOptions -> Bool)
-> Eq CalendarExportOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CalendarExportOptions -> CalendarExportOptions -> Bool
== :: CalendarExportOptions -> CalendarExportOptions -> Bool
$c/= :: CalendarExportOptions -> CalendarExportOptions -> Bool
/= :: CalendarExportOptions -> CalendarExportOptions -> Bool
Core.Eq, Int -> CalendarExportOptions -> ShowS
[CalendarExportOptions] -> ShowS
CalendarExportOptions -> String
(Int -> CalendarExportOptions -> ShowS)
-> (CalendarExportOptions -> String)
-> ([CalendarExportOptions] -> ShowS)
-> Show CalendarExportOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CalendarExportOptions -> ShowS
showsPrec :: Int -> CalendarExportOptions -> ShowS
$cshow :: CalendarExportOptions -> String
show :: CalendarExportOptions -> String
$cshowList :: [CalendarExportOptions] -> ShowS
showList :: [CalendarExportOptions] -> ShowS
Core.Show, (forall x. CalendarExportOptions -> Rep CalendarExportOptions x)
-> (forall x. Rep CalendarExportOptions x -> CalendarExportOptions)
-> Generic CalendarExportOptions
forall x. Rep CalendarExportOptions x -> CalendarExportOptions
forall x. CalendarExportOptions -> Rep CalendarExportOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CalendarExportOptions -> Rep CalendarExportOptions x
from :: forall x. CalendarExportOptions -> Rep CalendarExportOptions x
$cto :: forall x. Rep CalendarExportOptions x -> CalendarExportOptions
to :: forall x. Rep CalendarExportOptions x -> CalendarExportOptions
Core.Generic)

-- | Creates a value of 'CalendarExportOptions' with the minimum fields required to make a request.
newCalendarExportOptions ::
  CalendarExportOptions
newCalendarExportOptions :: CalendarExportOptions
newCalendarExportOptions =
  CalendarExportOptions {exportFormat :: Maybe CalendarExportOptions_ExportFormat
exportFormat = Maybe CalendarExportOptions_ExportFormat
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON CalendarExportOptions where
  parseJSON :: Value -> Parser CalendarExportOptions
parseJSON =
    String
-> (Object -> Parser CalendarExportOptions)
-> Value
-> Parser CalendarExportOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"CalendarExportOptions"
      (\Object
o -> Maybe CalendarExportOptions_ExportFormat -> CalendarExportOptions
CalendarExportOptions (Maybe CalendarExportOptions_ExportFormat -> CalendarExportOptions)
-> Parser (Maybe CalendarExportOptions_ExportFormat)
-> Parser CalendarExportOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe CalendarExportOptions_ExportFormat)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"exportFormat"))

instance Core.ToJSON CalendarExportOptions where
  toJSON :: CalendarExportOptions -> Value
toJSON CalendarExportOptions {Maybe CalendarExportOptions_ExportFormat
exportFormat :: CalendarExportOptions -> Maybe CalendarExportOptions_ExportFormat
exportFormat :: Maybe CalendarExportOptions_ExportFormat
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"exportFormat" Core..=) (CalendarExportOptions_ExportFormat -> Pair)
-> Maybe CalendarExportOptions_ExportFormat -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe CalendarExportOptions_ExportFormat
exportFormat])

-- | Additional options for Calendar search
--
-- /See:/ 'newCalendarOptions' smart constructor.
data CalendarOptions = CalendarOptions
  { -- | Matches only those events whose location contains all of the words in the given set. If the string contains quoted phrases, this method only matches those events whose location contain the exact phrase. Entries in the set are considered in \"and\". Word splitting example: [\"New Zealand\"] vs [\"New\",\"Zealand\"] \"New Zealand\": matched by both \"New and better Zealand\": only matched by the later
    CalendarOptions -> Maybe [Text]
locationQuery :: (Core.Maybe [Core.Text]),
    -- | Matches only those events that do not contain any of the words in the given set in title, description, location, or attendees. Entries in the set are considered in \"or\".
    CalendarOptions -> Maybe [Text]
minusWords :: (Core.Maybe [Core.Text]),
    -- | Matches only those events whose attendees contain all of the words in the given set. Entries in the set are considered in \"and\".
    CalendarOptions -> Maybe [Text]
peopleQuery :: (Core.Maybe [Core.Text]),
    -- | Matches only events for which the custodian gave one of these responses. If the set is empty or contains ATTENDEE/RESPONSE/UNSPECIFIED there will be no filtering on responses.
    CalendarOptions -> Maybe [CalendarOptions_ResponseStatusesItem]
responseStatuses :: (Core.Maybe [CalendarOptions_ResponseStatusesItem]),
    -- | Search the current version of the Calendar event, but export the contents of the last version saved before 12:00 AM UTC on the specified date. Enter the date in UTC.
    CalendarOptions -> Maybe DateTime
versionDate :: (Core.Maybe Core.DateTime)
  }
  deriving (CalendarOptions -> CalendarOptions -> Bool
(CalendarOptions -> CalendarOptions -> Bool)
-> (CalendarOptions -> CalendarOptions -> Bool)
-> Eq CalendarOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CalendarOptions -> CalendarOptions -> Bool
== :: CalendarOptions -> CalendarOptions -> Bool
$c/= :: CalendarOptions -> CalendarOptions -> Bool
/= :: CalendarOptions -> CalendarOptions -> Bool
Core.Eq, Int -> CalendarOptions -> ShowS
[CalendarOptions] -> ShowS
CalendarOptions -> String
(Int -> CalendarOptions -> ShowS)
-> (CalendarOptions -> String)
-> ([CalendarOptions] -> ShowS)
-> Show CalendarOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CalendarOptions -> ShowS
showsPrec :: Int -> CalendarOptions -> ShowS
$cshow :: CalendarOptions -> String
show :: CalendarOptions -> String
$cshowList :: [CalendarOptions] -> ShowS
showList :: [CalendarOptions] -> ShowS
Core.Show, (forall x. CalendarOptions -> Rep CalendarOptions x)
-> (forall x. Rep CalendarOptions x -> CalendarOptions)
-> Generic CalendarOptions
forall x. Rep CalendarOptions x -> CalendarOptions
forall x. CalendarOptions -> Rep CalendarOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CalendarOptions -> Rep CalendarOptions x
from :: forall x. CalendarOptions -> Rep CalendarOptions x
$cto :: forall x. Rep CalendarOptions x -> CalendarOptions
to :: forall x. Rep CalendarOptions x -> CalendarOptions
Core.Generic)

-- | Creates a value of 'CalendarOptions' with the minimum fields required to make a request.
newCalendarOptions ::
  CalendarOptions
newCalendarOptions :: CalendarOptions
newCalendarOptions =
  CalendarOptions
    { locationQuery :: Maybe [Text]
locationQuery = Maybe [Text]
forall a. Maybe a
Core.Nothing,
      minusWords :: Maybe [Text]
minusWords = Maybe [Text]
forall a. Maybe a
Core.Nothing,
      peopleQuery :: Maybe [Text]
peopleQuery = Maybe [Text]
forall a. Maybe a
Core.Nothing,
      responseStatuses :: Maybe [CalendarOptions_ResponseStatusesItem]
responseStatuses = Maybe [CalendarOptions_ResponseStatusesItem]
forall a. Maybe a
Core.Nothing,
      versionDate :: Maybe DateTime
versionDate = Maybe DateTime
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON CalendarOptions where
  parseJSON :: Value -> Parser CalendarOptions
parseJSON =
    String
-> (Object -> Parser CalendarOptions)
-> Value
-> Parser CalendarOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"CalendarOptions"
      ( \Object
o ->
          Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> Maybe [CalendarOptions_ResponseStatusesItem]
-> Maybe DateTime
-> CalendarOptions
CalendarOptions
            (Maybe [Text]
 -> Maybe [Text]
 -> Maybe [Text]
 -> Maybe [CalendarOptions_ResponseStatusesItem]
 -> Maybe DateTime
 -> CalendarOptions)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe [Text]
      -> Maybe [CalendarOptions_ResponseStatusesItem]
      -> Maybe DateTime
      -> CalendarOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"locationQuery")
            Parser
  (Maybe [Text]
   -> Maybe [Text]
   -> Maybe [CalendarOptions_ResponseStatusesItem]
   -> Maybe DateTime
   -> CalendarOptions)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe [CalendarOptions_ResponseStatusesItem]
      -> Maybe DateTime
      -> CalendarOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"minusWords")
            Parser
  (Maybe [Text]
   -> Maybe [CalendarOptions_ResponseStatusesItem]
   -> Maybe DateTime
   -> CalendarOptions)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [CalendarOptions_ResponseStatusesItem]
      -> Maybe DateTime -> CalendarOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"peopleQuery")
            Parser
  (Maybe [CalendarOptions_ResponseStatusesItem]
   -> Maybe DateTime -> CalendarOptions)
-> Parser (Maybe [CalendarOptions_ResponseStatusesItem])
-> Parser (Maybe DateTime -> CalendarOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object
-> Key -> Parser (Maybe [CalendarOptions_ResponseStatusesItem])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"responseStatuses")
            Parser (Maybe DateTime -> CalendarOptions)
-> Parser (Maybe DateTime) -> Parser CalendarOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"versionDate")
      )

instance Core.ToJSON CalendarOptions where
  toJSON :: CalendarOptions -> Value
toJSON CalendarOptions {Maybe [Text]
Maybe [CalendarOptions_ResponseStatusesItem]
Maybe DateTime
locationQuery :: CalendarOptions -> Maybe [Text]
minusWords :: CalendarOptions -> Maybe [Text]
peopleQuery :: CalendarOptions -> Maybe [Text]
responseStatuses :: CalendarOptions -> Maybe [CalendarOptions_ResponseStatusesItem]
versionDate :: CalendarOptions -> Maybe DateTime
locationQuery :: Maybe [Text]
minusWords :: Maybe [Text]
peopleQuery :: Maybe [Text]
responseStatuses :: Maybe [CalendarOptions_ResponseStatusesItem]
versionDate :: Maybe DateTime
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"locationQuery" Core..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Text]
locationQuery,
            (Key
"minusWords" Core..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Text]
minusWords,
            (Key
"peopleQuery" Core..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Text]
peopleQuery,
            (Key
"responseStatuses" Core..=) ([CalendarOptions_ResponseStatusesItem] -> Pair)
-> Maybe [CalendarOptions_ResponseStatusesItem] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [CalendarOptions_ResponseStatusesItem]
responseStatuses,
            (Key
"versionDate" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
versionDate
          ]
      )

-- | The request message for Operations.CancelOperation.
--
-- /See:/ 'newCancelOperationRequest' smart constructor.
data CancelOperationRequest = CancelOperationRequest
  deriving (CancelOperationRequest -> CancelOperationRequest -> Bool
(CancelOperationRequest -> CancelOperationRequest -> Bool)
-> (CancelOperationRequest -> CancelOperationRequest -> Bool)
-> Eq CancelOperationRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CancelOperationRequest -> CancelOperationRequest -> Bool
== :: CancelOperationRequest -> CancelOperationRequest -> Bool
$c/= :: CancelOperationRequest -> CancelOperationRequest -> Bool
/= :: CancelOperationRequest -> CancelOperationRequest -> Bool
Core.Eq, Int -> CancelOperationRequest -> ShowS
[CancelOperationRequest] -> ShowS
CancelOperationRequest -> String
(Int -> CancelOperationRequest -> ShowS)
-> (CancelOperationRequest -> String)
-> ([CancelOperationRequest] -> ShowS)
-> Show CancelOperationRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CancelOperationRequest -> ShowS
showsPrec :: Int -> CancelOperationRequest -> ShowS
$cshow :: CancelOperationRequest -> String
show :: CancelOperationRequest -> String
$cshowList :: [CancelOperationRequest] -> ShowS
showList :: [CancelOperationRequest] -> ShowS
Core.Show, (forall x. CancelOperationRequest -> Rep CancelOperationRequest x)
-> (forall x.
    Rep CancelOperationRequest x -> CancelOperationRequest)
-> Generic CancelOperationRequest
forall x. Rep CancelOperationRequest x -> CancelOperationRequest
forall x. CancelOperationRequest -> Rep CancelOperationRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CancelOperationRequest -> Rep CancelOperationRequest x
from :: forall x. CancelOperationRequest -> Rep CancelOperationRequest x
$cto :: forall x. Rep CancelOperationRequest x -> CancelOperationRequest
to :: forall x. Rep CancelOperationRequest x -> CancelOperationRequest
Core.Generic)

-- | Creates a value of 'CancelOperationRequest' with the minimum fields required to make a request.
newCancelOperationRequest ::
  CancelOperationRequest
newCancelOperationRequest :: CancelOperationRequest
newCancelOperationRequest = CancelOperationRequest
CancelOperationRequest

instance Core.FromJSON CancelOperationRequest where
  parseJSON :: Value -> Parser CancelOperationRequest
parseJSON =
    String
-> (Object -> Parser CancelOperationRequest)
-> Value
-> Parser CancelOperationRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"CancelOperationRequest"
      (\Object
o -> CancelOperationRequest -> Parser CancelOperationRequest
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Core.pure CancelOperationRequest
CancelOperationRequest)

instance Core.ToJSON CancelOperationRequest where
  toJSON :: CancelOperationRequest -> Value
toJSON = Value -> CancelOperationRequest -> Value
forall a b. a -> b -> a
Core.const Value
Core.emptyObject

-- | Close a matter by ID.
--
-- /See:/ 'newCloseMatterRequest' smart constructor.
data CloseMatterRequest = CloseMatterRequest
  deriving (CloseMatterRequest -> CloseMatterRequest -> Bool
(CloseMatterRequest -> CloseMatterRequest -> Bool)
-> (CloseMatterRequest -> CloseMatterRequest -> Bool)
-> Eq CloseMatterRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CloseMatterRequest -> CloseMatterRequest -> Bool
== :: CloseMatterRequest -> CloseMatterRequest -> Bool
$c/= :: CloseMatterRequest -> CloseMatterRequest -> Bool
/= :: CloseMatterRequest -> CloseMatterRequest -> Bool
Core.Eq, Int -> CloseMatterRequest -> ShowS
[CloseMatterRequest] -> ShowS
CloseMatterRequest -> String
(Int -> CloseMatterRequest -> ShowS)
-> (CloseMatterRequest -> String)
-> ([CloseMatterRequest] -> ShowS)
-> Show CloseMatterRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CloseMatterRequest -> ShowS
showsPrec :: Int -> CloseMatterRequest -> ShowS
$cshow :: CloseMatterRequest -> String
show :: CloseMatterRequest -> String
$cshowList :: [CloseMatterRequest] -> ShowS
showList :: [CloseMatterRequest] -> ShowS
Core.Show, (forall x. CloseMatterRequest -> Rep CloseMatterRequest x)
-> (forall x. Rep CloseMatterRequest x -> CloseMatterRequest)
-> Generic CloseMatterRequest
forall x. Rep CloseMatterRequest x -> CloseMatterRequest
forall x. CloseMatterRequest -> Rep CloseMatterRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CloseMatterRequest -> Rep CloseMatterRequest x
from :: forall x. CloseMatterRequest -> Rep CloseMatterRequest x
$cto :: forall x. Rep CloseMatterRequest x -> CloseMatterRequest
to :: forall x. Rep CloseMatterRequest x -> CloseMatterRequest
Core.Generic)

-- | Creates a value of 'CloseMatterRequest' with the minimum fields required to make a request.
newCloseMatterRequest ::
  CloseMatterRequest
newCloseMatterRequest :: CloseMatterRequest
newCloseMatterRequest = CloseMatterRequest
CloseMatterRequest

instance Core.FromJSON CloseMatterRequest where
  parseJSON :: Value -> Parser CloseMatterRequest
parseJSON =
    String
-> (Object -> Parser CloseMatterRequest)
-> Value
-> Parser CloseMatterRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"CloseMatterRequest"
      (\Object
o -> CloseMatterRequest -> Parser CloseMatterRequest
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Core.pure CloseMatterRequest
CloseMatterRequest)

instance Core.ToJSON CloseMatterRequest where
  toJSON :: CloseMatterRequest -> Value
toJSON = Value -> CloseMatterRequest -> Value
forall a b. a -> b -> a
Core.const Value
Core.emptyObject

-- | Response to a CloseMatterRequest.
--
-- /See:/ 'newCloseMatterResponse' smart constructor.
newtype CloseMatterResponse = CloseMatterResponse
  { -- | The updated matter, with state __CLOSED__.
    CloseMatterResponse -> Maybe Matter
matter :: (Core.Maybe Matter)
  }
  deriving (CloseMatterResponse -> CloseMatterResponse -> Bool
(CloseMatterResponse -> CloseMatterResponse -> Bool)
-> (CloseMatterResponse -> CloseMatterResponse -> Bool)
-> Eq CloseMatterResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CloseMatterResponse -> CloseMatterResponse -> Bool
== :: CloseMatterResponse -> CloseMatterResponse -> Bool
$c/= :: CloseMatterResponse -> CloseMatterResponse -> Bool
/= :: CloseMatterResponse -> CloseMatterResponse -> Bool
Core.Eq, Int -> CloseMatterResponse -> ShowS
[CloseMatterResponse] -> ShowS
CloseMatterResponse -> String
(Int -> CloseMatterResponse -> ShowS)
-> (CloseMatterResponse -> String)
-> ([CloseMatterResponse] -> ShowS)
-> Show CloseMatterResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CloseMatterResponse -> ShowS
showsPrec :: Int -> CloseMatterResponse -> ShowS
$cshow :: CloseMatterResponse -> String
show :: CloseMatterResponse -> String
$cshowList :: [CloseMatterResponse] -> ShowS
showList :: [CloseMatterResponse] -> ShowS
Core.Show, (forall x. CloseMatterResponse -> Rep CloseMatterResponse x)
-> (forall x. Rep CloseMatterResponse x -> CloseMatterResponse)
-> Generic CloseMatterResponse
forall x. Rep CloseMatterResponse x -> CloseMatterResponse
forall x. CloseMatterResponse -> Rep CloseMatterResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CloseMatterResponse -> Rep CloseMatterResponse x
from :: forall x. CloseMatterResponse -> Rep CloseMatterResponse x
$cto :: forall x. Rep CloseMatterResponse x -> CloseMatterResponse
to :: forall x. Rep CloseMatterResponse x -> CloseMatterResponse
Core.Generic)

-- | Creates a value of 'CloseMatterResponse' with the minimum fields required to make a request.
newCloseMatterResponse ::
  CloseMatterResponse
newCloseMatterResponse :: CloseMatterResponse
newCloseMatterResponse = CloseMatterResponse {matter :: Maybe Matter
matter = Maybe Matter
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON CloseMatterResponse where
  parseJSON :: Value -> Parser CloseMatterResponse
parseJSON =
    String
-> (Object -> Parser CloseMatterResponse)
-> Value
-> Parser CloseMatterResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"CloseMatterResponse"
      (\Object
o -> Maybe Matter -> CloseMatterResponse
CloseMatterResponse (Maybe Matter -> CloseMatterResponse)
-> Parser (Maybe Matter) -> Parser CloseMatterResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Matter)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"matter"))

instance Core.ToJSON CloseMatterResponse where
  toJSON :: CloseMatterResponse -> Value
toJSON CloseMatterResponse {Maybe Matter
matter :: CloseMatterResponse -> Maybe Matter
matter :: Maybe Matter
..} =
    [Pair] -> Value
Core.object ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"matter" Core..=) (Matter -> Pair) -> Maybe Matter -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Matter
matter])

-- | The export file in Cloud Storage
--
-- /See:/ 'newCloudStorageFile' smart constructor.
data CloudStorageFile = CloudStorageFile
  { -- | The name of the Cloud Storage bucket for the export file. You can use this value in the Cloud Storage <https://cloud.google.com/storage/docs/json_api JSON API> or <https://cloud.google.com/storage/docs/xml-api XML API>, but not to list the bucket contents. Instead, you can <https://cloud.google.com/storage/docs/json_api/v1/objects/get get individual export files> by object name.
    CloudStorageFile -> Maybe Text
bucketName :: (Core.Maybe Core.Text),
    -- | The md5 hash of the file.
    CloudStorageFile -> Maybe Text
md5Hash :: (Core.Maybe Core.Text),
    -- | The name of the Cloud Storage object for the export file. You can use this value in the Cloud Storage <https://cloud.google.com/storage/docs/json_api JSON API> or <https://cloud.google.com/storage/docs/xml-api XML API>.
    CloudStorageFile -> Maybe Text
objectName :: (Core.Maybe Core.Text),
    -- | The export file size.
    CloudStorageFile -> Maybe Int64
size :: (Core.Maybe Core.Int64)
  }
  deriving (CloudStorageFile -> CloudStorageFile -> Bool
(CloudStorageFile -> CloudStorageFile -> Bool)
-> (CloudStorageFile -> CloudStorageFile -> Bool)
-> Eq CloudStorageFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CloudStorageFile -> CloudStorageFile -> Bool
== :: CloudStorageFile -> CloudStorageFile -> Bool
$c/= :: CloudStorageFile -> CloudStorageFile -> Bool
/= :: CloudStorageFile -> CloudStorageFile -> Bool
Core.Eq, Int -> CloudStorageFile -> ShowS
[CloudStorageFile] -> ShowS
CloudStorageFile -> String
(Int -> CloudStorageFile -> ShowS)
-> (CloudStorageFile -> String)
-> ([CloudStorageFile] -> ShowS)
-> Show CloudStorageFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CloudStorageFile -> ShowS
showsPrec :: Int -> CloudStorageFile -> ShowS
$cshow :: CloudStorageFile -> String
show :: CloudStorageFile -> String
$cshowList :: [CloudStorageFile] -> ShowS
showList :: [CloudStorageFile] -> ShowS
Core.Show, (forall x. CloudStorageFile -> Rep CloudStorageFile x)
-> (forall x. Rep CloudStorageFile x -> CloudStorageFile)
-> Generic CloudStorageFile
forall x. Rep CloudStorageFile x -> CloudStorageFile
forall x. CloudStorageFile -> Rep CloudStorageFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CloudStorageFile -> Rep CloudStorageFile x
from :: forall x. CloudStorageFile -> Rep CloudStorageFile x
$cto :: forall x. Rep CloudStorageFile x -> CloudStorageFile
to :: forall x. Rep CloudStorageFile x -> CloudStorageFile
Core.Generic)

-- | Creates a value of 'CloudStorageFile' with the minimum fields required to make a request.
newCloudStorageFile ::
  CloudStorageFile
newCloudStorageFile :: CloudStorageFile
newCloudStorageFile =
  CloudStorageFile
    { bucketName :: Maybe Text
bucketName = Maybe Text
forall a. Maybe a
Core.Nothing,
      md5Hash :: Maybe Text
md5Hash = Maybe Text
forall a. Maybe a
Core.Nothing,
      objectName :: Maybe Text
objectName = Maybe Text
forall a. Maybe a
Core.Nothing,
      size :: Maybe Int64
size = Maybe Int64
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON CloudStorageFile where
  parseJSON :: Value -> Parser CloudStorageFile
parseJSON =
    String
-> (Object -> Parser CloudStorageFile)
-> Value
-> Parser CloudStorageFile
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"CloudStorageFile"
      ( \Object
o ->
          Maybe Text
-> Maybe Text -> Maybe Text -> Maybe Int64 -> CloudStorageFile
CloudStorageFile
            (Maybe Text
 -> Maybe Text -> Maybe Text -> Maybe Int64 -> CloudStorageFile)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Int64 -> CloudStorageFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"bucketName")
            Parser
  (Maybe Text -> Maybe Text -> Maybe Int64 -> CloudStorageFile)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Int64 -> CloudStorageFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"md5Hash")
            Parser (Maybe Text -> Maybe Int64 -> CloudStorageFile)
-> Parser (Maybe Text) -> Parser (Maybe Int64 -> CloudStorageFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"objectName")
            Parser (Maybe Int64 -> CloudStorageFile)
-> Parser (Maybe Int64) -> Parser CloudStorageFile
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe (AsText Int64))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"size" Parser (Maybe (AsText Int64))
-> (Maybe (AsText Int64) -> Maybe Int64) -> Parser (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Core.<&> (AsText Int64 -> Int64) -> Maybe (AsText Int64) -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.fmap AsText Int64 -> Int64
forall a. AsText a -> a
Core.fromAsText)
      )

instance Core.ToJSON CloudStorageFile where
  toJSON :: CloudStorageFile -> Value
toJSON CloudStorageFile {Maybe Int64
Maybe Text
bucketName :: CloudStorageFile -> Maybe Text
md5Hash :: CloudStorageFile -> Maybe Text
objectName :: CloudStorageFile -> Maybe Text
size :: CloudStorageFile -> Maybe Int64
bucketName :: Maybe Text
md5Hash :: Maybe Text
objectName :: Maybe Text
size :: Maybe Int64
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"bucketName" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
bucketName,
            (Key
"md5Hash" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
md5Hash,
            (Key
"objectName" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
objectName,
            (Key
"size" Core..=) (AsText Int64 -> Pair) -> (Int64 -> AsText Int64) -> Int64 -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
Core.. Int64 -> AsText Int64
forall a. a -> AsText a
Core.AsText (Int64 -> Pair) -> Maybe Int64 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int64
size
          ]
      )

-- | Export sink for Cloud Storage files.
--
-- /See:/ 'newCloudStorageSink' smart constructor.
newtype CloudStorageSink = CloudStorageSink
  { -- | Output only. The exported files in Cloud Storage.
    CloudStorageSink -> Maybe [CloudStorageFile]
files :: (Core.Maybe [CloudStorageFile])
  }
  deriving (CloudStorageSink -> CloudStorageSink -> Bool
(CloudStorageSink -> CloudStorageSink -> Bool)
-> (CloudStorageSink -> CloudStorageSink -> Bool)
-> Eq CloudStorageSink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CloudStorageSink -> CloudStorageSink -> Bool
== :: CloudStorageSink -> CloudStorageSink -> Bool
$c/= :: CloudStorageSink -> CloudStorageSink -> Bool
/= :: CloudStorageSink -> CloudStorageSink -> Bool
Core.Eq, Int -> CloudStorageSink -> ShowS
[CloudStorageSink] -> ShowS
CloudStorageSink -> String
(Int -> CloudStorageSink -> ShowS)
-> (CloudStorageSink -> String)
-> ([CloudStorageSink] -> ShowS)
-> Show CloudStorageSink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CloudStorageSink -> ShowS
showsPrec :: Int -> CloudStorageSink -> ShowS
$cshow :: CloudStorageSink -> String
show :: CloudStorageSink -> String
$cshowList :: [CloudStorageSink] -> ShowS
showList :: [CloudStorageSink] -> ShowS
Core.Show, (forall x. CloudStorageSink -> Rep CloudStorageSink x)
-> (forall x. Rep CloudStorageSink x -> CloudStorageSink)
-> Generic CloudStorageSink
forall x. Rep CloudStorageSink x -> CloudStorageSink
forall x. CloudStorageSink -> Rep CloudStorageSink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CloudStorageSink -> Rep CloudStorageSink x
from :: forall x. CloudStorageSink -> Rep CloudStorageSink x
$cto :: forall x. Rep CloudStorageSink x -> CloudStorageSink
to :: forall x. Rep CloudStorageSink x -> CloudStorageSink
Core.Generic)

-- | Creates a value of 'CloudStorageSink' with the minimum fields required to make a request.
newCloudStorageSink ::
  CloudStorageSink
newCloudStorageSink :: CloudStorageSink
newCloudStorageSink = CloudStorageSink {files :: Maybe [CloudStorageFile]
files = Maybe [CloudStorageFile]
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON CloudStorageSink where
  parseJSON :: Value -> Parser CloudStorageSink
parseJSON =
    String
-> (Object -> Parser CloudStorageSink)
-> Value
-> Parser CloudStorageSink
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"CloudStorageSink"
      (\Object
o -> Maybe [CloudStorageFile] -> CloudStorageSink
CloudStorageSink (Maybe [CloudStorageFile] -> CloudStorageSink)
-> Parser (Maybe [CloudStorageFile]) -> Parser CloudStorageSink
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [CloudStorageFile])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"files"))

instance Core.ToJSON CloudStorageSink where
  toJSON :: CloudStorageSink -> Value
toJSON CloudStorageSink {Maybe [CloudStorageFile]
files :: CloudStorageSink -> Maybe [CloudStorageFile]
files :: Maybe [CloudStorageFile]
..} =
    [Pair] -> Value
Core.object ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"files" Core..=) ([CloudStorageFile] -> Pair)
-> Maybe [CloudStorageFile] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [CloudStorageFile]
files])

-- | Service-specific options for holds.
--
-- /See:/ 'newCorpusQuery' smart constructor.
data CorpusQuery = CorpusQuery
  { -- | Service-specific options for Calendar holds. If set, __CorpusType__ must be __CALENDAR__.
    CorpusQuery -> Maybe HeldCalendarQuery
calendarQuery :: (Core.Maybe HeldCalendarQuery),
    -- | Service-specific options for Drive holds. If set, __CorpusType__ must be __DRIVE__.
    CorpusQuery -> Maybe HeldDriveQuery
driveQuery :: (Core.Maybe HeldDriveQuery),
    -- | Service-specific options for Groups holds. If set, __CorpusType__ must be __GROUPS__.
    CorpusQuery -> Maybe HeldGroupsQuery
groupsQuery :: (Core.Maybe HeldGroupsQuery),
    -- | Service-specific options for Chat holds. If set, __CorpusType__ must be **HANGOUTS_CHAT**.
    CorpusQuery -> Maybe HeldHangoutsChatQuery
hangoutsChatQuery :: (Core.Maybe HeldHangoutsChatQuery),
    -- | Service-specific options for Gmail holds. If set, __CorpusType__ must be __MAIL__.
    CorpusQuery -> Maybe HeldMailQuery
mailQuery :: (Core.Maybe HeldMailQuery),
    -- | Service-specific options for Voice holds. If set, __CorpusType__ must be __VOICE__.
    CorpusQuery -> Maybe HeldVoiceQuery
voiceQuery :: (Core.Maybe HeldVoiceQuery)
  }
  deriving (CorpusQuery -> CorpusQuery -> Bool
(CorpusQuery -> CorpusQuery -> Bool)
-> (CorpusQuery -> CorpusQuery -> Bool) -> Eq CorpusQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CorpusQuery -> CorpusQuery -> Bool
== :: CorpusQuery -> CorpusQuery -> Bool
$c/= :: CorpusQuery -> CorpusQuery -> Bool
/= :: CorpusQuery -> CorpusQuery -> Bool
Core.Eq, Int -> CorpusQuery -> ShowS
[CorpusQuery] -> ShowS
CorpusQuery -> String
(Int -> CorpusQuery -> ShowS)
-> (CorpusQuery -> String)
-> ([CorpusQuery] -> ShowS)
-> Show CorpusQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CorpusQuery -> ShowS
showsPrec :: Int -> CorpusQuery -> ShowS
$cshow :: CorpusQuery -> String
show :: CorpusQuery -> String
$cshowList :: [CorpusQuery] -> ShowS
showList :: [CorpusQuery] -> ShowS
Core.Show, (forall x. CorpusQuery -> Rep CorpusQuery x)
-> (forall x. Rep CorpusQuery x -> CorpusQuery)
-> Generic CorpusQuery
forall x. Rep CorpusQuery x -> CorpusQuery
forall x. CorpusQuery -> Rep CorpusQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CorpusQuery -> Rep CorpusQuery x
from :: forall x. CorpusQuery -> Rep CorpusQuery x
$cto :: forall x. Rep CorpusQuery x -> CorpusQuery
to :: forall x. Rep CorpusQuery x -> CorpusQuery
Core.Generic)

-- | Creates a value of 'CorpusQuery' with the minimum fields required to make a request.
newCorpusQuery ::
  CorpusQuery
newCorpusQuery :: CorpusQuery
newCorpusQuery =
  CorpusQuery
    { calendarQuery :: Maybe HeldCalendarQuery
calendarQuery = Maybe HeldCalendarQuery
forall a. Maybe a
Core.Nothing,
      driveQuery :: Maybe HeldDriveQuery
driveQuery = Maybe HeldDriveQuery
forall a. Maybe a
Core.Nothing,
      groupsQuery :: Maybe HeldGroupsQuery
groupsQuery = Maybe HeldGroupsQuery
forall a. Maybe a
Core.Nothing,
      hangoutsChatQuery :: Maybe HeldHangoutsChatQuery
hangoutsChatQuery = Maybe HeldHangoutsChatQuery
forall a. Maybe a
Core.Nothing,
      mailQuery :: Maybe HeldMailQuery
mailQuery = Maybe HeldMailQuery
forall a. Maybe a
Core.Nothing,
      voiceQuery :: Maybe HeldVoiceQuery
voiceQuery = Maybe HeldVoiceQuery
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON CorpusQuery where
  parseJSON :: Value -> Parser CorpusQuery
parseJSON =
    String
-> (Object -> Parser CorpusQuery) -> Value -> Parser CorpusQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"CorpusQuery"
      ( \Object
o ->
          Maybe HeldCalendarQuery
-> Maybe HeldDriveQuery
-> Maybe HeldGroupsQuery
-> Maybe HeldHangoutsChatQuery
-> Maybe HeldMailQuery
-> Maybe HeldVoiceQuery
-> CorpusQuery
CorpusQuery
            (Maybe HeldCalendarQuery
 -> Maybe HeldDriveQuery
 -> Maybe HeldGroupsQuery
 -> Maybe HeldHangoutsChatQuery
 -> Maybe HeldMailQuery
 -> Maybe HeldVoiceQuery
 -> CorpusQuery)
-> Parser (Maybe HeldCalendarQuery)
-> Parser
     (Maybe HeldDriveQuery
      -> Maybe HeldGroupsQuery
      -> Maybe HeldHangoutsChatQuery
      -> Maybe HeldMailQuery
      -> Maybe HeldVoiceQuery
      -> CorpusQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe HeldCalendarQuery)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"calendarQuery")
            Parser
  (Maybe HeldDriveQuery
   -> Maybe HeldGroupsQuery
   -> Maybe HeldHangoutsChatQuery
   -> Maybe HeldMailQuery
   -> Maybe HeldVoiceQuery
   -> CorpusQuery)
-> Parser (Maybe HeldDriveQuery)
-> Parser
     (Maybe HeldGroupsQuery
      -> Maybe HeldHangoutsChatQuery
      -> Maybe HeldMailQuery
      -> Maybe HeldVoiceQuery
      -> CorpusQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe HeldDriveQuery)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"driveQuery")
            Parser
  (Maybe HeldGroupsQuery
   -> Maybe HeldHangoutsChatQuery
   -> Maybe HeldMailQuery
   -> Maybe HeldVoiceQuery
   -> CorpusQuery)
-> Parser (Maybe HeldGroupsQuery)
-> Parser
     (Maybe HeldHangoutsChatQuery
      -> Maybe HeldMailQuery -> Maybe HeldVoiceQuery -> CorpusQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe HeldGroupsQuery)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"groupsQuery")
            Parser
  (Maybe HeldHangoutsChatQuery
   -> Maybe HeldMailQuery -> Maybe HeldVoiceQuery -> CorpusQuery)
-> Parser (Maybe HeldHangoutsChatQuery)
-> Parser
     (Maybe HeldMailQuery -> Maybe HeldVoiceQuery -> CorpusQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe HeldHangoutsChatQuery)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"hangoutsChatQuery")
            Parser (Maybe HeldMailQuery -> Maybe HeldVoiceQuery -> CorpusQuery)
-> Parser (Maybe HeldMailQuery)
-> Parser (Maybe HeldVoiceQuery -> CorpusQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe HeldMailQuery)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"mailQuery")
            Parser (Maybe HeldVoiceQuery -> CorpusQuery)
-> Parser (Maybe HeldVoiceQuery) -> Parser CorpusQuery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe HeldVoiceQuery)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"voiceQuery")
      )

instance Core.ToJSON CorpusQuery where
  toJSON :: CorpusQuery -> Value
toJSON CorpusQuery {Maybe HeldVoiceQuery
Maybe HeldMailQuery
Maybe HeldHangoutsChatQuery
Maybe HeldGroupsQuery
Maybe HeldDriveQuery
Maybe HeldCalendarQuery
calendarQuery :: CorpusQuery -> Maybe HeldCalendarQuery
driveQuery :: CorpusQuery -> Maybe HeldDriveQuery
groupsQuery :: CorpusQuery -> Maybe HeldGroupsQuery
hangoutsChatQuery :: CorpusQuery -> Maybe HeldHangoutsChatQuery
mailQuery :: CorpusQuery -> Maybe HeldMailQuery
voiceQuery :: CorpusQuery -> Maybe HeldVoiceQuery
calendarQuery :: Maybe HeldCalendarQuery
driveQuery :: Maybe HeldDriveQuery
groupsQuery :: Maybe HeldGroupsQuery
hangoutsChatQuery :: Maybe HeldHangoutsChatQuery
mailQuery :: Maybe HeldMailQuery
voiceQuery :: Maybe HeldVoiceQuery
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"calendarQuery" Core..=) (HeldCalendarQuery -> Pair)
-> Maybe HeldCalendarQuery -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe HeldCalendarQuery
calendarQuery,
            (Key
"driveQuery" Core..=) (HeldDriveQuery -> Pair) -> Maybe HeldDriveQuery -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe HeldDriveQuery
driveQuery,
            (Key
"groupsQuery" Core..=) (HeldGroupsQuery -> Pair) -> Maybe HeldGroupsQuery -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe HeldGroupsQuery
groupsQuery,
            (Key
"hangoutsChatQuery" Core..=) (HeldHangoutsChatQuery -> Pair)
-> Maybe HeldHangoutsChatQuery -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe HeldHangoutsChatQuery
hangoutsChatQuery,
            (Key
"mailQuery" Core..=) (HeldMailQuery -> Pair) -> Maybe HeldMailQuery -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe HeldMailQuery
mailQuery,
            (Key
"voiceQuery" Core..=) (HeldVoiceQuery -> Pair) -> Maybe HeldVoiceQuery -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe HeldVoiceQuery
voiceQuery
          ]
      )

-- | Long running operation metadata for CountArtifacts.
--
-- /See:/ 'newCountArtifactsMetadata' smart constructor.
data CountArtifactsMetadata = CountArtifactsMetadata
  { -- | End time of count operation. Available when operation is done.
    CountArtifactsMetadata -> Maybe DateTime
endTime :: (Core.Maybe Core.DateTime),
    -- | The matter ID of the associated matter.
    CountArtifactsMetadata -> Maybe Text
matterId :: (Core.Maybe Core.Text),
    -- | The search query from the request.
    CountArtifactsMetadata -> Maybe Query
query :: (Core.Maybe Query),
    -- | Creation time of count operation.
    CountArtifactsMetadata -> Maybe DateTime
startTime :: (Core.Maybe Core.DateTime)
  }
  deriving (CountArtifactsMetadata -> CountArtifactsMetadata -> Bool
(CountArtifactsMetadata -> CountArtifactsMetadata -> Bool)
-> (CountArtifactsMetadata -> CountArtifactsMetadata -> Bool)
-> Eq CountArtifactsMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CountArtifactsMetadata -> CountArtifactsMetadata -> Bool
== :: CountArtifactsMetadata -> CountArtifactsMetadata -> Bool
$c/= :: CountArtifactsMetadata -> CountArtifactsMetadata -> Bool
/= :: CountArtifactsMetadata -> CountArtifactsMetadata -> Bool
Core.Eq, Int -> CountArtifactsMetadata -> ShowS
[CountArtifactsMetadata] -> ShowS
CountArtifactsMetadata -> String
(Int -> CountArtifactsMetadata -> ShowS)
-> (CountArtifactsMetadata -> String)
-> ([CountArtifactsMetadata] -> ShowS)
-> Show CountArtifactsMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CountArtifactsMetadata -> ShowS
showsPrec :: Int -> CountArtifactsMetadata -> ShowS
$cshow :: CountArtifactsMetadata -> String
show :: CountArtifactsMetadata -> String
$cshowList :: [CountArtifactsMetadata] -> ShowS
showList :: [CountArtifactsMetadata] -> ShowS
Core.Show, (forall x. CountArtifactsMetadata -> Rep CountArtifactsMetadata x)
-> (forall x.
    Rep CountArtifactsMetadata x -> CountArtifactsMetadata)
-> Generic CountArtifactsMetadata
forall x. Rep CountArtifactsMetadata x -> CountArtifactsMetadata
forall x. CountArtifactsMetadata -> Rep CountArtifactsMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CountArtifactsMetadata -> Rep CountArtifactsMetadata x
from :: forall x. CountArtifactsMetadata -> Rep CountArtifactsMetadata x
$cto :: forall x. Rep CountArtifactsMetadata x -> CountArtifactsMetadata
to :: forall x. Rep CountArtifactsMetadata x -> CountArtifactsMetadata
Core.Generic)

-- | Creates a value of 'CountArtifactsMetadata' with the minimum fields required to make a request.
newCountArtifactsMetadata ::
  CountArtifactsMetadata
newCountArtifactsMetadata :: CountArtifactsMetadata
newCountArtifactsMetadata =
  CountArtifactsMetadata
    { endTime :: Maybe DateTime
endTime = Maybe DateTime
forall a. Maybe a
Core.Nothing,
      matterId :: Maybe Text
matterId = Maybe Text
forall a. Maybe a
Core.Nothing,
      query :: Maybe Query
query = Maybe Query
forall a. Maybe a
Core.Nothing,
      startTime :: Maybe DateTime
startTime = Maybe DateTime
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON CountArtifactsMetadata where
  parseJSON :: Value -> Parser CountArtifactsMetadata
parseJSON =
    String
-> (Object -> Parser CountArtifactsMetadata)
-> Value
-> Parser CountArtifactsMetadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"CountArtifactsMetadata"
      ( \Object
o ->
          Maybe DateTime
-> Maybe Text
-> Maybe Query
-> Maybe DateTime
-> CountArtifactsMetadata
CountArtifactsMetadata
            (Maybe DateTime
 -> Maybe Text
 -> Maybe Query
 -> Maybe DateTime
 -> CountArtifactsMetadata)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Query -> Maybe DateTime -> CountArtifactsMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"endTime")
            Parser
  (Maybe Text
   -> Maybe Query -> Maybe DateTime -> CountArtifactsMetadata)
-> Parser (Maybe Text)
-> Parser (Maybe Query -> Maybe DateTime -> CountArtifactsMetadata)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"matterId")
            Parser (Maybe Query -> Maybe DateTime -> CountArtifactsMetadata)
-> Parser (Maybe Query)
-> Parser (Maybe DateTime -> CountArtifactsMetadata)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Query)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"query")
            Parser (Maybe DateTime -> CountArtifactsMetadata)
-> Parser (Maybe DateTime) -> Parser CountArtifactsMetadata
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"startTime")
      )

instance Core.ToJSON CountArtifactsMetadata where
  toJSON :: CountArtifactsMetadata -> Value
toJSON CountArtifactsMetadata {Maybe Text
Maybe DateTime
Maybe Query
endTime :: CountArtifactsMetadata -> Maybe DateTime
matterId :: CountArtifactsMetadata -> Maybe Text
query :: CountArtifactsMetadata -> Maybe Query
startTime :: CountArtifactsMetadata -> Maybe DateTime
endTime :: Maybe DateTime
matterId :: Maybe Text
query :: Maybe Query
startTime :: Maybe DateTime
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"endTime" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
endTime,
            (Key
"matterId" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
matterId,
            (Key
"query" Core..=) (Query -> Pair) -> Maybe Query -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Query
query,
            (Key
"startTime" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
startTime
          ]
      )

-- | Count artifacts request.
--
-- /See:/ 'newCountArtifactsRequest' smart constructor.
data CountArtifactsRequest = CountArtifactsRequest
  { -- | The search query.
    CountArtifactsRequest -> Maybe Query
query :: (Core.Maybe Query),
    -- | Sets the granularity of the count results.
    CountArtifactsRequest -> Maybe CountArtifactsRequest_View
view :: (Core.Maybe CountArtifactsRequest_View)
  }
  deriving (CountArtifactsRequest -> CountArtifactsRequest -> Bool
(CountArtifactsRequest -> CountArtifactsRequest -> Bool)
-> (CountArtifactsRequest -> CountArtifactsRequest -> Bool)
-> Eq CountArtifactsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CountArtifactsRequest -> CountArtifactsRequest -> Bool
== :: CountArtifactsRequest -> CountArtifactsRequest -> Bool
$c/= :: CountArtifactsRequest -> CountArtifactsRequest -> Bool
/= :: CountArtifactsRequest -> CountArtifactsRequest -> Bool
Core.Eq, Int -> CountArtifactsRequest -> ShowS
[CountArtifactsRequest] -> ShowS
CountArtifactsRequest -> String
(Int -> CountArtifactsRequest -> ShowS)
-> (CountArtifactsRequest -> String)
-> ([CountArtifactsRequest] -> ShowS)
-> Show CountArtifactsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CountArtifactsRequest -> ShowS
showsPrec :: Int -> CountArtifactsRequest -> ShowS
$cshow :: CountArtifactsRequest -> String
show :: CountArtifactsRequest -> String
$cshowList :: [CountArtifactsRequest] -> ShowS
showList :: [CountArtifactsRequest] -> ShowS
Core.Show, (forall x. CountArtifactsRequest -> Rep CountArtifactsRequest x)
-> (forall x. Rep CountArtifactsRequest x -> CountArtifactsRequest)
-> Generic CountArtifactsRequest
forall x. Rep CountArtifactsRequest x -> CountArtifactsRequest
forall x. CountArtifactsRequest -> Rep CountArtifactsRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CountArtifactsRequest -> Rep CountArtifactsRequest x
from :: forall x. CountArtifactsRequest -> Rep CountArtifactsRequest x
$cto :: forall x. Rep CountArtifactsRequest x -> CountArtifactsRequest
to :: forall x. Rep CountArtifactsRequest x -> CountArtifactsRequest
Core.Generic)

-- | Creates a value of 'CountArtifactsRequest' with the minimum fields required to make a request.
newCountArtifactsRequest ::
  CountArtifactsRequest
newCountArtifactsRequest :: CountArtifactsRequest
newCountArtifactsRequest =
  CountArtifactsRequest {query :: Maybe Query
query = Maybe Query
forall a. Maybe a
Core.Nothing, view :: Maybe CountArtifactsRequest_View
view = Maybe CountArtifactsRequest_View
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON CountArtifactsRequest where
  parseJSON :: Value -> Parser CountArtifactsRequest
parseJSON =
    String
-> (Object -> Parser CountArtifactsRequest)
-> Value
-> Parser CountArtifactsRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"CountArtifactsRequest"
      ( \Object
o ->
          Maybe Query
-> Maybe CountArtifactsRequest_View -> CountArtifactsRequest
CountArtifactsRequest
            (Maybe Query
 -> Maybe CountArtifactsRequest_View -> CountArtifactsRequest)
-> Parser (Maybe Query)
-> Parser
     (Maybe CountArtifactsRequest_View -> CountArtifactsRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Query)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"query")
            Parser (Maybe CountArtifactsRequest_View -> CountArtifactsRequest)
-> Parser (Maybe CountArtifactsRequest_View)
-> Parser CountArtifactsRequest
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe CountArtifactsRequest_View)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"view")
      )

instance Core.ToJSON CountArtifactsRequest where
  toJSON :: CountArtifactsRequest -> Value
toJSON CountArtifactsRequest {Maybe CountArtifactsRequest_View
Maybe Query
query :: CountArtifactsRequest -> Maybe Query
view :: CountArtifactsRequest -> Maybe CountArtifactsRequest_View
query :: Maybe Query
view :: Maybe CountArtifactsRequest_View
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [(Key
"query" Core..=) (Query -> Pair) -> Maybe Query -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Query
query, (Key
"view" Core..=) (CountArtifactsRequest_View -> Pair)
-> Maybe CountArtifactsRequest_View -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe CountArtifactsRequest_View
view]
      )

-- | Definition of the response for method CountArtifacts.
--
-- /See:/ 'newCountArtifactsResponse' smart constructor.
data CountArtifactsResponse = CountArtifactsResponse
  { -- | Count metrics for Groups.
    CountArtifactsResponse -> Maybe GroupsCountResult
groupsCountResult :: (Core.Maybe GroupsCountResult),
    -- | Count metrics for Gmail and classic Hangouts.
    CountArtifactsResponse -> Maybe MailCountResult
mailCountResult :: (Core.Maybe MailCountResult),
    -- | Total count of messages.
    CountArtifactsResponse -> Maybe Int64
totalCount :: (Core.Maybe Core.Int64)
  }
  deriving (CountArtifactsResponse -> CountArtifactsResponse -> Bool
(CountArtifactsResponse -> CountArtifactsResponse -> Bool)
-> (CountArtifactsResponse -> CountArtifactsResponse -> Bool)
-> Eq CountArtifactsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CountArtifactsResponse -> CountArtifactsResponse -> Bool
== :: CountArtifactsResponse -> CountArtifactsResponse -> Bool
$c/= :: CountArtifactsResponse -> CountArtifactsResponse -> Bool
/= :: CountArtifactsResponse -> CountArtifactsResponse -> Bool
Core.Eq, Int -> CountArtifactsResponse -> ShowS
[CountArtifactsResponse] -> ShowS
CountArtifactsResponse -> String
(Int -> CountArtifactsResponse -> ShowS)
-> (CountArtifactsResponse -> String)
-> ([CountArtifactsResponse] -> ShowS)
-> Show CountArtifactsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CountArtifactsResponse -> ShowS
showsPrec :: Int -> CountArtifactsResponse -> ShowS
$cshow :: CountArtifactsResponse -> String
show :: CountArtifactsResponse -> String
$cshowList :: [CountArtifactsResponse] -> ShowS
showList :: [CountArtifactsResponse] -> ShowS
Core.Show, (forall x. CountArtifactsResponse -> Rep CountArtifactsResponse x)
-> (forall x.
    Rep CountArtifactsResponse x -> CountArtifactsResponse)
-> Generic CountArtifactsResponse
forall x. Rep CountArtifactsResponse x -> CountArtifactsResponse
forall x. CountArtifactsResponse -> Rep CountArtifactsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CountArtifactsResponse -> Rep CountArtifactsResponse x
from :: forall x. CountArtifactsResponse -> Rep CountArtifactsResponse x
$cto :: forall x. Rep CountArtifactsResponse x -> CountArtifactsResponse
to :: forall x. Rep CountArtifactsResponse x -> CountArtifactsResponse
Core.Generic)

-- | Creates a value of 'CountArtifactsResponse' with the minimum fields required to make a request.
newCountArtifactsResponse ::
  CountArtifactsResponse
newCountArtifactsResponse :: CountArtifactsResponse
newCountArtifactsResponse =
  CountArtifactsResponse
    { groupsCountResult :: Maybe GroupsCountResult
groupsCountResult = Maybe GroupsCountResult
forall a. Maybe a
Core.Nothing,
      mailCountResult :: Maybe MailCountResult
mailCountResult = Maybe MailCountResult
forall a. Maybe a
Core.Nothing,
      totalCount :: Maybe Int64
totalCount = Maybe Int64
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON CountArtifactsResponse where
  parseJSON :: Value -> Parser CountArtifactsResponse
parseJSON =
    String
-> (Object -> Parser CountArtifactsResponse)
-> Value
-> Parser CountArtifactsResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"CountArtifactsResponse"
      ( \Object
o ->
          Maybe GroupsCountResult
-> Maybe MailCountResult -> Maybe Int64 -> CountArtifactsResponse
CountArtifactsResponse
            (Maybe GroupsCountResult
 -> Maybe MailCountResult -> Maybe Int64 -> CountArtifactsResponse)
-> Parser (Maybe GroupsCountResult)
-> Parser
     (Maybe MailCountResult -> Maybe Int64 -> CountArtifactsResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe GroupsCountResult)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"groupsCountResult")
            Parser
  (Maybe MailCountResult -> Maybe Int64 -> CountArtifactsResponse)
-> Parser (Maybe MailCountResult)
-> Parser (Maybe Int64 -> CountArtifactsResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe MailCountResult)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"mailCountResult")
            Parser (Maybe Int64 -> CountArtifactsResponse)
-> Parser (Maybe Int64) -> Parser CountArtifactsResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe (AsText Int64))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"totalCount" Parser (Maybe (AsText Int64))
-> (Maybe (AsText Int64) -> Maybe Int64) -> Parser (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Core.<&> (AsText Int64 -> Int64) -> Maybe (AsText Int64) -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.fmap AsText Int64 -> Int64
forall a. AsText a -> a
Core.fromAsText)
      )

instance Core.ToJSON CountArtifactsResponse where
  toJSON :: CountArtifactsResponse -> Value
toJSON CountArtifactsResponse {Maybe Int64
Maybe MailCountResult
Maybe GroupsCountResult
groupsCountResult :: CountArtifactsResponse -> Maybe GroupsCountResult
mailCountResult :: CountArtifactsResponse -> Maybe MailCountResult
totalCount :: CountArtifactsResponse -> Maybe Int64
groupsCountResult :: Maybe GroupsCountResult
mailCountResult :: Maybe MailCountResult
totalCount :: Maybe Int64
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"groupsCountResult" Core..=) (GroupsCountResult -> Pair)
-> Maybe GroupsCountResult -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe GroupsCountResult
groupsCountResult,
            (Key
"mailCountResult" Core..=) (MailCountResult -> Pair) -> Maybe MailCountResult -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe MailCountResult
mailCountResult,
            (Key
"totalCount" Core..=) (AsText Int64 -> Pair) -> (Int64 -> AsText Int64) -> Int64 -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
Core.. Int64 -> AsText Int64
forall a. a -> AsText a
Core.AsText (Int64 -> Pair) -> Maybe Int64 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int64
totalCount
          ]
      )

-- | Specify Drive documents by document ID.
--
-- /See:/ 'newDriveDocumentIds' smart constructor.
newtype DriveDocumentIds = DriveDocumentIds
  { -- | Required. A list of Drive document IDs.
    DriveDocumentIds -> Maybe [Text]
ids :: (Core.Maybe [Core.Text])
  }
  deriving (DriveDocumentIds -> DriveDocumentIds -> Bool
(DriveDocumentIds -> DriveDocumentIds -> Bool)
-> (DriveDocumentIds -> DriveDocumentIds -> Bool)
-> Eq DriveDocumentIds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DriveDocumentIds -> DriveDocumentIds -> Bool
== :: DriveDocumentIds -> DriveDocumentIds -> Bool
$c/= :: DriveDocumentIds -> DriveDocumentIds -> Bool
/= :: DriveDocumentIds -> DriveDocumentIds -> Bool
Core.Eq, Int -> DriveDocumentIds -> ShowS
[DriveDocumentIds] -> ShowS
DriveDocumentIds -> String
(Int -> DriveDocumentIds -> ShowS)
-> (DriveDocumentIds -> String)
-> ([DriveDocumentIds] -> ShowS)
-> Show DriveDocumentIds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DriveDocumentIds -> ShowS
showsPrec :: Int -> DriveDocumentIds -> ShowS
$cshow :: DriveDocumentIds -> String
show :: DriveDocumentIds -> String
$cshowList :: [DriveDocumentIds] -> ShowS
showList :: [DriveDocumentIds] -> ShowS
Core.Show, (forall x. DriveDocumentIds -> Rep DriveDocumentIds x)
-> (forall x. Rep DriveDocumentIds x -> DriveDocumentIds)
-> Generic DriveDocumentIds
forall x. Rep DriveDocumentIds x -> DriveDocumentIds
forall x. DriveDocumentIds -> Rep DriveDocumentIds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DriveDocumentIds -> Rep DriveDocumentIds x
from :: forall x. DriveDocumentIds -> Rep DriveDocumentIds x
$cto :: forall x. Rep DriveDocumentIds x -> DriveDocumentIds
to :: forall x. Rep DriveDocumentIds x -> DriveDocumentIds
Core.Generic)

-- | Creates a value of 'DriveDocumentIds' with the minimum fields required to make a request.
newDriveDocumentIds ::
  DriveDocumentIds
newDriveDocumentIds :: DriveDocumentIds
newDriveDocumentIds = DriveDocumentIds {ids :: Maybe [Text]
ids = Maybe [Text]
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON DriveDocumentIds where
  parseJSON :: Value -> Parser DriveDocumentIds
parseJSON =
    String
-> (Object -> Parser DriveDocumentIds)
-> Value
-> Parser DriveDocumentIds
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"DriveDocumentIds"
      (\Object
o -> Maybe [Text] -> DriveDocumentIds
DriveDocumentIds (Maybe [Text] -> DriveDocumentIds)
-> Parser (Maybe [Text]) -> Parser DriveDocumentIds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"ids"))

instance Core.ToJSON DriveDocumentIds where
  toJSON :: DriveDocumentIds -> Value
toJSON DriveDocumentIds {Maybe [Text]
ids :: DriveDocumentIds -> Maybe [Text]
ids :: Maybe [Text]
..} =
    [Pair] -> Value
Core.object ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"ids" Core..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Text]
ids])

-- | The Drive documents to search.
--
-- /See:/ 'newDriveDocumentInfo' smart constructor.
newtype DriveDocumentInfo = DriveDocumentInfo
  { -- | Specify Drive documents by document ID.
    DriveDocumentInfo -> Maybe DriveDocumentIds
documentIds :: (Core.Maybe DriveDocumentIds)
  }
  deriving (DriveDocumentInfo -> DriveDocumentInfo -> Bool
(DriveDocumentInfo -> DriveDocumentInfo -> Bool)
-> (DriveDocumentInfo -> DriveDocumentInfo -> Bool)
-> Eq DriveDocumentInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DriveDocumentInfo -> DriveDocumentInfo -> Bool
== :: DriveDocumentInfo -> DriveDocumentInfo -> Bool
$c/= :: DriveDocumentInfo -> DriveDocumentInfo -> Bool
/= :: DriveDocumentInfo -> DriveDocumentInfo -> Bool
Core.Eq, Int -> DriveDocumentInfo -> ShowS
[DriveDocumentInfo] -> ShowS
DriveDocumentInfo -> String
(Int -> DriveDocumentInfo -> ShowS)
-> (DriveDocumentInfo -> String)
-> ([DriveDocumentInfo] -> ShowS)
-> Show DriveDocumentInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DriveDocumentInfo -> ShowS
showsPrec :: Int -> DriveDocumentInfo -> ShowS
$cshow :: DriveDocumentInfo -> String
show :: DriveDocumentInfo -> String
$cshowList :: [DriveDocumentInfo] -> ShowS
showList :: [DriveDocumentInfo] -> ShowS
Core.Show, (forall x. DriveDocumentInfo -> Rep DriveDocumentInfo x)
-> (forall x. Rep DriveDocumentInfo x -> DriveDocumentInfo)
-> Generic DriveDocumentInfo
forall x. Rep DriveDocumentInfo x -> DriveDocumentInfo
forall x. DriveDocumentInfo -> Rep DriveDocumentInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DriveDocumentInfo -> Rep DriveDocumentInfo x
from :: forall x. DriveDocumentInfo -> Rep DriveDocumentInfo x
$cto :: forall x. Rep DriveDocumentInfo x -> DriveDocumentInfo
to :: forall x. Rep DriveDocumentInfo x -> DriveDocumentInfo
Core.Generic)

-- | Creates a value of 'DriveDocumentInfo' with the minimum fields required to make a request.
newDriveDocumentInfo ::
  DriveDocumentInfo
newDriveDocumentInfo :: DriveDocumentInfo
newDriveDocumentInfo =
  DriveDocumentInfo {documentIds :: Maybe DriveDocumentIds
documentIds = Maybe DriveDocumentIds
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON DriveDocumentInfo where
  parseJSON :: Value -> Parser DriveDocumentInfo
parseJSON =
    String
-> (Object -> Parser DriveDocumentInfo)
-> Value
-> Parser DriveDocumentInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"DriveDocumentInfo"
      (\Object
o -> Maybe DriveDocumentIds -> DriveDocumentInfo
DriveDocumentInfo (Maybe DriveDocumentIds -> DriveDocumentInfo)
-> Parser (Maybe DriveDocumentIds) -> Parser DriveDocumentInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe DriveDocumentIds)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"documentIds"))

instance Core.ToJSON DriveDocumentInfo where
  toJSON :: DriveDocumentInfo -> Value
toJSON DriveDocumentInfo {Maybe DriveDocumentIds
documentIds :: DriveDocumentInfo -> Maybe DriveDocumentIds
documentIds :: Maybe DriveDocumentIds
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"documentIds" Core..=) (DriveDocumentIds -> Pair) -> Maybe DriveDocumentIds -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DriveDocumentIds
documentIds])

-- | Options for Drive exports.
--
-- /See:/ 'newDriveExportOptions' smart constructor.
newtype DriveExportOptions = DriveExportOptions
  { -- | To include access level information for users with <https://support.google.com/vault/answer/6099459#metadata indirect access> to files, set to __true__.
    DriveExportOptions -> Maybe Bool
includeAccessInfo :: (Core.Maybe Core.Bool)
  }
  deriving (DriveExportOptions -> DriveExportOptions -> Bool
(DriveExportOptions -> DriveExportOptions -> Bool)
-> (DriveExportOptions -> DriveExportOptions -> Bool)
-> Eq DriveExportOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DriveExportOptions -> DriveExportOptions -> Bool
== :: DriveExportOptions -> DriveExportOptions -> Bool
$c/= :: DriveExportOptions -> DriveExportOptions -> Bool
/= :: DriveExportOptions -> DriveExportOptions -> Bool
Core.Eq, Int -> DriveExportOptions -> ShowS
[DriveExportOptions] -> ShowS
DriveExportOptions -> String
(Int -> DriveExportOptions -> ShowS)
-> (DriveExportOptions -> String)
-> ([DriveExportOptions] -> ShowS)
-> Show DriveExportOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DriveExportOptions -> ShowS
showsPrec :: Int -> DriveExportOptions -> ShowS
$cshow :: DriveExportOptions -> String
show :: DriveExportOptions -> String
$cshowList :: [DriveExportOptions] -> ShowS
showList :: [DriveExportOptions] -> ShowS
Core.Show, (forall x. DriveExportOptions -> Rep DriveExportOptions x)
-> (forall x. Rep DriveExportOptions x -> DriveExportOptions)
-> Generic DriveExportOptions
forall x. Rep DriveExportOptions x -> DriveExportOptions
forall x. DriveExportOptions -> Rep DriveExportOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DriveExportOptions -> Rep DriveExportOptions x
from :: forall x. DriveExportOptions -> Rep DriveExportOptions x
$cto :: forall x. Rep DriveExportOptions x -> DriveExportOptions
to :: forall x. Rep DriveExportOptions x -> DriveExportOptions
Core.Generic)

-- | Creates a value of 'DriveExportOptions' with the minimum fields required to make a request.
newDriveExportOptions ::
  DriveExportOptions
newDriveExportOptions :: DriveExportOptions
newDriveExportOptions =
  DriveExportOptions {includeAccessInfo :: Maybe Bool
includeAccessInfo = Maybe Bool
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON DriveExportOptions where
  parseJSON :: Value -> Parser DriveExportOptions
parseJSON =
    String
-> (Object -> Parser DriveExportOptions)
-> Value
-> Parser DriveExportOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"DriveExportOptions"
      ( \Object
o ->
          Maybe Bool -> DriveExportOptions
DriveExportOptions (Maybe Bool -> DriveExportOptions)
-> Parser (Maybe Bool) -> Parser DriveExportOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"includeAccessInfo")
      )

instance Core.ToJSON DriveExportOptions where
  toJSON :: DriveExportOptions -> Value
toJSON DriveExportOptions {Maybe Bool
includeAccessInfo :: DriveExportOptions -> Maybe Bool
includeAccessInfo :: Maybe Bool
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [(Key
"includeAccessInfo" Core..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Bool
includeAccessInfo]
      )

-- | Additional options for Drive search.
--
-- /See:/ 'newDriveOptions' smart constructor.
data DriveOptions = DriveOptions
  { -- | Set whether the results include only content encrypted with <https://support.google.com/a?p=cse_ov Google Workspace Client-side encryption> content, only unencrypted content, or both. Defaults to both. Currently supported for Drive.
    DriveOptions -> Maybe DriveOptions_ClientSideEncryptedOption
clientSideEncryptedOption :: (Core.Maybe DriveOptions_ClientSideEncryptedOption),
    -- | Set to __true__ to include shared drives.
    DriveOptions -> Maybe Bool
includeSharedDrives :: (Core.Maybe Core.Bool),
    -- | Set to true to include Team Drive.
    DriveOptions -> Maybe Bool
includeTeamDrives :: (Core.Maybe Core.Bool),
    -- | Search the current version of the Drive file, but export the contents of the last version saved before 12:00 AM UTC on the specified date. Enter the date in UTC.
    DriveOptions -> Maybe DateTime
versionDate :: (Core.Maybe Core.DateTime)
  }
  deriving (DriveOptions -> DriveOptions -> Bool
(DriveOptions -> DriveOptions -> Bool)
-> (DriveOptions -> DriveOptions -> Bool) -> Eq DriveOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DriveOptions -> DriveOptions -> Bool
== :: DriveOptions -> DriveOptions -> Bool
$c/= :: DriveOptions -> DriveOptions -> Bool
/= :: DriveOptions -> DriveOptions -> Bool
Core.Eq, Int -> DriveOptions -> ShowS
[DriveOptions] -> ShowS
DriveOptions -> String
(Int -> DriveOptions -> ShowS)
-> (DriveOptions -> String)
-> ([DriveOptions] -> ShowS)
-> Show DriveOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DriveOptions -> ShowS
showsPrec :: Int -> DriveOptions -> ShowS
$cshow :: DriveOptions -> String
show :: DriveOptions -> String
$cshowList :: [DriveOptions] -> ShowS
showList :: [DriveOptions] -> ShowS
Core.Show, (forall x. DriveOptions -> Rep DriveOptions x)
-> (forall x. Rep DriveOptions x -> DriveOptions)
-> Generic DriveOptions
forall x. Rep DriveOptions x -> DriveOptions
forall x. DriveOptions -> Rep DriveOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DriveOptions -> Rep DriveOptions x
from :: forall x. DriveOptions -> Rep DriveOptions x
$cto :: forall x. Rep DriveOptions x -> DriveOptions
to :: forall x. Rep DriveOptions x -> DriveOptions
Core.Generic)

-- | Creates a value of 'DriveOptions' with the minimum fields required to make a request.
newDriveOptions ::
  DriveOptions
newDriveOptions :: DriveOptions
newDriveOptions =
  DriveOptions
    { clientSideEncryptedOption :: Maybe DriveOptions_ClientSideEncryptedOption
clientSideEncryptedOption = Maybe DriveOptions_ClientSideEncryptedOption
forall a. Maybe a
Core.Nothing,
      includeSharedDrives :: Maybe Bool
includeSharedDrives = Maybe Bool
forall a. Maybe a
Core.Nothing,
      includeTeamDrives :: Maybe Bool
includeTeamDrives = Maybe Bool
forall a. Maybe a
Core.Nothing,
      versionDate :: Maybe DateTime
versionDate = Maybe DateTime
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON DriveOptions where
  parseJSON :: Value -> Parser DriveOptions
parseJSON =
    String
-> (Object -> Parser DriveOptions) -> Value -> Parser DriveOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"DriveOptions"
      ( \Object
o ->
          Maybe DriveOptions_ClientSideEncryptedOption
-> Maybe Bool -> Maybe Bool -> Maybe DateTime -> DriveOptions
DriveOptions
            (Maybe DriveOptions_ClientSideEncryptedOption
 -> Maybe Bool -> Maybe Bool -> Maybe DateTime -> DriveOptions)
-> Parser (Maybe DriveOptions_ClientSideEncryptedOption)
-> Parser
     (Maybe Bool -> Maybe Bool -> Maybe DateTime -> DriveOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object
-> Key -> Parser (Maybe DriveOptions_ClientSideEncryptedOption)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"clientSideEncryptedOption")
            Parser (Maybe Bool -> Maybe Bool -> Maybe DateTime -> DriveOptions)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> Maybe DateTime -> DriveOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"includeSharedDrives")
            Parser (Maybe Bool -> Maybe DateTime -> DriveOptions)
-> Parser (Maybe Bool) -> Parser (Maybe DateTime -> DriveOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"includeTeamDrives")
            Parser (Maybe DateTime -> DriveOptions)
-> Parser (Maybe DateTime) -> Parser DriveOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"versionDate")
      )

instance Core.ToJSON DriveOptions where
  toJSON :: DriveOptions -> Value
toJSON DriveOptions {Maybe Bool
Maybe DateTime
Maybe DriveOptions_ClientSideEncryptedOption
clientSideEncryptedOption :: DriveOptions -> Maybe DriveOptions_ClientSideEncryptedOption
includeSharedDrives :: DriveOptions -> Maybe Bool
includeTeamDrives :: DriveOptions -> Maybe Bool
versionDate :: DriveOptions -> Maybe DateTime
clientSideEncryptedOption :: Maybe DriveOptions_ClientSideEncryptedOption
includeSharedDrives :: Maybe Bool
includeTeamDrives :: Maybe Bool
versionDate :: Maybe DateTime
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"clientSideEncryptedOption" Core..=)
              (DriveOptions_ClientSideEncryptedOption -> Pair)
-> Maybe DriveOptions_ClientSideEncryptedOption -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DriveOptions_ClientSideEncryptedOption
clientSideEncryptedOption,
            (Key
"includeSharedDrives" Core..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Bool
includeSharedDrives,
            (Key
"includeTeamDrives" Core..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Bool
includeTeamDrives,
            (Key
"versionDate" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
versionDate
          ]
      )

-- | A generic empty message that you can re-use to avoid defining duplicated empty messages in your APIs. A typical example is to use it as the request or the response type of an API method. For instance: service Foo { rpc Bar(google.protobuf.Empty) returns (google.protobuf.Empty); }
--
-- /See:/ 'newEmpty' smart constructor.
data Empty = Empty
  deriving (Empty -> Empty -> Bool
(Empty -> Empty -> Bool) -> (Empty -> Empty -> Bool) -> Eq Empty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Empty -> Empty -> Bool
== :: Empty -> Empty -> Bool
$c/= :: Empty -> Empty -> Bool
/= :: Empty -> Empty -> Bool
Core.Eq, Int -> Empty -> ShowS
[Empty] -> ShowS
Empty -> String
(Int -> Empty -> ShowS)
-> (Empty -> String) -> ([Empty] -> ShowS) -> Show Empty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Empty -> ShowS
showsPrec :: Int -> Empty -> ShowS
$cshow :: Empty -> String
show :: Empty -> String
$cshowList :: [Empty] -> ShowS
showList :: [Empty] -> ShowS
Core.Show, (forall x. Empty -> Rep Empty x)
-> (forall x. Rep Empty x -> Empty) -> Generic Empty
forall x. Rep Empty x -> Empty
forall x. Empty -> Rep Empty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Empty -> Rep Empty x
from :: forall x. Empty -> Rep Empty x
$cto :: forall x. Rep Empty x -> Empty
to :: forall x. Rep Empty x -> Empty
Core.Generic)

-- | Creates a value of 'Empty' with the minimum fields required to make a request.
newEmpty ::
  Empty
newEmpty :: Empty
newEmpty = Empty
Empty

instance Core.FromJSON Empty where
  parseJSON :: Value -> Parser Empty
parseJSON = String -> (Object -> Parser Empty) -> Value -> Parser Empty
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject String
"Empty" (\Object
o -> Empty -> Parser Empty
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Core.pure Empty
Empty)

instance Core.ToJSON Empty where
  toJSON :: Empty -> Value
toJSON = Value -> Empty -> Value
forall a b. a -> b -> a
Core.const Value
Core.emptyObject

-- | An export. To work with Vault resources, the account must have the <https://support.google.com/vault/answer/2799699 required Vault privileges> and access to the matter. To access a matter, the account must have created the matter, have the matter shared with them, or have the __View All Matters__ privilege.
--
-- /See:/ 'newExport' smart constructor.
data Export = Export
  { -- | Output only. The sink for export files in Cloud Storage.
    Export -> Maybe CloudStorageSink
cloudStorageSink :: (Core.Maybe CloudStorageSink),
    -- | Output only. The time when the export was created.
    Export -> Maybe DateTime
createTime :: (Core.Maybe Core.DateTime),
    -- | Additional export options.
    Export -> Maybe ExportOptions
exportOptions :: (Core.Maybe ExportOptions),
    -- | Output only. The generated export ID.
    Export -> Maybe Text
id :: (Core.Maybe Core.Text),
    -- | Output only. The matter ID.
    Export -> Maybe Text
matterId :: (Core.Maybe Core.Text),
    -- | The export name. Don\'t use special characters (~!$\'(),;\@:\/?) in the name, they can prevent you from downloading exports.
    Export -> Maybe Text
name :: (Core.Maybe Core.Text),
    -- | Output only. Identifies the parent export that spawned this child export. This is only set on child exports.
    Export -> Maybe Text
parentExportId :: (Core.Maybe Core.Text),
    -- | The query parameters used to create the export.
    Export -> Maybe Query
query :: (Core.Maybe Query),
    -- | Output only. The requester of the export.
    Export -> Maybe UserInfo
requester :: (Core.Maybe UserInfo),
    -- | Output only. Details about the export progress and size.
    Export -> Maybe ExportStats
stats :: (Core.Maybe ExportStats),
    -- | Output only. The status of the export.
    Export -> Maybe Export_Status
status :: (Core.Maybe Export_Status)
  }
  deriving (Export -> Export -> Bool
(Export -> Export -> Bool)
-> (Export -> Export -> Bool) -> Eq Export
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Export -> Export -> Bool
== :: Export -> Export -> Bool
$c/= :: Export -> Export -> Bool
/= :: Export -> Export -> Bool
Core.Eq, Int -> Export -> ShowS
[Export] -> ShowS
Export -> String
(Int -> Export -> ShowS)
-> (Export -> String) -> ([Export] -> ShowS) -> Show Export
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Export -> ShowS
showsPrec :: Int -> Export -> ShowS
$cshow :: Export -> String
show :: Export -> String
$cshowList :: [Export] -> ShowS
showList :: [Export] -> ShowS
Core.Show, (forall x. Export -> Rep Export x)
-> (forall x. Rep Export x -> Export) -> Generic Export
forall x. Rep Export x -> Export
forall x. Export -> Rep Export x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Export -> Rep Export x
from :: forall x. Export -> Rep Export x
$cto :: forall x. Rep Export x -> Export
to :: forall x. Rep Export x -> Export
Core.Generic)

-- | Creates a value of 'Export' with the minimum fields required to make a request.
newExport ::
  Export
newExport :: Export
newExport =
  Export
    { cloudStorageSink :: Maybe CloudStorageSink
cloudStorageSink = Maybe CloudStorageSink
forall a. Maybe a
Core.Nothing,
      createTime :: Maybe DateTime
createTime = Maybe DateTime
forall a. Maybe a
Core.Nothing,
      exportOptions :: Maybe ExportOptions
exportOptions = Maybe ExportOptions
forall a. Maybe a
Core.Nothing,
      id :: Maybe Text
id = Maybe Text
forall a. Maybe a
Core.Nothing,
      matterId :: Maybe Text
matterId = Maybe Text
forall a. Maybe a
Core.Nothing,
      name :: Maybe Text
name = Maybe Text
forall a. Maybe a
Core.Nothing,
      parentExportId :: Maybe Text
parentExportId = Maybe Text
forall a. Maybe a
Core.Nothing,
      query :: Maybe Query
query = Maybe Query
forall a. Maybe a
Core.Nothing,
      requester :: Maybe UserInfo
requester = Maybe UserInfo
forall a. Maybe a
Core.Nothing,
      stats :: Maybe ExportStats
stats = Maybe ExportStats
forall a. Maybe a
Core.Nothing,
      status :: Maybe Export_Status
status = Maybe Export_Status
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON Export where
  parseJSON :: Value -> Parser Export
parseJSON =
    String -> (Object -> Parser Export) -> Value -> Parser Export
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"Export"
      ( \Object
o ->
          Maybe CloudStorageSink
-> Maybe DateTime
-> Maybe ExportOptions
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Query
-> Maybe UserInfo
-> Maybe ExportStats
-> Maybe Export_Status
-> Export
Export
            (Maybe CloudStorageSink
 -> Maybe DateTime
 -> Maybe ExportOptions
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Query
 -> Maybe UserInfo
 -> Maybe ExportStats
 -> Maybe Export_Status
 -> Export)
-> Parser (Maybe CloudStorageSink)
-> Parser
     (Maybe DateTime
      -> Maybe ExportOptions
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Query
      -> Maybe UserInfo
      -> Maybe ExportStats
      -> Maybe Export_Status
      -> Export)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe CloudStorageSink)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"cloudStorageSink")
            Parser
  (Maybe DateTime
   -> Maybe ExportOptions
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Query
   -> Maybe UserInfo
   -> Maybe ExportStats
   -> Maybe Export_Status
   -> Export)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe ExportOptions
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Query
      -> Maybe UserInfo
      -> Maybe ExportStats
      -> Maybe Export_Status
      -> Export)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"createTime")
            Parser
  (Maybe ExportOptions
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Query
   -> Maybe UserInfo
   -> Maybe ExportStats
   -> Maybe Export_Status
   -> Export)
-> Parser (Maybe ExportOptions)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Query
      -> Maybe UserInfo
      -> Maybe ExportStats
      -> Maybe Export_Status
      -> Export)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe ExportOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"exportOptions")
            Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Query
   -> Maybe UserInfo
   -> Maybe ExportStats
   -> Maybe Export_Status
   -> Export)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Query
      -> Maybe UserInfo
      -> Maybe ExportStats
      -> Maybe Export_Status
      -> Export)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"id")
            Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Query
   -> Maybe UserInfo
   -> Maybe ExportStats
   -> Maybe Export_Status
   -> Export)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Query
      -> Maybe UserInfo
      -> Maybe ExportStats
      -> Maybe Export_Status
      -> Export)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"matterId")
            Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Query
   -> Maybe UserInfo
   -> Maybe ExportStats
   -> Maybe Export_Status
   -> Export)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Query
      -> Maybe UserInfo
      -> Maybe ExportStats
      -> Maybe Export_Status
      -> Export)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"name")
            Parser
  (Maybe Text
   -> Maybe Query
   -> Maybe UserInfo
   -> Maybe ExportStats
   -> Maybe Export_Status
   -> Export)
-> Parser (Maybe Text)
-> Parser
     (Maybe Query
      -> Maybe UserInfo
      -> Maybe ExportStats
      -> Maybe Export_Status
      -> Export)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"parentExportId")
            Parser
  (Maybe Query
   -> Maybe UserInfo
   -> Maybe ExportStats
   -> Maybe Export_Status
   -> Export)
-> Parser (Maybe Query)
-> Parser
     (Maybe UserInfo
      -> Maybe ExportStats -> Maybe Export_Status -> Export)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Query)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"query")
            Parser
  (Maybe UserInfo
   -> Maybe ExportStats -> Maybe Export_Status -> Export)
-> Parser (Maybe UserInfo)
-> Parser (Maybe ExportStats -> Maybe Export_Status -> Export)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe UserInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"requester")
            Parser (Maybe ExportStats -> Maybe Export_Status -> Export)
-> Parser (Maybe ExportStats)
-> Parser (Maybe Export_Status -> Export)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe ExportStats)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"stats")
            Parser (Maybe Export_Status -> Export)
-> Parser (Maybe Export_Status) -> Parser Export
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Export_Status)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"status")
      )

instance Core.ToJSON Export where
  toJSON :: Export -> Value
toJSON Export {Maybe Text
Maybe DateTime
Maybe Export_Status
Maybe UserInfo
Maybe Query
Maybe ExportStats
Maybe ExportOptions
Maybe CloudStorageSink
cloudStorageSink :: Export -> Maybe CloudStorageSink
createTime :: Export -> Maybe DateTime
exportOptions :: Export -> Maybe ExportOptions
id :: Export -> Maybe Text
matterId :: Export -> Maybe Text
name :: Export -> Maybe Text
parentExportId :: Export -> Maybe Text
query :: Export -> Maybe Query
requester :: Export -> Maybe UserInfo
stats :: Export -> Maybe ExportStats
status :: Export -> Maybe Export_Status
cloudStorageSink :: Maybe CloudStorageSink
createTime :: Maybe DateTime
exportOptions :: Maybe ExportOptions
id :: Maybe Text
matterId :: Maybe Text
name :: Maybe Text
parentExportId :: Maybe Text
query :: Maybe Query
requester :: Maybe UserInfo
stats :: Maybe ExportStats
status :: Maybe Export_Status
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"cloudStorageSink" Core..=) (CloudStorageSink -> Pair) -> Maybe CloudStorageSink -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe CloudStorageSink
cloudStorageSink,
            (Key
"createTime" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
createTime,
            (Key
"exportOptions" Core..=) (ExportOptions -> Pair) -> Maybe ExportOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe ExportOptions
exportOptions,
            (Key
"id" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
id,
            (Key
"matterId" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
matterId,
            (Key
"name" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
name,
            (Key
"parentExportId" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
parentExportId,
            (Key
"query" Core..=) (Query -> Pair) -> Maybe Query -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Query
query,
            (Key
"requester" Core..=) (UserInfo -> Pair) -> Maybe UserInfo -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe UserInfo
requester,
            (Key
"stats" Core..=) (ExportStats -> Pair) -> Maybe ExportStats -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe ExportStats
stats,
            (Key
"status" Core..=) (Export_Status -> Pair) -> Maybe Export_Status -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Export_Status
status
          ]
      )

-- | Additional options for exports
--
-- /See:/ 'newExportOptions' smart constructor.
data ExportOptions = ExportOptions
  { -- | Option available for Calendar export.
    ExportOptions -> Maybe CalendarExportOptions
calendarOptions :: (Core.Maybe CalendarExportOptions),
    -- | Options for Drive exports.
    ExportOptions -> Maybe DriveExportOptions
driveOptions :: (Core.Maybe DriveExportOptions),
    -- | Option available for Gemini export.
    ExportOptions -> Maybe GeminiExportOptions
geminiOptions :: (Core.Maybe GeminiExportOptions),
    -- | Options for Groups exports.
    ExportOptions -> Maybe GroupsExportOptions
groupsOptions :: (Core.Maybe GroupsExportOptions),
    -- | Options for Chat exports.
    ExportOptions -> Maybe HangoutsChatExportOptions
hangoutsChatOptions :: (Core.Maybe HangoutsChatExportOptions),
    -- | Options for Gmail exports.
    ExportOptions -> Maybe MailExportOptions
mailOptions :: (Core.Maybe MailExportOptions),
    -- | The requested data region for the export.
    ExportOptions -> Maybe ExportOptions_Region
region :: (Core.Maybe ExportOptions_Region),
    -- | Options for Voice exports.
    ExportOptions -> Maybe VoiceExportOptions
voiceOptions :: (Core.Maybe VoiceExportOptions)
  }
  deriving (ExportOptions -> ExportOptions -> Bool
(ExportOptions -> ExportOptions -> Bool)
-> (ExportOptions -> ExportOptions -> Bool) -> Eq ExportOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExportOptions -> ExportOptions -> Bool
== :: ExportOptions -> ExportOptions -> Bool
$c/= :: ExportOptions -> ExportOptions -> Bool
/= :: ExportOptions -> ExportOptions -> Bool
Core.Eq, Int -> ExportOptions -> ShowS
[ExportOptions] -> ShowS
ExportOptions -> String
(Int -> ExportOptions -> ShowS)
-> (ExportOptions -> String)
-> ([ExportOptions] -> ShowS)
-> Show ExportOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExportOptions -> ShowS
showsPrec :: Int -> ExportOptions -> ShowS
$cshow :: ExportOptions -> String
show :: ExportOptions -> String
$cshowList :: [ExportOptions] -> ShowS
showList :: [ExportOptions] -> ShowS
Core.Show, (forall x. ExportOptions -> Rep ExportOptions x)
-> (forall x. Rep ExportOptions x -> ExportOptions)
-> Generic ExportOptions
forall x. Rep ExportOptions x -> ExportOptions
forall x. ExportOptions -> Rep ExportOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExportOptions -> Rep ExportOptions x
from :: forall x. ExportOptions -> Rep ExportOptions x
$cto :: forall x. Rep ExportOptions x -> ExportOptions
to :: forall x. Rep ExportOptions x -> ExportOptions
Core.Generic)

-- | Creates a value of 'ExportOptions' with the minimum fields required to make a request.
newExportOptions ::
  ExportOptions
newExportOptions :: ExportOptions
newExportOptions =
  ExportOptions
    { calendarOptions :: Maybe CalendarExportOptions
calendarOptions = Maybe CalendarExportOptions
forall a. Maybe a
Core.Nothing,
      driveOptions :: Maybe DriveExportOptions
driveOptions = Maybe DriveExportOptions
forall a. Maybe a
Core.Nothing,
      geminiOptions :: Maybe GeminiExportOptions
geminiOptions = Maybe GeminiExportOptions
forall a. Maybe a
Core.Nothing,
      groupsOptions :: Maybe GroupsExportOptions
groupsOptions = Maybe GroupsExportOptions
forall a. Maybe a
Core.Nothing,
      hangoutsChatOptions :: Maybe HangoutsChatExportOptions
hangoutsChatOptions = Maybe HangoutsChatExportOptions
forall a. Maybe a
Core.Nothing,
      mailOptions :: Maybe MailExportOptions
mailOptions = Maybe MailExportOptions
forall a. Maybe a
Core.Nothing,
      region :: Maybe ExportOptions_Region
region = Maybe ExportOptions_Region
forall a. Maybe a
Core.Nothing,
      voiceOptions :: Maybe VoiceExportOptions
voiceOptions = Maybe VoiceExportOptions
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON ExportOptions where
  parseJSON :: Value -> Parser ExportOptions
parseJSON =
    String
-> (Object -> Parser ExportOptions)
-> Value
-> Parser ExportOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"ExportOptions"
      ( \Object
o ->
          Maybe CalendarExportOptions
-> Maybe DriveExportOptions
-> Maybe GeminiExportOptions
-> Maybe GroupsExportOptions
-> Maybe HangoutsChatExportOptions
-> Maybe MailExportOptions
-> Maybe ExportOptions_Region
-> Maybe VoiceExportOptions
-> ExportOptions
ExportOptions
            (Maybe CalendarExportOptions
 -> Maybe DriveExportOptions
 -> Maybe GeminiExportOptions
 -> Maybe GroupsExportOptions
 -> Maybe HangoutsChatExportOptions
 -> Maybe MailExportOptions
 -> Maybe ExportOptions_Region
 -> Maybe VoiceExportOptions
 -> ExportOptions)
-> Parser (Maybe CalendarExportOptions)
-> Parser
     (Maybe DriveExportOptions
      -> Maybe GeminiExportOptions
      -> Maybe GroupsExportOptions
      -> Maybe HangoutsChatExportOptions
      -> Maybe MailExportOptions
      -> Maybe ExportOptions_Region
      -> Maybe VoiceExportOptions
      -> ExportOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe CalendarExportOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"calendarOptions")
            Parser
  (Maybe DriveExportOptions
   -> Maybe GeminiExportOptions
   -> Maybe GroupsExportOptions
   -> Maybe HangoutsChatExportOptions
   -> Maybe MailExportOptions
   -> Maybe ExportOptions_Region
   -> Maybe VoiceExportOptions
   -> ExportOptions)
-> Parser (Maybe DriveExportOptions)
-> Parser
     (Maybe GeminiExportOptions
      -> Maybe GroupsExportOptions
      -> Maybe HangoutsChatExportOptions
      -> Maybe MailExportOptions
      -> Maybe ExportOptions_Region
      -> Maybe VoiceExportOptions
      -> ExportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe DriveExportOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"driveOptions")
            Parser
  (Maybe GeminiExportOptions
   -> Maybe GroupsExportOptions
   -> Maybe HangoutsChatExportOptions
   -> Maybe MailExportOptions
   -> Maybe ExportOptions_Region
   -> Maybe VoiceExportOptions
   -> ExportOptions)
-> Parser (Maybe GeminiExportOptions)
-> Parser
     (Maybe GroupsExportOptions
      -> Maybe HangoutsChatExportOptions
      -> Maybe MailExportOptions
      -> Maybe ExportOptions_Region
      -> Maybe VoiceExportOptions
      -> ExportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe GeminiExportOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"geminiOptions")
            Parser
  (Maybe GroupsExportOptions
   -> Maybe HangoutsChatExportOptions
   -> Maybe MailExportOptions
   -> Maybe ExportOptions_Region
   -> Maybe VoiceExportOptions
   -> ExportOptions)
-> Parser (Maybe GroupsExportOptions)
-> Parser
     (Maybe HangoutsChatExportOptions
      -> Maybe MailExportOptions
      -> Maybe ExportOptions_Region
      -> Maybe VoiceExportOptions
      -> ExportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe GroupsExportOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"groupsOptions")
            Parser
  (Maybe HangoutsChatExportOptions
   -> Maybe MailExportOptions
   -> Maybe ExportOptions_Region
   -> Maybe VoiceExportOptions
   -> ExportOptions)
-> Parser (Maybe HangoutsChatExportOptions)
-> Parser
     (Maybe MailExportOptions
      -> Maybe ExportOptions_Region
      -> Maybe VoiceExportOptions
      -> ExportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe HangoutsChatExportOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"hangoutsChatOptions")
            Parser
  (Maybe MailExportOptions
   -> Maybe ExportOptions_Region
   -> Maybe VoiceExportOptions
   -> ExportOptions)
-> Parser (Maybe MailExportOptions)
-> Parser
     (Maybe ExportOptions_Region
      -> Maybe VoiceExportOptions -> ExportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe MailExportOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"mailOptions")
            Parser
  (Maybe ExportOptions_Region
   -> Maybe VoiceExportOptions -> ExportOptions)
-> Parser (Maybe ExportOptions_Region)
-> Parser (Maybe VoiceExportOptions -> ExportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe ExportOptions_Region)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"region")
            Parser (Maybe VoiceExportOptions -> ExportOptions)
-> Parser (Maybe VoiceExportOptions) -> Parser ExportOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe VoiceExportOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"voiceOptions")
      )

instance Core.ToJSON ExportOptions where
  toJSON :: ExportOptions -> Value
toJSON ExportOptions {Maybe ExportOptions_Region
Maybe VoiceExportOptions
Maybe MailExportOptions
Maybe HangoutsChatExportOptions
Maybe GroupsExportOptions
Maybe GeminiExportOptions
Maybe DriveExportOptions
Maybe CalendarExportOptions
calendarOptions :: ExportOptions -> Maybe CalendarExportOptions
driveOptions :: ExportOptions -> Maybe DriveExportOptions
geminiOptions :: ExportOptions -> Maybe GeminiExportOptions
groupsOptions :: ExportOptions -> Maybe GroupsExportOptions
hangoutsChatOptions :: ExportOptions -> Maybe HangoutsChatExportOptions
mailOptions :: ExportOptions -> Maybe MailExportOptions
region :: ExportOptions -> Maybe ExportOptions_Region
voiceOptions :: ExportOptions -> Maybe VoiceExportOptions
calendarOptions :: Maybe CalendarExportOptions
driveOptions :: Maybe DriveExportOptions
geminiOptions :: Maybe GeminiExportOptions
groupsOptions :: Maybe GroupsExportOptions
hangoutsChatOptions :: Maybe HangoutsChatExportOptions
mailOptions :: Maybe MailExportOptions
region :: Maybe ExportOptions_Region
voiceOptions :: Maybe VoiceExportOptions
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"calendarOptions" Core..=) (CalendarExportOptions -> Pair)
-> Maybe CalendarExportOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe CalendarExportOptions
calendarOptions,
            (Key
"driveOptions" Core..=) (DriveExportOptions -> Pair)
-> Maybe DriveExportOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DriveExportOptions
driveOptions,
            (Key
"geminiOptions" Core..=) (GeminiExportOptions -> Pair)
-> Maybe GeminiExportOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe GeminiExportOptions
geminiOptions,
            (Key
"groupsOptions" Core..=) (GroupsExportOptions -> Pair)
-> Maybe GroupsExportOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe GroupsExportOptions
groupsOptions,
            (Key
"hangoutsChatOptions" Core..=) (HangoutsChatExportOptions -> Pair)
-> Maybe HangoutsChatExportOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe HangoutsChatExportOptions
hangoutsChatOptions,
            (Key
"mailOptions" Core..=) (MailExportOptions -> Pair)
-> Maybe MailExportOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe MailExportOptions
mailOptions,
            (Key
"region" Core..=) (ExportOptions_Region -> Pair)
-> Maybe ExportOptions_Region -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe ExportOptions_Region
region,
            (Key
"voiceOptions" Core..=) (VoiceExportOptions -> Pair)
-> Maybe VoiceExportOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe VoiceExportOptions
voiceOptions
          ]
      )

-- | Progress information for an export.
--
-- /See:/ 'newExportStats' smart constructor.
data ExportStats = ExportStats
  { -- | The number of messages or files already processed for export.
    ExportStats -> Maybe Int64
exportedArtifactCount :: (Core.Maybe Core.Int64),
    -- | The size of export in bytes.
    ExportStats -> Maybe Int64
sizeInBytes :: (Core.Maybe Core.Int64),
    -- | The number of messages or files to be exported.
    ExportStats -> Maybe Int64
totalArtifactCount :: (Core.Maybe Core.Int64)
  }
  deriving (ExportStats -> ExportStats -> Bool
(ExportStats -> ExportStats -> Bool)
-> (ExportStats -> ExportStats -> Bool) -> Eq ExportStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExportStats -> ExportStats -> Bool
== :: ExportStats -> ExportStats -> Bool
$c/= :: ExportStats -> ExportStats -> Bool
/= :: ExportStats -> ExportStats -> Bool
Core.Eq, Int -> ExportStats -> ShowS
[ExportStats] -> ShowS
ExportStats -> String
(Int -> ExportStats -> ShowS)
-> (ExportStats -> String)
-> ([ExportStats] -> ShowS)
-> Show ExportStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExportStats -> ShowS
showsPrec :: Int -> ExportStats -> ShowS
$cshow :: ExportStats -> String
show :: ExportStats -> String
$cshowList :: [ExportStats] -> ShowS
showList :: [ExportStats] -> ShowS
Core.Show, (forall x. ExportStats -> Rep ExportStats x)
-> (forall x. Rep ExportStats x -> ExportStats)
-> Generic ExportStats
forall x. Rep ExportStats x -> ExportStats
forall x. ExportStats -> Rep ExportStats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExportStats -> Rep ExportStats x
from :: forall x. ExportStats -> Rep ExportStats x
$cto :: forall x. Rep ExportStats x -> ExportStats
to :: forall x. Rep ExportStats x -> ExportStats
Core.Generic)

-- | Creates a value of 'ExportStats' with the minimum fields required to make a request.
newExportStats ::
  ExportStats
newExportStats :: ExportStats
newExportStats =
  ExportStats
    { exportedArtifactCount :: Maybe Int64
exportedArtifactCount = Maybe Int64
forall a. Maybe a
Core.Nothing,
      sizeInBytes :: Maybe Int64
sizeInBytes = Maybe Int64
forall a. Maybe a
Core.Nothing,
      totalArtifactCount :: Maybe Int64
totalArtifactCount = Maybe Int64
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON ExportStats where
  parseJSON :: Value -> Parser ExportStats
parseJSON =
    String
-> (Object -> Parser ExportStats) -> Value -> Parser ExportStats
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"ExportStats"
      ( \Object
o ->
          Maybe Int64 -> Maybe Int64 -> Maybe Int64 -> ExportStats
ExportStats
            (Maybe Int64 -> Maybe Int64 -> Maybe Int64 -> ExportStats)
-> Parser (Maybe Int64)
-> Parser (Maybe Int64 -> Maybe Int64 -> ExportStats)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> ( Object
o
                         Object -> Key -> Parser (Maybe (AsText Int64))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"exportedArtifactCount"
                         Parser (Maybe (AsText Int64))
-> (Maybe (AsText Int64) -> Maybe Int64) -> Parser (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Core.<&> (AsText Int64 -> Int64) -> Maybe (AsText Int64) -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.fmap AsText Int64 -> Int64
forall a. AsText a -> a
Core.fromAsText
                     )
            Parser (Maybe Int64 -> Maybe Int64 -> ExportStats)
-> Parser (Maybe Int64) -> Parser (Maybe Int64 -> ExportStats)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe (AsText Int64))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"sizeInBytes" Parser (Maybe (AsText Int64))
-> (Maybe (AsText Int64) -> Maybe Int64) -> Parser (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Core.<&> (AsText Int64 -> Int64) -> Maybe (AsText Int64) -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.fmap AsText Int64 -> Int64
forall a. AsText a -> a
Core.fromAsText)
            Parser (Maybe Int64 -> ExportStats)
-> Parser (Maybe Int64) -> Parser ExportStats
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> ( Object
o
                         Object -> Key -> Parser (Maybe (AsText Int64))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"totalArtifactCount"
                         Parser (Maybe (AsText Int64))
-> (Maybe (AsText Int64) -> Maybe Int64) -> Parser (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Core.<&> (AsText Int64 -> Int64) -> Maybe (AsText Int64) -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.fmap AsText Int64 -> Int64
forall a. AsText a -> a
Core.fromAsText
                     )
      )

instance Core.ToJSON ExportStats where
  toJSON :: ExportStats -> Value
toJSON ExportStats {Maybe Int64
exportedArtifactCount :: ExportStats -> Maybe Int64
sizeInBytes :: ExportStats -> Maybe Int64
totalArtifactCount :: ExportStats -> Maybe Int64
exportedArtifactCount :: Maybe Int64
sizeInBytes :: Maybe Int64
totalArtifactCount :: Maybe Int64
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"exportedArtifactCount" Core..=)
              (AsText Int64 -> Pair) -> (Int64 -> AsText Int64) -> Int64 -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
Core.. Int64 -> AsText Int64
forall a. a -> AsText a
Core.AsText
              (Int64 -> Pair) -> Maybe Int64 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int64
exportedArtifactCount,
            (Key
"sizeInBytes" Core..=) (AsText Int64 -> Pair) -> (Int64 -> AsText Int64) -> Int64 -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
Core.. Int64 -> AsText Int64
forall a. a -> AsText a
Core.AsText (Int64 -> Pair) -> Maybe Int64 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int64
sizeInBytes,
            (Key
"totalArtifactCount" Core..=)
              (AsText Int64 -> Pair) -> (Int64 -> AsText Int64) -> Int64 -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
Core.. Int64 -> AsText Int64
forall a. a -> AsText a
Core.AsText
              (Int64 -> Pair) -> Maybe Int64 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int64
totalArtifactCount
          ]
      )

-- | The options for Gemini exports.
--
-- /See:/ 'newGeminiExportOptions' smart constructor.
newtype GeminiExportOptions = GeminiExportOptions
  { -- | The file format for exported messages.
    GeminiExportOptions -> Maybe GeminiExportOptions_ExportFormat
exportFormat :: (Core.Maybe GeminiExportOptions_ExportFormat)
  }
  deriving (GeminiExportOptions -> GeminiExportOptions -> Bool
(GeminiExportOptions -> GeminiExportOptions -> Bool)
-> (GeminiExportOptions -> GeminiExportOptions -> Bool)
-> Eq GeminiExportOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeminiExportOptions -> GeminiExportOptions -> Bool
== :: GeminiExportOptions -> GeminiExportOptions -> Bool
$c/= :: GeminiExportOptions -> GeminiExportOptions -> Bool
/= :: GeminiExportOptions -> GeminiExportOptions -> Bool
Core.Eq, Int -> GeminiExportOptions -> ShowS
[GeminiExportOptions] -> ShowS
GeminiExportOptions -> String
(Int -> GeminiExportOptions -> ShowS)
-> (GeminiExportOptions -> String)
-> ([GeminiExportOptions] -> ShowS)
-> Show GeminiExportOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeminiExportOptions -> ShowS
showsPrec :: Int -> GeminiExportOptions -> ShowS
$cshow :: GeminiExportOptions -> String
show :: GeminiExportOptions -> String
$cshowList :: [GeminiExportOptions] -> ShowS
showList :: [GeminiExportOptions] -> ShowS
Core.Show, (forall x. GeminiExportOptions -> Rep GeminiExportOptions x)
-> (forall x. Rep GeminiExportOptions x -> GeminiExportOptions)
-> Generic GeminiExportOptions
forall x. Rep GeminiExportOptions x -> GeminiExportOptions
forall x. GeminiExportOptions -> Rep GeminiExportOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GeminiExportOptions -> Rep GeminiExportOptions x
from :: forall x. GeminiExportOptions -> Rep GeminiExportOptions x
$cto :: forall x. Rep GeminiExportOptions x -> GeminiExportOptions
to :: forall x. Rep GeminiExportOptions x -> GeminiExportOptions
Core.Generic)

-- | Creates a value of 'GeminiExportOptions' with the minimum fields required to make a request.
newGeminiExportOptions ::
  GeminiExportOptions
newGeminiExportOptions :: GeminiExportOptions
newGeminiExportOptions =
  GeminiExportOptions {exportFormat :: Maybe GeminiExportOptions_ExportFormat
exportFormat = Maybe GeminiExportOptions_ExportFormat
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON GeminiExportOptions where
  parseJSON :: Value -> Parser GeminiExportOptions
parseJSON =
    String
-> (Object -> Parser GeminiExportOptions)
-> Value
-> Parser GeminiExportOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"GeminiExportOptions"
      (\Object
o -> Maybe GeminiExportOptions_ExportFormat -> GeminiExportOptions
GeminiExportOptions (Maybe GeminiExportOptions_ExportFormat -> GeminiExportOptions)
-> Parser (Maybe GeminiExportOptions_ExportFormat)
-> Parser GeminiExportOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe GeminiExportOptions_ExportFormat)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"exportFormat"))

instance Core.ToJSON GeminiExportOptions where
  toJSON :: GeminiExportOptions -> Value
toJSON GeminiExportOptions {Maybe GeminiExportOptions_ExportFormat
exportFormat :: GeminiExportOptions -> Maybe GeminiExportOptions_ExportFormat
exportFormat :: Maybe GeminiExportOptions_ExportFormat
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"exportFormat" Core..=) (GeminiExportOptions_ExportFormat -> Pair)
-> Maybe GeminiExportOptions_ExportFormat -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe GeminiExportOptions_ExportFormat
exportFormat])

-- | Additional options for Gemini search
--
-- /See:/ 'newGeminiOptions' smart constructor.
data GeminiOptions = GeminiOptions
  deriving (GeminiOptions -> GeminiOptions -> Bool
(GeminiOptions -> GeminiOptions -> Bool)
-> (GeminiOptions -> GeminiOptions -> Bool) -> Eq GeminiOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeminiOptions -> GeminiOptions -> Bool
== :: GeminiOptions -> GeminiOptions -> Bool
$c/= :: GeminiOptions -> GeminiOptions -> Bool
/= :: GeminiOptions -> GeminiOptions -> Bool
Core.Eq, Int -> GeminiOptions -> ShowS
[GeminiOptions] -> ShowS
GeminiOptions -> String
(Int -> GeminiOptions -> ShowS)
-> (GeminiOptions -> String)
-> ([GeminiOptions] -> ShowS)
-> Show GeminiOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeminiOptions -> ShowS
showsPrec :: Int -> GeminiOptions -> ShowS
$cshow :: GeminiOptions -> String
show :: GeminiOptions -> String
$cshowList :: [GeminiOptions] -> ShowS
showList :: [GeminiOptions] -> ShowS
Core.Show, (forall x. GeminiOptions -> Rep GeminiOptions x)
-> (forall x. Rep GeminiOptions x -> GeminiOptions)
-> Generic GeminiOptions
forall x. Rep GeminiOptions x -> GeminiOptions
forall x. GeminiOptions -> Rep GeminiOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GeminiOptions -> Rep GeminiOptions x
from :: forall x. GeminiOptions -> Rep GeminiOptions x
$cto :: forall x. Rep GeminiOptions x -> GeminiOptions
to :: forall x. Rep GeminiOptions x -> GeminiOptions
Core.Generic)

-- | Creates a value of 'GeminiOptions' with the minimum fields required to make a request.
newGeminiOptions ::
  GeminiOptions
newGeminiOptions :: GeminiOptions
newGeminiOptions = GeminiOptions
GeminiOptions

instance Core.FromJSON GeminiOptions where
  parseJSON :: Value -> Parser GeminiOptions
parseJSON =
    String
-> (Object -> Parser GeminiOptions)
-> Value
-> Parser GeminiOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject String
"GeminiOptions" (\Object
o -> GeminiOptions -> Parser GeminiOptions
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Core.pure GeminiOptions
GeminiOptions)

instance Core.ToJSON GeminiOptions where
  toJSON :: GeminiOptions -> Value
toJSON = Value -> GeminiOptions -> Value
forall a b. a -> b -> a
Core.const Value
Core.emptyObject

-- | Groups specific count metrics.
--
-- /See:/ 'newGroupsCountResult' smart constructor.
data GroupsCountResult = GroupsCountResult
  { -- | Error occurred when querying these accounts.
    GroupsCountResult -> Maybe [AccountCountError]
accountCountErrors :: (Core.Maybe [AccountCountError]),
    -- | Subtotal count per matching account that have more than zero messages.
    GroupsCountResult -> Maybe [AccountCount]
accountCounts :: (Core.Maybe [AccountCount]),
    -- | Total number of accounts that can be queried and have more than zero messages.
    GroupsCountResult -> Maybe Int64
matchingAccountsCount :: (Core.Maybe Core.Int64),
    -- | When __DataScope__ is **HELD_DATA**, these accounts in the request are not queried because they are not on hold. For other data scope, this field is not set.
    GroupsCountResult -> Maybe [Text]
nonQueryableAccounts :: (Core.Maybe [Core.Text]),
    -- | Total number of accounts involved in this count operation.
    GroupsCountResult -> Maybe Int64
queriedAccountsCount :: (Core.Maybe Core.Int64)
  }
  deriving (GroupsCountResult -> GroupsCountResult -> Bool
(GroupsCountResult -> GroupsCountResult -> Bool)
-> (GroupsCountResult -> GroupsCountResult -> Bool)
-> Eq GroupsCountResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GroupsCountResult -> GroupsCountResult -> Bool
== :: GroupsCountResult -> GroupsCountResult -> Bool
$c/= :: GroupsCountResult -> GroupsCountResult -> Bool
/= :: GroupsCountResult -> GroupsCountResult -> Bool
Core.Eq, Int -> GroupsCountResult -> ShowS
[GroupsCountResult] -> ShowS
GroupsCountResult -> String
(Int -> GroupsCountResult -> ShowS)
-> (GroupsCountResult -> String)
-> ([GroupsCountResult] -> ShowS)
-> Show GroupsCountResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupsCountResult -> ShowS
showsPrec :: Int -> GroupsCountResult -> ShowS
$cshow :: GroupsCountResult -> String
show :: GroupsCountResult -> String
$cshowList :: [GroupsCountResult] -> ShowS
showList :: [GroupsCountResult] -> ShowS
Core.Show, (forall x. GroupsCountResult -> Rep GroupsCountResult x)
-> (forall x. Rep GroupsCountResult x -> GroupsCountResult)
-> Generic GroupsCountResult
forall x. Rep GroupsCountResult x -> GroupsCountResult
forall x. GroupsCountResult -> Rep GroupsCountResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GroupsCountResult -> Rep GroupsCountResult x
from :: forall x. GroupsCountResult -> Rep GroupsCountResult x
$cto :: forall x. Rep GroupsCountResult x -> GroupsCountResult
to :: forall x. Rep GroupsCountResult x -> GroupsCountResult
Core.Generic)

-- | Creates a value of 'GroupsCountResult' with the minimum fields required to make a request.
newGroupsCountResult ::
  GroupsCountResult
newGroupsCountResult :: GroupsCountResult
newGroupsCountResult =
  GroupsCountResult
    { accountCountErrors :: Maybe [AccountCountError]
accountCountErrors = Maybe [AccountCountError]
forall a. Maybe a
Core.Nothing,
      accountCounts :: Maybe [AccountCount]
accountCounts = Maybe [AccountCount]
forall a. Maybe a
Core.Nothing,
      matchingAccountsCount :: Maybe Int64
matchingAccountsCount = Maybe Int64
forall a. Maybe a
Core.Nothing,
      nonQueryableAccounts :: Maybe [Text]
nonQueryableAccounts = Maybe [Text]
forall a. Maybe a
Core.Nothing,
      queriedAccountsCount :: Maybe Int64
queriedAccountsCount = Maybe Int64
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON GroupsCountResult where
  parseJSON :: Value -> Parser GroupsCountResult
parseJSON =
    String
-> (Object -> Parser GroupsCountResult)
-> Value
-> Parser GroupsCountResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"GroupsCountResult"
      ( \Object
o ->
          Maybe [AccountCountError]
-> Maybe [AccountCount]
-> Maybe Int64
-> Maybe [Text]
-> Maybe Int64
-> GroupsCountResult
GroupsCountResult
            (Maybe [AccountCountError]
 -> Maybe [AccountCount]
 -> Maybe Int64
 -> Maybe [Text]
 -> Maybe Int64
 -> GroupsCountResult)
-> Parser (Maybe [AccountCountError])
-> Parser
     (Maybe [AccountCount]
      -> Maybe Int64 -> Maybe [Text] -> Maybe Int64 -> GroupsCountResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [AccountCountError])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"accountCountErrors")
            Parser
  (Maybe [AccountCount]
   -> Maybe Int64 -> Maybe [Text] -> Maybe Int64 -> GroupsCountResult)
-> Parser (Maybe [AccountCount])
-> Parser
     (Maybe Int64 -> Maybe [Text] -> Maybe Int64 -> GroupsCountResult)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe [AccountCount])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"accountCounts")
            Parser
  (Maybe Int64 -> Maybe [Text] -> Maybe Int64 -> GroupsCountResult)
-> Parser (Maybe Int64)
-> Parser (Maybe [Text] -> Maybe Int64 -> GroupsCountResult)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> ( Object
o
                         Object -> Key -> Parser (Maybe (AsText Int64))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"matchingAccountsCount"
                         Parser (Maybe (AsText Int64))
-> (Maybe (AsText Int64) -> Maybe Int64) -> Parser (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Core.<&> (AsText Int64 -> Int64) -> Maybe (AsText Int64) -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.fmap AsText Int64 -> Int64
forall a. AsText a -> a
Core.fromAsText
                     )
            Parser (Maybe [Text] -> Maybe Int64 -> GroupsCountResult)
-> Parser (Maybe [Text])
-> Parser (Maybe Int64 -> GroupsCountResult)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"nonQueryableAccounts")
            Parser (Maybe Int64 -> GroupsCountResult)
-> Parser (Maybe Int64) -> Parser GroupsCountResult
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> ( Object
o
                         Object -> Key -> Parser (Maybe (AsText Int64))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"queriedAccountsCount"
                         Parser (Maybe (AsText Int64))
-> (Maybe (AsText Int64) -> Maybe Int64) -> Parser (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Core.<&> (AsText Int64 -> Int64) -> Maybe (AsText Int64) -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.fmap AsText Int64 -> Int64
forall a. AsText a -> a
Core.fromAsText
                     )
      )

instance Core.ToJSON GroupsCountResult where
  toJSON :: GroupsCountResult -> Value
toJSON GroupsCountResult {Maybe Int64
Maybe [Text]
Maybe [AccountCountError]
Maybe [AccountCount]
accountCountErrors :: GroupsCountResult -> Maybe [AccountCountError]
accountCounts :: GroupsCountResult -> Maybe [AccountCount]
matchingAccountsCount :: GroupsCountResult -> Maybe Int64
nonQueryableAccounts :: GroupsCountResult -> Maybe [Text]
queriedAccountsCount :: GroupsCountResult -> Maybe Int64
accountCountErrors :: Maybe [AccountCountError]
accountCounts :: Maybe [AccountCount]
matchingAccountsCount :: Maybe Int64
nonQueryableAccounts :: Maybe [Text]
queriedAccountsCount :: Maybe Int64
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"accountCountErrors" Core..=) ([AccountCountError] -> Pair)
-> Maybe [AccountCountError] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [AccountCountError]
accountCountErrors,
            (Key
"accountCounts" Core..=) ([AccountCount] -> Pair) -> Maybe [AccountCount] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [AccountCount]
accountCounts,
            (Key
"matchingAccountsCount" Core..=)
              (AsText Int64 -> Pair) -> (Int64 -> AsText Int64) -> Int64 -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
Core.. Int64 -> AsText Int64
forall a. a -> AsText a
Core.AsText
              (Int64 -> Pair) -> Maybe Int64 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int64
matchingAccountsCount,
            (Key
"nonQueryableAccounts" Core..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Text]
nonQueryableAccounts,
            (Key
"queriedAccountsCount" Core..=)
              (AsText Int64 -> Pair) -> (Int64 -> AsText Int64) -> Int64 -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
Core.. Int64 -> AsText Int64
forall a. a -> AsText a
Core.AsText
              (Int64 -> Pair) -> Maybe Int64 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int64
queriedAccountsCount
          ]
      )

-- | Options for Groups exports.
--
-- /See:/ 'newGroupsExportOptions' smart constructor.
newtype GroupsExportOptions = GroupsExportOptions
  { -- | The file format for exported messages.
    GroupsExportOptions -> Maybe GroupsExportOptions_ExportFormat
exportFormat :: (Core.Maybe GroupsExportOptions_ExportFormat)
  }
  deriving (GroupsExportOptions -> GroupsExportOptions -> Bool
(GroupsExportOptions -> GroupsExportOptions -> Bool)
-> (GroupsExportOptions -> GroupsExportOptions -> Bool)
-> Eq GroupsExportOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GroupsExportOptions -> GroupsExportOptions -> Bool
== :: GroupsExportOptions -> GroupsExportOptions -> Bool
$c/= :: GroupsExportOptions -> GroupsExportOptions -> Bool
/= :: GroupsExportOptions -> GroupsExportOptions -> Bool
Core.Eq, Int -> GroupsExportOptions -> ShowS
[GroupsExportOptions] -> ShowS
GroupsExportOptions -> String
(Int -> GroupsExportOptions -> ShowS)
-> (GroupsExportOptions -> String)
-> ([GroupsExportOptions] -> ShowS)
-> Show GroupsExportOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupsExportOptions -> ShowS
showsPrec :: Int -> GroupsExportOptions -> ShowS
$cshow :: GroupsExportOptions -> String
show :: GroupsExportOptions -> String
$cshowList :: [GroupsExportOptions] -> ShowS
showList :: [GroupsExportOptions] -> ShowS
Core.Show, (forall x. GroupsExportOptions -> Rep GroupsExportOptions x)
-> (forall x. Rep GroupsExportOptions x -> GroupsExportOptions)
-> Generic GroupsExportOptions
forall x. Rep GroupsExportOptions x -> GroupsExportOptions
forall x. GroupsExportOptions -> Rep GroupsExportOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GroupsExportOptions -> Rep GroupsExportOptions x
from :: forall x. GroupsExportOptions -> Rep GroupsExportOptions x
$cto :: forall x. Rep GroupsExportOptions x -> GroupsExportOptions
to :: forall x. Rep GroupsExportOptions x -> GroupsExportOptions
Core.Generic)

-- | Creates a value of 'GroupsExportOptions' with the minimum fields required to make a request.
newGroupsExportOptions ::
  GroupsExportOptions
newGroupsExportOptions :: GroupsExportOptions
newGroupsExportOptions =
  GroupsExportOptions {exportFormat :: Maybe GroupsExportOptions_ExportFormat
exportFormat = Maybe GroupsExportOptions_ExportFormat
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON GroupsExportOptions where
  parseJSON :: Value -> Parser GroupsExportOptions
parseJSON =
    String
-> (Object -> Parser GroupsExportOptions)
-> Value
-> Parser GroupsExportOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"GroupsExportOptions"
      (\Object
o -> Maybe GroupsExportOptions_ExportFormat -> GroupsExportOptions
GroupsExportOptions (Maybe GroupsExportOptions_ExportFormat -> GroupsExportOptions)
-> Parser (Maybe GroupsExportOptions_ExportFormat)
-> Parser GroupsExportOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe GroupsExportOptions_ExportFormat)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"exportFormat"))

instance Core.ToJSON GroupsExportOptions where
  toJSON :: GroupsExportOptions -> Value
toJSON GroupsExportOptions {Maybe GroupsExportOptions_ExportFormat
exportFormat :: GroupsExportOptions -> Maybe GroupsExportOptions_ExportFormat
exportFormat :: Maybe GroupsExportOptions_ExportFormat
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"exportFormat" Core..=) (GroupsExportOptions_ExportFormat -> Pair)
-> Maybe GroupsExportOptions_ExportFormat -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe GroupsExportOptions_ExportFormat
exportFormat])

-- | Options for Chat exports.
--
-- /See:/ 'newHangoutsChatExportOptions' smart constructor.
newtype HangoutsChatExportOptions = HangoutsChatExportOptions
  { -- | The file format for exported messages.
    HangoutsChatExportOptions
-> Maybe HangoutsChatExportOptions_ExportFormat
exportFormat :: (Core.Maybe HangoutsChatExportOptions_ExportFormat)
  }
  deriving (HangoutsChatExportOptions -> HangoutsChatExportOptions -> Bool
(HangoutsChatExportOptions -> HangoutsChatExportOptions -> Bool)
-> (HangoutsChatExportOptions -> HangoutsChatExportOptions -> Bool)
-> Eq HangoutsChatExportOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HangoutsChatExportOptions -> HangoutsChatExportOptions -> Bool
== :: HangoutsChatExportOptions -> HangoutsChatExportOptions -> Bool
$c/= :: HangoutsChatExportOptions -> HangoutsChatExportOptions -> Bool
/= :: HangoutsChatExportOptions -> HangoutsChatExportOptions -> Bool
Core.Eq, Int -> HangoutsChatExportOptions -> ShowS
[HangoutsChatExportOptions] -> ShowS
HangoutsChatExportOptions -> String
(Int -> HangoutsChatExportOptions -> ShowS)
-> (HangoutsChatExportOptions -> String)
-> ([HangoutsChatExportOptions] -> ShowS)
-> Show HangoutsChatExportOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HangoutsChatExportOptions -> ShowS
showsPrec :: Int -> HangoutsChatExportOptions -> ShowS
$cshow :: HangoutsChatExportOptions -> String
show :: HangoutsChatExportOptions -> String
$cshowList :: [HangoutsChatExportOptions] -> ShowS
showList :: [HangoutsChatExportOptions] -> ShowS
Core.Show, (forall x.
 HangoutsChatExportOptions -> Rep HangoutsChatExportOptions x)
-> (forall x.
    Rep HangoutsChatExportOptions x -> HangoutsChatExportOptions)
-> Generic HangoutsChatExportOptions
forall x.
Rep HangoutsChatExportOptions x -> HangoutsChatExportOptions
forall x.
HangoutsChatExportOptions -> Rep HangoutsChatExportOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
HangoutsChatExportOptions -> Rep HangoutsChatExportOptions x
from :: forall x.
HangoutsChatExportOptions -> Rep HangoutsChatExportOptions x
$cto :: forall x.
Rep HangoutsChatExportOptions x -> HangoutsChatExportOptions
to :: forall x.
Rep HangoutsChatExportOptions x -> HangoutsChatExportOptions
Core.Generic)

-- | Creates a value of 'HangoutsChatExportOptions' with the minimum fields required to make a request.
newHangoutsChatExportOptions ::
  HangoutsChatExportOptions
newHangoutsChatExportOptions :: HangoutsChatExportOptions
newHangoutsChatExportOptions =
  HangoutsChatExportOptions {exportFormat :: Maybe HangoutsChatExportOptions_ExportFormat
exportFormat = Maybe HangoutsChatExportOptions_ExportFormat
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON HangoutsChatExportOptions where
  parseJSON :: Value -> Parser HangoutsChatExportOptions
parseJSON =
    String
-> (Object -> Parser HangoutsChatExportOptions)
-> Value
-> Parser HangoutsChatExportOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"HangoutsChatExportOptions"
      ( \Object
o ->
          Maybe HangoutsChatExportOptions_ExportFormat
-> HangoutsChatExportOptions
HangoutsChatExportOptions (Maybe HangoutsChatExportOptions_ExportFormat
 -> HangoutsChatExportOptions)
-> Parser (Maybe HangoutsChatExportOptions_ExportFormat)
-> Parser HangoutsChatExportOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object
-> Key -> Parser (Maybe HangoutsChatExportOptions_ExportFormat)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"exportFormat")
      )

instance Core.ToJSON HangoutsChatExportOptions where
  toJSON :: HangoutsChatExportOptions -> Value
toJSON HangoutsChatExportOptions {Maybe HangoutsChatExportOptions_ExportFormat
exportFormat :: HangoutsChatExportOptions
-> Maybe HangoutsChatExportOptions_ExportFormat
exportFormat :: Maybe HangoutsChatExportOptions_ExportFormat
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"exportFormat" Core..=) (HangoutsChatExportOptions_ExportFormat -> Pair)
-> Maybe HangoutsChatExportOptions_ExportFormat -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe HangoutsChatExportOptions_ExportFormat
exportFormat])

-- | The Chat spaces to search
--
-- /See:/ 'newHangoutsChatInfo' smart constructor.
newtype HangoutsChatInfo = HangoutsChatInfo
  { -- | A list of Chat spaces IDs, as provided by the <https://developers.google.com/chat Chat API>. There is a limit of exporting from 500 Chat spaces per request.
    HangoutsChatInfo -> Maybe [Text]
roomId :: (Core.Maybe [Core.Text])
  }
  deriving (HangoutsChatInfo -> HangoutsChatInfo -> Bool
(HangoutsChatInfo -> HangoutsChatInfo -> Bool)
-> (HangoutsChatInfo -> HangoutsChatInfo -> Bool)
-> Eq HangoutsChatInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HangoutsChatInfo -> HangoutsChatInfo -> Bool
== :: HangoutsChatInfo -> HangoutsChatInfo -> Bool
$c/= :: HangoutsChatInfo -> HangoutsChatInfo -> Bool
/= :: HangoutsChatInfo -> HangoutsChatInfo -> Bool
Core.Eq, Int -> HangoutsChatInfo -> ShowS
[HangoutsChatInfo] -> ShowS
HangoutsChatInfo -> String
(Int -> HangoutsChatInfo -> ShowS)
-> (HangoutsChatInfo -> String)
-> ([HangoutsChatInfo] -> ShowS)
-> Show HangoutsChatInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HangoutsChatInfo -> ShowS
showsPrec :: Int -> HangoutsChatInfo -> ShowS
$cshow :: HangoutsChatInfo -> String
show :: HangoutsChatInfo -> String
$cshowList :: [HangoutsChatInfo] -> ShowS
showList :: [HangoutsChatInfo] -> ShowS
Core.Show, (forall x. HangoutsChatInfo -> Rep HangoutsChatInfo x)
-> (forall x. Rep HangoutsChatInfo x -> HangoutsChatInfo)
-> Generic HangoutsChatInfo
forall x. Rep HangoutsChatInfo x -> HangoutsChatInfo
forall x. HangoutsChatInfo -> Rep HangoutsChatInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HangoutsChatInfo -> Rep HangoutsChatInfo x
from :: forall x. HangoutsChatInfo -> Rep HangoutsChatInfo x
$cto :: forall x. Rep HangoutsChatInfo x -> HangoutsChatInfo
to :: forall x. Rep HangoutsChatInfo x -> HangoutsChatInfo
Core.Generic)

-- | Creates a value of 'HangoutsChatInfo' with the minimum fields required to make a request.
newHangoutsChatInfo ::
  HangoutsChatInfo
newHangoutsChatInfo :: HangoutsChatInfo
newHangoutsChatInfo = HangoutsChatInfo {roomId :: Maybe [Text]
roomId = Maybe [Text]
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON HangoutsChatInfo where
  parseJSON :: Value -> Parser HangoutsChatInfo
parseJSON =
    String
-> (Object -> Parser HangoutsChatInfo)
-> Value
-> Parser HangoutsChatInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"HangoutsChatInfo"
      (\Object
o -> Maybe [Text] -> HangoutsChatInfo
HangoutsChatInfo (Maybe [Text] -> HangoutsChatInfo)
-> Parser (Maybe [Text]) -> Parser HangoutsChatInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"roomId"))

instance Core.ToJSON HangoutsChatInfo where
  toJSON :: HangoutsChatInfo -> Value
toJSON HangoutsChatInfo {Maybe [Text]
roomId :: HangoutsChatInfo -> Maybe [Text]
roomId :: Maybe [Text]
..} =
    [Pair] -> Value
Core.object ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"roomId" Core..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Text]
roomId])

-- | Additional options for Google Chat search
--
-- /See:/ 'newHangoutsChatOptions' smart constructor.
newtype HangoutsChatOptions = HangoutsChatOptions
  { -- | For searches by account or organizational unit, set to __true__ to include rooms.
    HangoutsChatOptions -> Maybe Bool
includeRooms :: (Core.Maybe Core.Bool)
  }
  deriving (HangoutsChatOptions -> HangoutsChatOptions -> Bool
(HangoutsChatOptions -> HangoutsChatOptions -> Bool)
-> (HangoutsChatOptions -> HangoutsChatOptions -> Bool)
-> Eq HangoutsChatOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HangoutsChatOptions -> HangoutsChatOptions -> Bool
== :: HangoutsChatOptions -> HangoutsChatOptions -> Bool
$c/= :: HangoutsChatOptions -> HangoutsChatOptions -> Bool
/= :: HangoutsChatOptions -> HangoutsChatOptions -> Bool
Core.Eq, Int -> HangoutsChatOptions -> ShowS
[HangoutsChatOptions] -> ShowS
HangoutsChatOptions -> String
(Int -> HangoutsChatOptions -> ShowS)
-> (HangoutsChatOptions -> String)
-> ([HangoutsChatOptions] -> ShowS)
-> Show HangoutsChatOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HangoutsChatOptions -> ShowS
showsPrec :: Int -> HangoutsChatOptions -> ShowS
$cshow :: HangoutsChatOptions -> String
show :: HangoutsChatOptions -> String
$cshowList :: [HangoutsChatOptions] -> ShowS
showList :: [HangoutsChatOptions] -> ShowS
Core.Show, (forall x. HangoutsChatOptions -> Rep HangoutsChatOptions x)
-> (forall x. Rep HangoutsChatOptions x -> HangoutsChatOptions)
-> Generic HangoutsChatOptions
forall x. Rep HangoutsChatOptions x -> HangoutsChatOptions
forall x. HangoutsChatOptions -> Rep HangoutsChatOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HangoutsChatOptions -> Rep HangoutsChatOptions x
from :: forall x. HangoutsChatOptions -> Rep HangoutsChatOptions x
$cto :: forall x. Rep HangoutsChatOptions x -> HangoutsChatOptions
to :: forall x. Rep HangoutsChatOptions x -> HangoutsChatOptions
Core.Generic)

-- | Creates a value of 'HangoutsChatOptions' with the minimum fields required to make a request.
newHangoutsChatOptions ::
  HangoutsChatOptions
newHangoutsChatOptions :: HangoutsChatOptions
newHangoutsChatOptions =
  HangoutsChatOptions {includeRooms :: Maybe Bool
includeRooms = Maybe Bool
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON HangoutsChatOptions where
  parseJSON :: Value -> Parser HangoutsChatOptions
parseJSON =
    String
-> (Object -> Parser HangoutsChatOptions)
-> Value
-> Parser HangoutsChatOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"HangoutsChatOptions"
      (\Object
o -> Maybe Bool -> HangoutsChatOptions
HangoutsChatOptions (Maybe Bool -> HangoutsChatOptions)
-> Parser (Maybe Bool) -> Parser HangoutsChatOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"includeRooms"))

instance Core.ToJSON HangoutsChatOptions where
  toJSON :: HangoutsChatOptions -> Value
toJSON HangoutsChatOptions {Maybe Bool
includeRooms :: HangoutsChatOptions -> Maybe Bool
includeRooms :: Maybe Bool
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"includeRooms" Core..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Bool
includeRooms])

-- | An account covered by a hold. This structure is immutable. It can be an individual account or a Google Group, depending on the service. To work with Vault resources, the account must have the [required Vault privileges] (https:\/\/support.google.com\/vault\/answer\/2799699) and access to the matter. To access a matter, the account must have created the matter, have the matter shared with them, or have the __View All Matters__ privilege.
--
-- /See:/ 'newHeldAccount' smart constructor.
data HeldAccount = HeldAccount
  { -- | The account ID, as provided by the <https://developers.google.com/admin-sdk/ Admin SDK>.
    HeldAccount -> Maybe Text
accountId :: (Core.Maybe Core.Text),
    -- | The primary email address of the account. If used as an input, this takes precedence over __accountId__.
    HeldAccount -> Maybe Text
email :: (Core.Maybe Core.Text),
    -- | Output only. The first name of the account holder.
    HeldAccount -> Maybe Text
firstName :: (Core.Maybe Core.Text),
    -- | Output only. When the account was put on hold.
    HeldAccount -> Maybe DateTime
holdTime :: (Core.Maybe Core.DateTime),
    -- | Output only. The last name of the account holder.
    HeldAccount -> Maybe Text
lastName :: (Core.Maybe Core.Text)
  }
  deriving (HeldAccount -> HeldAccount -> Bool
(HeldAccount -> HeldAccount -> Bool)
-> (HeldAccount -> HeldAccount -> Bool) -> Eq HeldAccount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeldAccount -> HeldAccount -> Bool
== :: HeldAccount -> HeldAccount -> Bool
$c/= :: HeldAccount -> HeldAccount -> Bool
/= :: HeldAccount -> HeldAccount -> Bool
Core.Eq, Int -> HeldAccount -> ShowS
[HeldAccount] -> ShowS
HeldAccount -> String
(Int -> HeldAccount -> ShowS)
-> (HeldAccount -> String)
-> ([HeldAccount] -> ShowS)
-> Show HeldAccount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeldAccount -> ShowS
showsPrec :: Int -> HeldAccount -> ShowS
$cshow :: HeldAccount -> String
show :: HeldAccount -> String
$cshowList :: [HeldAccount] -> ShowS
showList :: [HeldAccount] -> ShowS
Core.Show, (forall x. HeldAccount -> Rep HeldAccount x)
-> (forall x. Rep HeldAccount x -> HeldAccount)
-> Generic HeldAccount
forall x. Rep HeldAccount x -> HeldAccount
forall x. HeldAccount -> Rep HeldAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeldAccount -> Rep HeldAccount x
from :: forall x. HeldAccount -> Rep HeldAccount x
$cto :: forall x. Rep HeldAccount x -> HeldAccount
to :: forall x. Rep HeldAccount x -> HeldAccount
Core.Generic)

-- | Creates a value of 'HeldAccount' with the minimum fields required to make a request.
newHeldAccount ::
  HeldAccount
newHeldAccount :: HeldAccount
newHeldAccount =
  HeldAccount
    { accountId :: Maybe Text
accountId = Maybe Text
forall a. Maybe a
Core.Nothing,
      email :: Maybe Text
email = Maybe Text
forall a. Maybe a
Core.Nothing,
      firstName :: Maybe Text
firstName = Maybe Text
forall a. Maybe a
Core.Nothing,
      holdTime :: Maybe DateTime
holdTime = Maybe DateTime
forall a. Maybe a
Core.Nothing,
      lastName :: Maybe Text
lastName = Maybe Text
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON HeldAccount where
  parseJSON :: Value -> Parser HeldAccount
parseJSON =
    String
-> (Object -> Parser HeldAccount) -> Value -> Parser HeldAccount
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"HeldAccount"
      ( \Object
o ->
          Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe DateTime
-> Maybe Text
-> HeldAccount
HeldAccount
            (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Text
 -> HeldAccount)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe DateTime -> Maybe Text -> HeldAccount)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"accountId")
            Parser
  (Maybe Text
   -> Maybe Text -> Maybe DateTime -> Maybe Text -> HeldAccount)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe DateTime -> Maybe Text -> HeldAccount)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"email")
            Parser (Maybe Text -> Maybe DateTime -> Maybe Text -> HeldAccount)
-> Parser (Maybe Text)
-> Parser (Maybe DateTime -> Maybe Text -> HeldAccount)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"firstName")
            Parser (Maybe DateTime -> Maybe Text -> HeldAccount)
-> Parser (Maybe DateTime) -> Parser (Maybe Text -> HeldAccount)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"holdTime")
            Parser (Maybe Text -> HeldAccount)
-> Parser (Maybe Text) -> Parser HeldAccount
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"lastName")
      )

instance Core.ToJSON HeldAccount where
  toJSON :: HeldAccount -> Value
toJSON HeldAccount {Maybe Text
Maybe DateTime
accountId :: HeldAccount -> Maybe Text
email :: HeldAccount -> Maybe Text
firstName :: HeldAccount -> Maybe Text
holdTime :: HeldAccount -> Maybe DateTime
lastName :: HeldAccount -> Maybe Text
accountId :: Maybe Text
email :: Maybe Text
firstName :: Maybe Text
holdTime :: Maybe DateTime
lastName :: Maybe Text
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"accountId" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
accountId,
            (Key
"email" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
email,
            (Key
"firstName" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
firstName,
            (Key
"holdTime" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
holdTime,
            (Key
"lastName" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
lastName
          ]
      )

-- | Options for Calendar holds.
--
-- /See:/ 'newHeldCalendarQuery' smart constructor.
data HeldCalendarQuery = HeldCalendarQuery
  deriving (HeldCalendarQuery -> HeldCalendarQuery -> Bool
(HeldCalendarQuery -> HeldCalendarQuery -> Bool)
-> (HeldCalendarQuery -> HeldCalendarQuery -> Bool)
-> Eq HeldCalendarQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeldCalendarQuery -> HeldCalendarQuery -> Bool
== :: HeldCalendarQuery -> HeldCalendarQuery -> Bool
$c/= :: HeldCalendarQuery -> HeldCalendarQuery -> Bool
/= :: HeldCalendarQuery -> HeldCalendarQuery -> Bool
Core.Eq, Int -> HeldCalendarQuery -> ShowS
[HeldCalendarQuery] -> ShowS
HeldCalendarQuery -> String
(Int -> HeldCalendarQuery -> ShowS)
-> (HeldCalendarQuery -> String)
-> ([HeldCalendarQuery] -> ShowS)
-> Show HeldCalendarQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeldCalendarQuery -> ShowS
showsPrec :: Int -> HeldCalendarQuery -> ShowS
$cshow :: HeldCalendarQuery -> String
show :: HeldCalendarQuery -> String
$cshowList :: [HeldCalendarQuery] -> ShowS
showList :: [HeldCalendarQuery] -> ShowS
Core.Show, (forall x. HeldCalendarQuery -> Rep HeldCalendarQuery x)
-> (forall x. Rep HeldCalendarQuery x -> HeldCalendarQuery)
-> Generic HeldCalendarQuery
forall x. Rep HeldCalendarQuery x -> HeldCalendarQuery
forall x. HeldCalendarQuery -> Rep HeldCalendarQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeldCalendarQuery -> Rep HeldCalendarQuery x
from :: forall x. HeldCalendarQuery -> Rep HeldCalendarQuery x
$cto :: forall x. Rep HeldCalendarQuery x -> HeldCalendarQuery
to :: forall x. Rep HeldCalendarQuery x -> HeldCalendarQuery
Core.Generic)

-- | Creates a value of 'HeldCalendarQuery' with the minimum fields required to make a request.
newHeldCalendarQuery ::
  HeldCalendarQuery
newHeldCalendarQuery :: HeldCalendarQuery
newHeldCalendarQuery = HeldCalendarQuery
HeldCalendarQuery

instance Core.FromJSON HeldCalendarQuery where
  parseJSON :: Value -> Parser HeldCalendarQuery
parseJSON =
    String
-> (Object -> Parser HeldCalendarQuery)
-> Value
-> Parser HeldCalendarQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"HeldCalendarQuery"
      (\Object
o -> HeldCalendarQuery -> Parser HeldCalendarQuery
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Core.pure HeldCalendarQuery
HeldCalendarQuery)

instance Core.ToJSON HeldCalendarQuery where
  toJSON :: HeldCalendarQuery -> Value
toJSON = Value -> HeldCalendarQuery -> Value
forall a b. a -> b -> a
Core.const Value
Core.emptyObject

-- | Options for Drive holds.
--
-- /See:/ 'newHeldDriveQuery' smart constructor.
data HeldDriveQuery = HeldDriveQuery
  { -- | To include files in shared drives in the hold, set to __true__.
    HeldDriveQuery -> Maybe Bool
includeSharedDriveFiles :: (Core.Maybe Core.Bool),
    -- | To include files in Team Drives in the hold, set to __true__.
    HeldDriveQuery -> Maybe Bool
includeTeamDriveFiles :: (Core.Maybe Core.Bool)
  }
  deriving (HeldDriveQuery -> HeldDriveQuery -> Bool
(HeldDriveQuery -> HeldDriveQuery -> Bool)
-> (HeldDriveQuery -> HeldDriveQuery -> Bool) -> Eq HeldDriveQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeldDriveQuery -> HeldDriveQuery -> Bool
== :: HeldDriveQuery -> HeldDriveQuery -> Bool
$c/= :: HeldDriveQuery -> HeldDriveQuery -> Bool
/= :: HeldDriveQuery -> HeldDriveQuery -> Bool
Core.Eq, Int -> HeldDriveQuery -> ShowS
[HeldDriveQuery] -> ShowS
HeldDriveQuery -> String
(Int -> HeldDriveQuery -> ShowS)
-> (HeldDriveQuery -> String)
-> ([HeldDriveQuery] -> ShowS)
-> Show HeldDriveQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeldDriveQuery -> ShowS
showsPrec :: Int -> HeldDriveQuery -> ShowS
$cshow :: HeldDriveQuery -> String
show :: HeldDriveQuery -> String
$cshowList :: [HeldDriveQuery] -> ShowS
showList :: [HeldDriveQuery] -> ShowS
Core.Show, (forall x. HeldDriveQuery -> Rep HeldDriveQuery x)
-> (forall x. Rep HeldDriveQuery x -> HeldDriveQuery)
-> Generic HeldDriveQuery
forall x. Rep HeldDriveQuery x -> HeldDriveQuery
forall x. HeldDriveQuery -> Rep HeldDriveQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeldDriveQuery -> Rep HeldDriveQuery x
from :: forall x. HeldDriveQuery -> Rep HeldDriveQuery x
$cto :: forall x. Rep HeldDriveQuery x -> HeldDriveQuery
to :: forall x. Rep HeldDriveQuery x -> HeldDriveQuery
Core.Generic)

-- | Creates a value of 'HeldDriveQuery' with the minimum fields required to make a request.
newHeldDriveQuery ::
  HeldDriveQuery
newHeldDriveQuery :: HeldDriveQuery
newHeldDriveQuery =
  HeldDriveQuery
    { includeSharedDriveFiles :: Maybe Bool
includeSharedDriveFiles = Maybe Bool
forall a. Maybe a
Core.Nothing,
      includeTeamDriveFiles :: Maybe Bool
includeTeamDriveFiles = Maybe Bool
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON HeldDriveQuery where
  parseJSON :: Value -> Parser HeldDriveQuery
parseJSON =
    String
-> (Object -> Parser HeldDriveQuery)
-> Value
-> Parser HeldDriveQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"HeldDriveQuery"
      ( \Object
o ->
          Maybe Bool -> Maybe Bool -> HeldDriveQuery
HeldDriveQuery
            (Maybe Bool -> Maybe Bool -> HeldDriveQuery)
-> Parser (Maybe Bool) -> Parser (Maybe Bool -> HeldDriveQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"includeSharedDriveFiles")
            Parser (Maybe Bool -> HeldDriveQuery)
-> Parser (Maybe Bool) -> Parser HeldDriveQuery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"includeTeamDriveFiles")
      )

instance Core.ToJSON HeldDriveQuery where
  toJSON :: HeldDriveQuery -> Value
toJSON HeldDriveQuery {Maybe Bool
includeSharedDriveFiles :: HeldDriveQuery -> Maybe Bool
includeTeamDriveFiles :: HeldDriveQuery -> Maybe Bool
includeSharedDriveFiles :: Maybe Bool
includeTeamDriveFiles :: Maybe Bool
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"includeSharedDriveFiles" Core..=)
              (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Bool
includeSharedDriveFiles,
            (Key
"includeTeamDriveFiles" Core..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Bool
includeTeamDriveFiles
          ]
      )

-- | Query options for group holds.
--
-- /See:/ 'newHeldGroupsQuery' smart constructor.
data HeldGroupsQuery = HeldGroupsQuery
  { -- | The end time for the query. Specify in GMT. The value is rounded to 12 AM on the specified date.
    HeldGroupsQuery -> Maybe DateTime
endTime :: (Core.Maybe Core.DateTime),
    -- | The start time for the query. Specify in GMT. The value is rounded to 12 AM on the specified date.
    HeldGroupsQuery -> Maybe DateTime
startTime :: (Core.Maybe Core.DateTime),
    -- | The <https://support.google.com/vault/answer/2474474 search operators> used to refine the messages covered by the hold.
    HeldGroupsQuery -> Maybe Text
terms :: (Core.Maybe Core.Text)
  }
  deriving (HeldGroupsQuery -> HeldGroupsQuery -> Bool
(HeldGroupsQuery -> HeldGroupsQuery -> Bool)
-> (HeldGroupsQuery -> HeldGroupsQuery -> Bool)
-> Eq HeldGroupsQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeldGroupsQuery -> HeldGroupsQuery -> Bool
== :: HeldGroupsQuery -> HeldGroupsQuery -> Bool
$c/= :: HeldGroupsQuery -> HeldGroupsQuery -> Bool
/= :: HeldGroupsQuery -> HeldGroupsQuery -> Bool
Core.Eq, Int -> HeldGroupsQuery -> ShowS
[HeldGroupsQuery] -> ShowS
HeldGroupsQuery -> String
(Int -> HeldGroupsQuery -> ShowS)
-> (HeldGroupsQuery -> String)
-> ([HeldGroupsQuery] -> ShowS)
-> Show HeldGroupsQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeldGroupsQuery -> ShowS
showsPrec :: Int -> HeldGroupsQuery -> ShowS
$cshow :: HeldGroupsQuery -> String
show :: HeldGroupsQuery -> String
$cshowList :: [HeldGroupsQuery] -> ShowS
showList :: [HeldGroupsQuery] -> ShowS
Core.Show, (forall x. HeldGroupsQuery -> Rep HeldGroupsQuery x)
-> (forall x. Rep HeldGroupsQuery x -> HeldGroupsQuery)
-> Generic HeldGroupsQuery
forall x. Rep HeldGroupsQuery x -> HeldGroupsQuery
forall x. HeldGroupsQuery -> Rep HeldGroupsQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeldGroupsQuery -> Rep HeldGroupsQuery x
from :: forall x. HeldGroupsQuery -> Rep HeldGroupsQuery x
$cto :: forall x. Rep HeldGroupsQuery x -> HeldGroupsQuery
to :: forall x. Rep HeldGroupsQuery x -> HeldGroupsQuery
Core.Generic)

-- | Creates a value of 'HeldGroupsQuery' with the minimum fields required to make a request.
newHeldGroupsQuery ::
  HeldGroupsQuery
newHeldGroupsQuery :: HeldGroupsQuery
newHeldGroupsQuery =
  HeldGroupsQuery
    { endTime :: Maybe DateTime
endTime = Maybe DateTime
forall a. Maybe a
Core.Nothing,
      startTime :: Maybe DateTime
startTime = Maybe DateTime
forall a. Maybe a
Core.Nothing,
      terms :: Maybe Text
terms = Maybe Text
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON HeldGroupsQuery where
  parseJSON :: Value -> Parser HeldGroupsQuery
parseJSON =
    String
-> (Object -> Parser HeldGroupsQuery)
-> Value
-> Parser HeldGroupsQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"HeldGroupsQuery"
      ( \Object
o ->
          Maybe DateTime -> Maybe DateTime -> Maybe Text -> HeldGroupsQuery
HeldGroupsQuery
            (Maybe DateTime -> Maybe DateTime -> Maybe Text -> HeldGroupsQuery)
-> Parser (Maybe DateTime)
-> Parser (Maybe DateTime -> Maybe Text -> HeldGroupsQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"endTime")
            Parser (Maybe DateTime -> Maybe Text -> HeldGroupsQuery)
-> Parser (Maybe DateTime)
-> Parser (Maybe Text -> HeldGroupsQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"startTime")
            Parser (Maybe Text -> HeldGroupsQuery)
-> Parser (Maybe Text) -> Parser HeldGroupsQuery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"terms")
      )

instance Core.ToJSON HeldGroupsQuery where
  toJSON :: HeldGroupsQuery -> Value
toJSON HeldGroupsQuery {Maybe Text
Maybe DateTime
endTime :: HeldGroupsQuery -> Maybe DateTime
startTime :: HeldGroupsQuery -> Maybe DateTime
terms :: HeldGroupsQuery -> Maybe Text
endTime :: Maybe DateTime
startTime :: Maybe DateTime
terms :: Maybe Text
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"endTime" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
endTime,
            (Key
"startTime" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
startTime,
            (Key
"terms" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
terms
          ]
      )

-- | Options for Chat holds.
--
-- /See:/ 'newHeldHangoutsChatQuery' smart constructor.
newtype HeldHangoutsChatQuery = HeldHangoutsChatQuery
  { -- | To include messages in Chat spaces the user was a member of, set to __true__.
    HeldHangoutsChatQuery -> Maybe Bool
includeRooms :: (Core.Maybe Core.Bool)
  }
  deriving (HeldHangoutsChatQuery -> HeldHangoutsChatQuery -> Bool
(HeldHangoutsChatQuery -> HeldHangoutsChatQuery -> Bool)
-> (HeldHangoutsChatQuery -> HeldHangoutsChatQuery -> Bool)
-> Eq HeldHangoutsChatQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeldHangoutsChatQuery -> HeldHangoutsChatQuery -> Bool
== :: HeldHangoutsChatQuery -> HeldHangoutsChatQuery -> Bool
$c/= :: HeldHangoutsChatQuery -> HeldHangoutsChatQuery -> Bool
/= :: HeldHangoutsChatQuery -> HeldHangoutsChatQuery -> Bool
Core.Eq, Int -> HeldHangoutsChatQuery -> ShowS
[HeldHangoutsChatQuery] -> ShowS
HeldHangoutsChatQuery -> String
(Int -> HeldHangoutsChatQuery -> ShowS)
-> (HeldHangoutsChatQuery -> String)
-> ([HeldHangoutsChatQuery] -> ShowS)
-> Show HeldHangoutsChatQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeldHangoutsChatQuery -> ShowS
showsPrec :: Int -> HeldHangoutsChatQuery -> ShowS
$cshow :: HeldHangoutsChatQuery -> String
show :: HeldHangoutsChatQuery -> String
$cshowList :: [HeldHangoutsChatQuery] -> ShowS
showList :: [HeldHangoutsChatQuery] -> ShowS
Core.Show, (forall x. HeldHangoutsChatQuery -> Rep HeldHangoutsChatQuery x)
-> (forall x. Rep HeldHangoutsChatQuery x -> HeldHangoutsChatQuery)
-> Generic HeldHangoutsChatQuery
forall x. Rep HeldHangoutsChatQuery x -> HeldHangoutsChatQuery
forall x. HeldHangoutsChatQuery -> Rep HeldHangoutsChatQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeldHangoutsChatQuery -> Rep HeldHangoutsChatQuery x
from :: forall x. HeldHangoutsChatQuery -> Rep HeldHangoutsChatQuery x
$cto :: forall x. Rep HeldHangoutsChatQuery x -> HeldHangoutsChatQuery
to :: forall x. Rep HeldHangoutsChatQuery x -> HeldHangoutsChatQuery
Core.Generic)

-- | Creates a value of 'HeldHangoutsChatQuery' with the minimum fields required to make a request.
newHeldHangoutsChatQuery ::
  HeldHangoutsChatQuery
newHeldHangoutsChatQuery :: HeldHangoutsChatQuery
newHeldHangoutsChatQuery =
  HeldHangoutsChatQuery {includeRooms :: Maybe Bool
includeRooms = Maybe Bool
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON HeldHangoutsChatQuery where
  parseJSON :: Value -> Parser HeldHangoutsChatQuery
parseJSON =
    String
-> (Object -> Parser HeldHangoutsChatQuery)
-> Value
-> Parser HeldHangoutsChatQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"HeldHangoutsChatQuery"
      (\Object
o -> Maybe Bool -> HeldHangoutsChatQuery
HeldHangoutsChatQuery (Maybe Bool -> HeldHangoutsChatQuery)
-> Parser (Maybe Bool) -> Parser HeldHangoutsChatQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"includeRooms"))

instance Core.ToJSON HeldHangoutsChatQuery where
  toJSON :: HeldHangoutsChatQuery -> Value
toJSON HeldHangoutsChatQuery {Maybe Bool
includeRooms :: HeldHangoutsChatQuery -> Maybe Bool
includeRooms :: Maybe Bool
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"includeRooms" Core..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Bool
includeRooms])

-- | Query options for Gmail holds.
--
-- /See:/ 'newHeldMailQuery' smart constructor.
data HeldMailQuery = HeldMailQuery
  { -- | The end time for the query. Specify in GMT. The value is rounded to 12 AM on the specified date.
    HeldMailQuery -> Maybe DateTime
endTime :: (Core.Maybe Core.DateTime),
    -- | The start time for the query. Specify in GMT. The value is rounded to 12 AM on the specified date.
    HeldMailQuery -> Maybe DateTime
startTime :: (Core.Maybe Core.DateTime),
    -- | The <https://support.google.com/vault/answer/2474474 search operators> used to refine the messages covered by the hold.
    HeldMailQuery -> Maybe Text
terms :: (Core.Maybe Core.Text)
  }
  deriving (HeldMailQuery -> HeldMailQuery -> Bool
(HeldMailQuery -> HeldMailQuery -> Bool)
-> (HeldMailQuery -> HeldMailQuery -> Bool) -> Eq HeldMailQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeldMailQuery -> HeldMailQuery -> Bool
== :: HeldMailQuery -> HeldMailQuery -> Bool
$c/= :: HeldMailQuery -> HeldMailQuery -> Bool
/= :: HeldMailQuery -> HeldMailQuery -> Bool
Core.Eq, Int -> HeldMailQuery -> ShowS
[HeldMailQuery] -> ShowS
HeldMailQuery -> String
(Int -> HeldMailQuery -> ShowS)
-> (HeldMailQuery -> String)
-> ([HeldMailQuery] -> ShowS)
-> Show HeldMailQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeldMailQuery -> ShowS
showsPrec :: Int -> HeldMailQuery -> ShowS
$cshow :: HeldMailQuery -> String
show :: HeldMailQuery -> String
$cshowList :: [HeldMailQuery] -> ShowS
showList :: [HeldMailQuery] -> ShowS
Core.Show, (forall x. HeldMailQuery -> Rep HeldMailQuery x)
-> (forall x. Rep HeldMailQuery x -> HeldMailQuery)
-> Generic HeldMailQuery
forall x. Rep HeldMailQuery x -> HeldMailQuery
forall x. HeldMailQuery -> Rep HeldMailQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeldMailQuery -> Rep HeldMailQuery x
from :: forall x. HeldMailQuery -> Rep HeldMailQuery x
$cto :: forall x. Rep HeldMailQuery x -> HeldMailQuery
to :: forall x. Rep HeldMailQuery x -> HeldMailQuery
Core.Generic)

-- | Creates a value of 'HeldMailQuery' with the minimum fields required to make a request.
newHeldMailQuery ::
  HeldMailQuery
newHeldMailQuery :: HeldMailQuery
newHeldMailQuery =
  HeldMailQuery
    { endTime :: Maybe DateTime
endTime = Maybe DateTime
forall a. Maybe a
Core.Nothing,
      startTime :: Maybe DateTime
startTime = Maybe DateTime
forall a. Maybe a
Core.Nothing,
      terms :: Maybe Text
terms = Maybe Text
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON HeldMailQuery where
  parseJSON :: Value -> Parser HeldMailQuery
parseJSON =
    String
-> (Object -> Parser HeldMailQuery)
-> Value
-> Parser HeldMailQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"HeldMailQuery"
      ( \Object
o ->
          Maybe DateTime -> Maybe DateTime -> Maybe Text -> HeldMailQuery
HeldMailQuery
            (Maybe DateTime -> Maybe DateTime -> Maybe Text -> HeldMailQuery)
-> Parser (Maybe DateTime)
-> Parser (Maybe DateTime -> Maybe Text -> HeldMailQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"endTime")
            Parser (Maybe DateTime -> Maybe Text -> HeldMailQuery)
-> Parser (Maybe DateTime) -> Parser (Maybe Text -> HeldMailQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"startTime")
            Parser (Maybe Text -> HeldMailQuery)
-> Parser (Maybe Text) -> Parser HeldMailQuery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"terms")
      )

instance Core.ToJSON HeldMailQuery where
  toJSON :: HeldMailQuery -> Value
toJSON HeldMailQuery {Maybe Text
Maybe DateTime
endTime :: HeldMailQuery -> Maybe DateTime
startTime :: HeldMailQuery -> Maybe DateTime
terms :: HeldMailQuery -> Maybe Text
endTime :: Maybe DateTime
startTime :: Maybe DateTime
terms :: Maybe Text
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"endTime" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
endTime,
            (Key
"startTime" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
startTime,
            (Key
"terms" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
terms
          ]
      )

-- | The organizational unit covered by a hold. This structure is immutable.
--
-- /See:/ 'newHeldOrgUnit' smart constructor.
data HeldOrgUnit = HeldOrgUnit
  { -- | When the organizational unit was put on hold. This property is immutable.
    HeldOrgUnit -> Maybe DateTime
holdTime :: (Core.Maybe Core.DateTime),
    -- | The organizational unit\'s immutable ID as provided by the <https://developers.google.com/admin-sdk/ Admin SDK>.
    HeldOrgUnit -> Maybe Text
orgUnitId :: (Core.Maybe Core.Text)
  }
  deriving (HeldOrgUnit -> HeldOrgUnit -> Bool
(HeldOrgUnit -> HeldOrgUnit -> Bool)
-> (HeldOrgUnit -> HeldOrgUnit -> Bool) -> Eq HeldOrgUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeldOrgUnit -> HeldOrgUnit -> Bool
== :: HeldOrgUnit -> HeldOrgUnit -> Bool
$c/= :: HeldOrgUnit -> HeldOrgUnit -> Bool
/= :: HeldOrgUnit -> HeldOrgUnit -> Bool
Core.Eq, Int -> HeldOrgUnit -> ShowS
[HeldOrgUnit] -> ShowS
HeldOrgUnit -> String
(Int -> HeldOrgUnit -> ShowS)
-> (HeldOrgUnit -> String)
-> ([HeldOrgUnit] -> ShowS)
-> Show HeldOrgUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeldOrgUnit -> ShowS
showsPrec :: Int -> HeldOrgUnit -> ShowS
$cshow :: HeldOrgUnit -> String
show :: HeldOrgUnit -> String
$cshowList :: [HeldOrgUnit] -> ShowS
showList :: [HeldOrgUnit] -> ShowS
Core.Show, (forall x. HeldOrgUnit -> Rep HeldOrgUnit x)
-> (forall x. Rep HeldOrgUnit x -> HeldOrgUnit)
-> Generic HeldOrgUnit
forall x. Rep HeldOrgUnit x -> HeldOrgUnit
forall x. HeldOrgUnit -> Rep HeldOrgUnit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeldOrgUnit -> Rep HeldOrgUnit x
from :: forall x. HeldOrgUnit -> Rep HeldOrgUnit x
$cto :: forall x. Rep HeldOrgUnit x -> HeldOrgUnit
to :: forall x. Rep HeldOrgUnit x -> HeldOrgUnit
Core.Generic)

-- | Creates a value of 'HeldOrgUnit' with the minimum fields required to make a request.
newHeldOrgUnit ::
  HeldOrgUnit
newHeldOrgUnit :: HeldOrgUnit
newHeldOrgUnit =
  HeldOrgUnit {holdTime :: Maybe DateTime
holdTime = Maybe DateTime
forall a. Maybe a
Core.Nothing, orgUnitId :: Maybe Text
orgUnitId = Maybe Text
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON HeldOrgUnit where
  parseJSON :: Value -> Parser HeldOrgUnit
parseJSON =
    String
-> (Object -> Parser HeldOrgUnit) -> Value -> Parser HeldOrgUnit
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"HeldOrgUnit"
      ( \Object
o ->
          Maybe DateTime -> Maybe Text -> HeldOrgUnit
HeldOrgUnit
            (Maybe DateTime -> Maybe Text -> HeldOrgUnit)
-> Parser (Maybe DateTime) -> Parser (Maybe Text -> HeldOrgUnit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"holdTime")
            Parser (Maybe Text -> HeldOrgUnit)
-> Parser (Maybe Text) -> Parser HeldOrgUnit
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"orgUnitId")
      )

instance Core.ToJSON HeldOrgUnit where
  toJSON :: HeldOrgUnit -> Value
toJSON HeldOrgUnit {Maybe Text
Maybe DateTime
holdTime :: HeldOrgUnit -> Maybe DateTime
orgUnitId :: HeldOrgUnit -> Maybe Text
holdTime :: Maybe DateTime
orgUnitId :: Maybe Text
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"holdTime" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
holdTime,
            (Key
"orgUnitId" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
orgUnitId
          ]
      )

-- | Options for Voice holds.
--
-- /See:/ 'newHeldVoiceQuery' smart constructor.
newtype HeldVoiceQuery = HeldVoiceQuery
  { -- | A list of data types covered by the hold. Should be non-empty. Order does not matter and duplicates are ignored.
    HeldVoiceQuery -> Maybe [HeldVoiceQuery_CoveredDataItem]
coveredData :: (Core.Maybe [HeldVoiceQuery_CoveredDataItem])
  }
  deriving (HeldVoiceQuery -> HeldVoiceQuery -> Bool
(HeldVoiceQuery -> HeldVoiceQuery -> Bool)
-> (HeldVoiceQuery -> HeldVoiceQuery -> Bool) -> Eq HeldVoiceQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeldVoiceQuery -> HeldVoiceQuery -> Bool
== :: HeldVoiceQuery -> HeldVoiceQuery -> Bool
$c/= :: HeldVoiceQuery -> HeldVoiceQuery -> Bool
/= :: HeldVoiceQuery -> HeldVoiceQuery -> Bool
Core.Eq, Int -> HeldVoiceQuery -> ShowS
[HeldVoiceQuery] -> ShowS
HeldVoiceQuery -> String
(Int -> HeldVoiceQuery -> ShowS)
-> (HeldVoiceQuery -> String)
-> ([HeldVoiceQuery] -> ShowS)
-> Show HeldVoiceQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeldVoiceQuery -> ShowS
showsPrec :: Int -> HeldVoiceQuery -> ShowS
$cshow :: HeldVoiceQuery -> String
show :: HeldVoiceQuery -> String
$cshowList :: [HeldVoiceQuery] -> ShowS
showList :: [HeldVoiceQuery] -> ShowS
Core.Show, (forall x. HeldVoiceQuery -> Rep HeldVoiceQuery x)
-> (forall x. Rep HeldVoiceQuery x -> HeldVoiceQuery)
-> Generic HeldVoiceQuery
forall x. Rep HeldVoiceQuery x -> HeldVoiceQuery
forall x. HeldVoiceQuery -> Rep HeldVoiceQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeldVoiceQuery -> Rep HeldVoiceQuery x
from :: forall x. HeldVoiceQuery -> Rep HeldVoiceQuery x
$cto :: forall x. Rep HeldVoiceQuery x -> HeldVoiceQuery
to :: forall x. Rep HeldVoiceQuery x -> HeldVoiceQuery
Core.Generic)

-- | Creates a value of 'HeldVoiceQuery' with the minimum fields required to make a request.
newHeldVoiceQuery ::
  HeldVoiceQuery
newHeldVoiceQuery :: HeldVoiceQuery
newHeldVoiceQuery = HeldVoiceQuery {coveredData :: Maybe [HeldVoiceQuery_CoveredDataItem]
coveredData = Maybe [HeldVoiceQuery_CoveredDataItem]
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON HeldVoiceQuery where
  parseJSON :: Value -> Parser HeldVoiceQuery
parseJSON =
    String
-> (Object -> Parser HeldVoiceQuery)
-> Value
-> Parser HeldVoiceQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"HeldVoiceQuery"
      (\Object
o -> Maybe [HeldVoiceQuery_CoveredDataItem] -> HeldVoiceQuery
HeldVoiceQuery (Maybe [HeldVoiceQuery_CoveredDataItem] -> HeldVoiceQuery)
-> Parser (Maybe [HeldVoiceQuery_CoveredDataItem])
-> Parser HeldVoiceQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [HeldVoiceQuery_CoveredDataItem])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"coveredData"))

instance Core.ToJSON HeldVoiceQuery where
  toJSON :: HeldVoiceQuery -> Value
toJSON HeldVoiceQuery {Maybe [HeldVoiceQuery_CoveredDataItem]
coveredData :: HeldVoiceQuery -> Maybe [HeldVoiceQuery_CoveredDataItem]
coveredData :: Maybe [HeldVoiceQuery_CoveredDataItem]
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"coveredData" Core..=) ([HeldVoiceQuery_CoveredDataItem] -> Pair)
-> Maybe [HeldVoiceQuery_CoveredDataItem] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [HeldVoiceQuery_CoveredDataItem]
coveredData])

-- | A hold. A hold prevents the specified Google Workspace service from purging data for specific accounts or all members of an organizational unit. To work with Vault resources, the account must have the [required Vault privileges] (https:\/\/support.google.com\/vault\/answer\/2799699) and access to the matter. To access a matter, the account must have created the matter, have the matter shared with them, or have the __View All Matters__ privilege.
--
-- /See:/ 'newHold' smart constructor.
data Hold = Hold
  { -- | If set, the hold applies to the specified accounts and __orgUnit__ must be empty.
    Hold -> Maybe [HeldAccount]
accounts :: (Core.Maybe [HeldAccount]),
    -- | The service to be searched.
    Hold -> Maybe Hold_Corpus
corpus :: (Core.Maybe Hold_Corpus),
    -- | The unique immutable ID of the hold. Assigned during creation.
    Hold -> Maybe Text
holdId :: (Core.Maybe Core.Text),
    -- | The name of the hold.
    Hold -> Maybe Text
name :: (Core.Maybe Core.Text),
    -- | If set, the hold applies to all members of the organizational unit and __accounts__ must be empty. This property is mutable. For Groups holds, set __accounts__.
    Hold -> Maybe HeldOrgUnit
orgUnit :: (Core.Maybe HeldOrgUnit),
    -- | Service-specific options. If set, __CorpusQuery__ must match __CorpusType__.
    Hold -> Maybe CorpusQuery
query :: (Core.Maybe CorpusQuery),
    -- | The last time this hold was modified.
    Hold -> Maybe DateTime
updateTime :: (Core.Maybe Core.DateTime)
  }
  deriving (Hold -> Hold -> Bool
(Hold -> Hold -> Bool) -> (Hold -> Hold -> Bool) -> Eq Hold
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hold -> Hold -> Bool
== :: Hold -> Hold -> Bool
$c/= :: Hold -> Hold -> Bool
/= :: Hold -> Hold -> Bool
Core.Eq, Int -> Hold -> ShowS
[Hold] -> ShowS
Hold -> String
(Int -> Hold -> ShowS)
-> (Hold -> String) -> ([Hold] -> ShowS) -> Show Hold
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hold -> ShowS
showsPrec :: Int -> Hold -> ShowS
$cshow :: Hold -> String
show :: Hold -> String
$cshowList :: [Hold] -> ShowS
showList :: [Hold] -> ShowS
Core.Show, (forall x. Hold -> Rep Hold x)
-> (forall x. Rep Hold x -> Hold) -> Generic Hold
forall x. Rep Hold x -> Hold
forall x. Hold -> Rep Hold x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Hold -> Rep Hold x
from :: forall x. Hold -> Rep Hold x
$cto :: forall x. Rep Hold x -> Hold
to :: forall x. Rep Hold x -> Hold
Core.Generic)

-- | Creates a value of 'Hold' with the minimum fields required to make a request.
newHold ::
  Hold
newHold :: Hold
newHold =
  Hold
    { accounts :: Maybe [HeldAccount]
accounts = Maybe [HeldAccount]
forall a. Maybe a
Core.Nothing,
      corpus :: Maybe Hold_Corpus
corpus = Maybe Hold_Corpus
forall a. Maybe a
Core.Nothing,
      holdId :: Maybe Text
holdId = Maybe Text
forall a. Maybe a
Core.Nothing,
      name :: Maybe Text
name = Maybe Text
forall a. Maybe a
Core.Nothing,
      orgUnit :: Maybe HeldOrgUnit
orgUnit = Maybe HeldOrgUnit
forall a. Maybe a
Core.Nothing,
      query :: Maybe CorpusQuery
query = Maybe CorpusQuery
forall a. Maybe a
Core.Nothing,
      updateTime :: Maybe DateTime
updateTime = Maybe DateTime
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON Hold where
  parseJSON :: Value -> Parser Hold
parseJSON =
    String -> (Object -> Parser Hold) -> Value -> Parser Hold
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"Hold"
      ( \Object
o ->
          Maybe [HeldAccount]
-> Maybe Hold_Corpus
-> Maybe Text
-> Maybe Text
-> Maybe HeldOrgUnit
-> Maybe CorpusQuery
-> Maybe DateTime
-> Hold
Hold
            (Maybe [HeldAccount]
 -> Maybe Hold_Corpus
 -> Maybe Text
 -> Maybe Text
 -> Maybe HeldOrgUnit
 -> Maybe CorpusQuery
 -> Maybe DateTime
 -> Hold)
-> Parser (Maybe [HeldAccount])
-> Parser
     (Maybe Hold_Corpus
      -> Maybe Text
      -> Maybe Text
      -> Maybe HeldOrgUnit
      -> Maybe CorpusQuery
      -> Maybe DateTime
      -> Hold)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [HeldAccount])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"accounts")
            Parser
  (Maybe Hold_Corpus
   -> Maybe Text
   -> Maybe Text
   -> Maybe HeldOrgUnit
   -> Maybe CorpusQuery
   -> Maybe DateTime
   -> Hold)
-> Parser (Maybe Hold_Corpus)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe HeldOrgUnit
      -> Maybe CorpusQuery
      -> Maybe DateTime
      -> Hold)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Hold_Corpus)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"corpus")
            Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe HeldOrgUnit
   -> Maybe CorpusQuery
   -> Maybe DateTime
   -> Hold)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe HeldOrgUnit
      -> Maybe CorpusQuery
      -> Maybe DateTime
      -> Hold)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"holdId")
            Parser
  (Maybe Text
   -> Maybe HeldOrgUnit
   -> Maybe CorpusQuery
   -> Maybe DateTime
   -> Hold)
-> Parser (Maybe Text)
-> Parser
     (Maybe HeldOrgUnit -> Maybe CorpusQuery -> Maybe DateTime -> Hold)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"name")
            Parser
  (Maybe HeldOrgUnit -> Maybe CorpusQuery -> Maybe DateTime -> Hold)
-> Parser (Maybe HeldOrgUnit)
-> Parser (Maybe CorpusQuery -> Maybe DateTime -> Hold)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe HeldOrgUnit)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"orgUnit")
            Parser (Maybe CorpusQuery -> Maybe DateTime -> Hold)
-> Parser (Maybe CorpusQuery) -> Parser (Maybe DateTime -> Hold)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe CorpusQuery)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"query")
            Parser (Maybe DateTime -> Hold)
-> Parser (Maybe DateTime) -> Parser Hold
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"updateTime")
      )

instance Core.ToJSON Hold where
  toJSON :: Hold -> Value
toJSON Hold {Maybe [HeldAccount]
Maybe Text
Maybe DateTime
Maybe Hold_Corpus
Maybe HeldOrgUnit
Maybe CorpusQuery
accounts :: Hold -> Maybe [HeldAccount]
corpus :: Hold -> Maybe Hold_Corpus
holdId :: Hold -> Maybe Text
name :: Hold -> Maybe Text
orgUnit :: Hold -> Maybe HeldOrgUnit
query :: Hold -> Maybe CorpusQuery
updateTime :: Hold -> Maybe DateTime
accounts :: Maybe [HeldAccount]
corpus :: Maybe Hold_Corpus
holdId :: Maybe Text
name :: Maybe Text
orgUnit :: Maybe HeldOrgUnit
query :: Maybe CorpusQuery
updateTime :: Maybe DateTime
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"accounts" Core..=) ([HeldAccount] -> Pair) -> Maybe [HeldAccount] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [HeldAccount]
accounts,
            (Key
"corpus" Core..=) (Hold_Corpus -> Pair) -> Maybe Hold_Corpus -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Hold_Corpus
corpus,
            (Key
"holdId" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
holdId,
            (Key
"name" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
name,
            (Key
"orgUnit" Core..=) (HeldOrgUnit -> Pair) -> Maybe HeldOrgUnit -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe HeldOrgUnit
orgUnit,
            (Key
"query" Core..=) (CorpusQuery -> Pair) -> Maybe CorpusQuery -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe CorpusQuery
query,
            (Key
"updateTime" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
updateTime
          ]
      )

-- | The exports for a matter.
--
-- /See:/ 'newListExportsResponse' smart constructor.
data ListExportsResponse = ListExportsResponse
  { -- | The list of exports.
    ListExportsResponse -> Maybe [Export]
exports :: (Core.Maybe [Export]),
    -- | Page token to retrieve the next page of results in the list.
    ListExportsResponse -> Maybe Text
nextPageToken :: (Core.Maybe Core.Text)
  }
  deriving (ListExportsResponse -> ListExportsResponse -> Bool
(ListExportsResponse -> ListExportsResponse -> Bool)
-> (ListExportsResponse -> ListExportsResponse -> Bool)
-> Eq ListExportsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListExportsResponse -> ListExportsResponse -> Bool
== :: ListExportsResponse -> ListExportsResponse -> Bool
$c/= :: ListExportsResponse -> ListExportsResponse -> Bool
/= :: ListExportsResponse -> ListExportsResponse -> Bool
Core.Eq, Int -> ListExportsResponse -> ShowS
[ListExportsResponse] -> ShowS
ListExportsResponse -> String
(Int -> ListExportsResponse -> ShowS)
-> (ListExportsResponse -> String)
-> ([ListExportsResponse] -> ShowS)
-> Show ListExportsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListExportsResponse -> ShowS
showsPrec :: Int -> ListExportsResponse -> ShowS
$cshow :: ListExportsResponse -> String
show :: ListExportsResponse -> String
$cshowList :: [ListExportsResponse] -> ShowS
showList :: [ListExportsResponse] -> ShowS
Core.Show, (forall x. ListExportsResponse -> Rep ListExportsResponse x)
-> (forall x. Rep ListExportsResponse x -> ListExportsResponse)
-> Generic ListExportsResponse
forall x. Rep ListExportsResponse x -> ListExportsResponse
forall x. ListExportsResponse -> Rep ListExportsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListExportsResponse -> Rep ListExportsResponse x
from :: forall x. ListExportsResponse -> Rep ListExportsResponse x
$cto :: forall x. Rep ListExportsResponse x -> ListExportsResponse
to :: forall x. Rep ListExportsResponse x -> ListExportsResponse
Core.Generic)

-- | Creates a value of 'ListExportsResponse' with the minimum fields required to make a request.
newListExportsResponse ::
  ListExportsResponse
newListExportsResponse :: ListExportsResponse
newListExportsResponse =
  ListExportsResponse
    { exports :: Maybe [Export]
exports = Maybe [Export]
forall a. Maybe a
Core.Nothing,
      nextPageToken :: Maybe Text
nextPageToken = Maybe Text
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON ListExportsResponse where
  parseJSON :: Value -> Parser ListExportsResponse
parseJSON =
    String
-> (Object -> Parser ListExportsResponse)
-> Value
-> Parser ListExportsResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"ListExportsResponse"
      ( \Object
o ->
          Maybe [Export] -> Maybe Text -> ListExportsResponse
ListExportsResponse
            (Maybe [Export] -> Maybe Text -> ListExportsResponse)
-> Parser (Maybe [Export])
-> Parser (Maybe Text -> ListExportsResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [Export])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"exports")
            Parser (Maybe Text -> ListExportsResponse)
-> Parser (Maybe Text) -> Parser ListExportsResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"nextPageToken")
      )

instance Core.ToJSON ListExportsResponse where
  toJSON :: ListExportsResponse -> Value
toJSON ListExportsResponse {Maybe [Export]
Maybe Text
exports :: ListExportsResponse -> Maybe [Export]
nextPageToken :: ListExportsResponse -> Maybe Text
exports :: Maybe [Export]
nextPageToken :: Maybe Text
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"exports" Core..=) ([Export] -> Pair) -> Maybe [Export] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Export]
exports,
            (Key
"nextPageToken" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
nextPageToken
          ]
      )

-- | Returns a list of the accounts covered by a hold.
--
-- /See:/ 'newListHeldAccountsResponse' smart constructor.
newtype ListHeldAccountsResponse = ListHeldAccountsResponse
  { -- | The held accounts on a hold.
    ListHeldAccountsResponse -> Maybe [HeldAccount]
accounts :: (Core.Maybe [HeldAccount])
  }
  deriving (ListHeldAccountsResponse -> ListHeldAccountsResponse -> Bool
(ListHeldAccountsResponse -> ListHeldAccountsResponse -> Bool)
-> (ListHeldAccountsResponse -> ListHeldAccountsResponse -> Bool)
-> Eq ListHeldAccountsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListHeldAccountsResponse -> ListHeldAccountsResponse -> Bool
== :: ListHeldAccountsResponse -> ListHeldAccountsResponse -> Bool
$c/= :: ListHeldAccountsResponse -> ListHeldAccountsResponse -> Bool
/= :: ListHeldAccountsResponse -> ListHeldAccountsResponse -> Bool
Core.Eq, Int -> ListHeldAccountsResponse -> ShowS
[ListHeldAccountsResponse] -> ShowS
ListHeldAccountsResponse -> String
(Int -> ListHeldAccountsResponse -> ShowS)
-> (ListHeldAccountsResponse -> String)
-> ([ListHeldAccountsResponse] -> ShowS)
-> Show ListHeldAccountsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListHeldAccountsResponse -> ShowS
showsPrec :: Int -> ListHeldAccountsResponse -> ShowS
$cshow :: ListHeldAccountsResponse -> String
show :: ListHeldAccountsResponse -> String
$cshowList :: [ListHeldAccountsResponse] -> ShowS
showList :: [ListHeldAccountsResponse] -> ShowS
Core.Show, (forall x.
 ListHeldAccountsResponse -> Rep ListHeldAccountsResponse x)
-> (forall x.
    Rep ListHeldAccountsResponse x -> ListHeldAccountsResponse)
-> Generic ListHeldAccountsResponse
forall x.
Rep ListHeldAccountsResponse x -> ListHeldAccountsResponse
forall x.
ListHeldAccountsResponse -> Rep ListHeldAccountsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ListHeldAccountsResponse -> Rep ListHeldAccountsResponse x
from :: forall x.
ListHeldAccountsResponse -> Rep ListHeldAccountsResponse x
$cto :: forall x.
Rep ListHeldAccountsResponse x -> ListHeldAccountsResponse
to :: forall x.
Rep ListHeldAccountsResponse x -> ListHeldAccountsResponse
Core.Generic)

-- | Creates a value of 'ListHeldAccountsResponse' with the minimum fields required to make a request.
newListHeldAccountsResponse ::
  ListHeldAccountsResponse
newListHeldAccountsResponse :: ListHeldAccountsResponse
newListHeldAccountsResponse =
  ListHeldAccountsResponse {accounts :: Maybe [HeldAccount]
accounts = Maybe [HeldAccount]
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON ListHeldAccountsResponse where
  parseJSON :: Value -> Parser ListHeldAccountsResponse
parseJSON =
    String
-> (Object -> Parser ListHeldAccountsResponse)
-> Value
-> Parser ListHeldAccountsResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"ListHeldAccountsResponse"
      (\Object
o -> Maybe [HeldAccount] -> ListHeldAccountsResponse
ListHeldAccountsResponse (Maybe [HeldAccount] -> ListHeldAccountsResponse)
-> Parser (Maybe [HeldAccount]) -> Parser ListHeldAccountsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [HeldAccount])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"accounts"))

instance Core.ToJSON ListHeldAccountsResponse where
  toJSON :: ListHeldAccountsResponse -> Value
toJSON ListHeldAccountsResponse {Maybe [HeldAccount]
accounts :: ListHeldAccountsResponse -> Maybe [HeldAccount]
accounts :: Maybe [HeldAccount]
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"accounts" Core..=) ([HeldAccount] -> Pair) -> Maybe [HeldAccount] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [HeldAccount]
accounts])

-- | The holds for a matter.
--
-- /See:/ 'newListHoldsResponse' smart constructor.
data ListHoldsResponse = ListHoldsResponse
  { -- | The list of holds.
    ListHoldsResponse -> Maybe [Hold]
holds :: (Core.Maybe [Hold]),
    -- | Page token to retrieve the next page of results in the list. If this is empty, then there are no more holds to list.
    ListHoldsResponse -> Maybe Text
nextPageToken :: (Core.Maybe Core.Text)
  }
  deriving (ListHoldsResponse -> ListHoldsResponse -> Bool
(ListHoldsResponse -> ListHoldsResponse -> Bool)
-> (ListHoldsResponse -> ListHoldsResponse -> Bool)
-> Eq ListHoldsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListHoldsResponse -> ListHoldsResponse -> Bool
== :: ListHoldsResponse -> ListHoldsResponse -> Bool
$c/= :: ListHoldsResponse -> ListHoldsResponse -> Bool
/= :: ListHoldsResponse -> ListHoldsResponse -> Bool
Core.Eq, Int -> ListHoldsResponse -> ShowS
[ListHoldsResponse] -> ShowS
ListHoldsResponse -> String
(Int -> ListHoldsResponse -> ShowS)
-> (ListHoldsResponse -> String)
-> ([ListHoldsResponse] -> ShowS)
-> Show ListHoldsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListHoldsResponse -> ShowS
showsPrec :: Int -> ListHoldsResponse -> ShowS
$cshow :: ListHoldsResponse -> String
show :: ListHoldsResponse -> String
$cshowList :: [ListHoldsResponse] -> ShowS
showList :: [ListHoldsResponse] -> ShowS
Core.Show, (forall x. ListHoldsResponse -> Rep ListHoldsResponse x)
-> (forall x. Rep ListHoldsResponse x -> ListHoldsResponse)
-> Generic ListHoldsResponse
forall x. Rep ListHoldsResponse x -> ListHoldsResponse
forall x. ListHoldsResponse -> Rep ListHoldsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListHoldsResponse -> Rep ListHoldsResponse x
from :: forall x. ListHoldsResponse -> Rep ListHoldsResponse x
$cto :: forall x. Rep ListHoldsResponse x -> ListHoldsResponse
to :: forall x. Rep ListHoldsResponse x -> ListHoldsResponse
Core.Generic)

-- | Creates a value of 'ListHoldsResponse' with the minimum fields required to make a request.
newListHoldsResponse ::
  ListHoldsResponse
newListHoldsResponse :: ListHoldsResponse
newListHoldsResponse =
  ListHoldsResponse
    { holds :: Maybe [Hold]
holds = Maybe [Hold]
forall a. Maybe a
Core.Nothing,
      nextPageToken :: Maybe Text
nextPageToken = Maybe Text
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON ListHoldsResponse where
  parseJSON :: Value -> Parser ListHoldsResponse
parseJSON =
    String
-> (Object -> Parser ListHoldsResponse)
-> Value
-> Parser ListHoldsResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"ListHoldsResponse"
      ( \Object
o ->
          Maybe [Hold] -> Maybe Text -> ListHoldsResponse
ListHoldsResponse
            (Maybe [Hold] -> Maybe Text -> ListHoldsResponse)
-> Parser (Maybe [Hold])
-> Parser (Maybe Text -> ListHoldsResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [Hold])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"holds")
            Parser (Maybe Text -> ListHoldsResponse)
-> Parser (Maybe Text) -> Parser ListHoldsResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"nextPageToken")
      )

instance Core.ToJSON ListHoldsResponse where
  toJSON :: ListHoldsResponse -> Value
toJSON ListHoldsResponse {Maybe [Hold]
Maybe Text
holds :: ListHoldsResponse -> Maybe [Hold]
nextPageToken :: ListHoldsResponse -> Maybe Text
holds :: Maybe [Hold]
nextPageToken :: Maybe Text
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"holds" Core..=) ([Hold] -> Pair) -> Maybe [Hold] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Hold]
holds,
            (Key
"nextPageToken" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
nextPageToken
          ]
      )

-- | Provides the list of matters.
--
-- /See:/ 'newListMattersResponse' smart constructor.
data ListMattersResponse = ListMattersResponse
  { -- | List of matters.
    ListMattersResponse -> Maybe [Matter]
matters :: (Core.Maybe [Matter]),
    -- | Page token to retrieve the next page of results in the list.
    ListMattersResponse -> Maybe Text
nextPageToken :: (Core.Maybe Core.Text)
  }
  deriving (ListMattersResponse -> ListMattersResponse -> Bool
(ListMattersResponse -> ListMattersResponse -> Bool)
-> (ListMattersResponse -> ListMattersResponse -> Bool)
-> Eq ListMattersResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListMattersResponse -> ListMattersResponse -> Bool
== :: ListMattersResponse -> ListMattersResponse -> Bool
$c/= :: ListMattersResponse -> ListMattersResponse -> Bool
/= :: ListMattersResponse -> ListMattersResponse -> Bool
Core.Eq, Int -> ListMattersResponse -> ShowS
[ListMattersResponse] -> ShowS
ListMattersResponse -> String
(Int -> ListMattersResponse -> ShowS)
-> (ListMattersResponse -> String)
-> ([ListMattersResponse] -> ShowS)
-> Show ListMattersResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListMattersResponse -> ShowS
showsPrec :: Int -> ListMattersResponse -> ShowS
$cshow :: ListMattersResponse -> String
show :: ListMattersResponse -> String
$cshowList :: [ListMattersResponse] -> ShowS
showList :: [ListMattersResponse] -> ShowS
Core.Show, (forall x. ListMattersResponse -> Rep ListMattersResponse x)
-> (forall x. Rep ListMattersResponse x -> ListMattersResponse)
-> Generic ListMattersResponse
forall x. Rep ListMattersResponse x -> ListMattersResponse
forall x. ListMattersResponse -> Rep ListMattersResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListMattersResponse -> Rep ListMattersResponse x
from :: forall x. ListMattersResponse -> Rep ListMattersResponse x
$cto :: forall x. Rep ListMattersResponse x -> ListMattersResponse
to :: forall x. Rep ListMattersResponse x -> ListMattersResponse
Core.Generic)

-- | Creates a value of 'ListMattersResponse' with the minimum fields required to make a request.
newListMattersResponse ::
  ListMattersResponse
newListMattersResponse :: ListMattersResponse
newListMattersResponse =
  ListMattersResponse
    { matters :: Maybe [Matter]
matters = Maybe [Matter]
forall a. Maybe a
Core.Nothing,
      nextPageToken :: Maybe Text
nextPageToken = Maybe Text
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON ListMattersResponse where
  parseJSON :: Value -> Parser ListMattersResponse
parseJSON =
    String
-> (Object -> Parser ListMattersResponse)
-> Value
-> Parser ListMattersResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"ListMattersResponse"
      ( \Object
o ->
          Maybe [Matter] -> Maybe Text -> ListMattersResponse
ListMattersResponse
            (Maybe [Matter] -> Maybe Text -> ListMattersResponse)
-> Parser (Maybe [Matter])
-> Parser (Maybe Text -> ListMattersResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [Matter])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"matters")
            Parser (Maybe Text -> ListMattersResponse)
-> Parser (Maybe Text) -> Parser ListMattersResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"nextPageToken")
      )

instance Core.ToJSON ListMattersResponse where
  toJSON :: ListMattersResponse -> Value
toJSON ListMattersResponse {Maybe [Matter]
Maybe Text
matters :: ListMattersResponse -> Maybe [Matter]
nextPageToken :: ListMattersResponse -> Maybe Text
matters :: Maybe [Matter]
nextPageToken :: Maybe Text
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"matters" Core..=) ([Matter] -> Pair) -> Maybe [Matter] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Matter]
matters,
            (Key
"nextPageToken" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
nextPageToken
          ]
      )

-- | The response message for Operations.ListOperations.
--
-- /See:/ 'newListOperationsResponse' smart constructor.
data ListOperationsResponse = ListOperationsResponse
  { -- | The standard List next-page token.
    ListOperationsResponse -> Maybe Text
nextPageToken :: (Core.Maybe Core.Text),
    -- | A list of operations that matches the specified filter in the request.
    ListOperationsResponse -> Maybe [Operation]
operations :: (Core.Maybe [Operation])
  }
  deriving (ListOperationsResponse -> ListOperationsResponse -> Bool
(ListOperationsResponse -> ListOperationsResponse -> Bool)
-> (ListOperationsResponse -> ListOperationsResponse -> Bool)
-> Eq ListOperationsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListOperationsResponse -> ListOperationsResponse -> Bool
== :: ListOperationsResponse -> ListOperationsResponse -> Bool
$c/= :: ListOperationsResponse -> ListOperationsResponse -> Bool
/= :: ListOperationsResponse -> ListOperationsResponse -> Bool
Core.Eq, Int -> ListOperationsResponse -> ShowS
[ListOperationsResponse] -> ShowS
ListOperationsResponse -> String
(Int -> ListOperationsResponse -> ShowS)
-> (ListOperationsResponse -> String)
-> ([ListOperationsResponse] -> ShowS)
-> Show ListOperationsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListOperationsResponse -> ShowS
showsPrec :: Int -> ListOperationsResponse -> ShowS
$cshow :: ListOperationsResponse -> String
show :: ListOperationsResponse -> String
$cshowList :: [ListOperationsResponse] -> ShowS
showList :: [ListOperationsResponse] -> ShowS
Core.Show, (forall x. ListOperationsResponse -> Rep ListOperationsResponse x)
-> (forall x.
    Rep ListOperationsResponse x -> ListOperationsResponse)
-> Generic ListOperationsResponse
forall x. Rep ListOperationsResponse x -> ListOperationsResponse
forall x. ListOperationsResponse -> Rep ListOperationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListOperationsResponse -> Rep ListOperationsResponse x
from :: forall x. ListOperationsResponse -> Rep ListOperationsResponse x
$cto :: forall x. Rep ListOperationsResponse x -> ListOperationsResponse
to :: forall x. Rep ListOperationsResponse x -> ListOperationsResponse
Core.Generic)

-- | Creates a value of 'ListOperationsResponse' with the minimum fields required to make a request.
newListOperationsResponse ::
  ListOperationsResponse
newListOperationsResponse :: ListOperationsResponse
newListOperationsResponse =
  ListOperationsResponse
    { nextPageToken :: Maybe Text
nextPageToken = Maybe Text
forall a. Maybe a
Core.Nothing,
      operations :: Maybe [Operation]
operations = Maybe [Operation]
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON ListOperationsResponse where
  parseJSON :: Value -> Parser ListOperationsResponse
parseJSON =
    String
-> (Object -> Parser ListOperationsResponse)
-> Value
-> Parser ListOperationsResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"ListOperationsResponse"
      ( \Object
o ->
          Maybe Text -> Maybe [Operation] -> ListOperationsResponse
ListOperationsResponse
            (Maybe Text -> Maybe [Operation] -> ListOperationsResponse)
-> Parser (Maybe Text)
-> Parser (Maybe [Operation] -> ListOperationsResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"nextPageToken")
            Parser (Maybe [Operation] -> ListOperationsResponse)
-> Parser (Maybe [Operation]) -> Parser ListOperationsResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe [Operation])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"operations")
      )

instance Core.ToJSON ListOperationsResponse where
  toJSON :: ListOperationsResponse -> Value
toJSON ListOperationsResponse {Maybe [Operation]
Maybe Text
nextPageToken :: ListOperationsResponse -> Maybe Text
operations :: ListOperationsResponse -> Maybe [Operation]
nextPageToken :: Maybe Text
operations :: Maybe [Operation]
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"nextPageToken" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
nextPageToken,
            (Key
"operations" Core..=) ([Operation] -> Pair) -> Maybe [Operation] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Operation]
operations
          ]
      )

-- | Definition of the response for method ListSaveQuery.
--
-- /See:/ 'newListSavedQueriesResponse' smart constructor.
data ListSavedQueriesResponse = ListSavedQueriesResponse
  { -- | Page token to retrieve the next page of results in the list. If this is empty, then there are no more saved queries to list.
    ListSavedQueriesResponse -> Maybe Text
nextPageToken :: (Core.Maybe Core.Text),
    -- | List of saved queries.
    ListSavedQueriesResponse -> Maybe [SavedQuery]
savedQueries :: (Core.Maybe [SavedQuery])
  }
  deriving (ListSavedQueriesResponse -> ListSavedQueriesResponse -> Bool
(ListSavedQueriesResponse -> ListSavedQueriesResponse -> Bool)
-> (ListSavedQueriesResponse -> ListSavedQueriesResponse -> Bool)
-> Eq ListSavedQueriesResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListSavedQueriesResponse -> ListSavedQueriesResponse -> Bool
== :: ListSavedQueriesResponse -> ListSavedQueriesResponse -> Bool
$c/= :: ListSavedQueriesResponse -> ListSavedQueriesResponse -> Bool
/= :: ListSavedQueriesResponse -> ListSavedQueriesResponse -> Bool
Core.Eq, Int -> ListSavedQueriesResponse -> ShowS
[ListSavedQueriesResponse] -> ShowS
ListSavedQueriesResponse -> String
(Int -> ListSavedQueriesResponse -> ShowS)
-> (ListSavedQueriesResponse -> String)
-> ([ListSavedQueriesResponse] -> ShowS)
-> Show ListSavedQueriesResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListSavedQueriesResponse -> ShowS
showsPrec :: Int -> ListSavedQueriesResponse -> ShowS
$cshow :: ListSavedQueriesResponse -> String
show :: ListSavedQueriesResponse -> String
$cshowList :: [ListSavedQueriesResponse] -> ShowS
showList :: [ListSavedQueriesResponse] -> ShowS
Core.Show, (forall x.
 ListSavedQueriesResponse -> Rep ListSavedQueriesResponse x)
-> (forall x.
    Rep ListSavedQueriesResponse x -> ListSavedQueriesResponse)
-> Generic ListSavedQueriesResponse
forall x.
Rep ListSavedQueriesResponse x -> ListSavedQueriesResponse
forall x.
ListSavedQueriesResponse -> Rep ListSavedQueriesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ListSavedQueriesResponse -> Rep ListSavedQueriesResponse x
from :: forall x.
ListSavedQueriesResponse -> Rep ListSavedQueriesResponse x
$cto :: forall x.
Rep ListSavedQueriesResponse x -> ListSavedQueriesResponse
to :: forall x.
Rep ListSavedQueriesResponse x -> ListSavedQueriesResponse
Core.Generic)

-- | Creates a value of 'ListSavedQueriesResponse' with the minimum fields required to make a request.
newListSavedQueriesResponse ::
  ListSavedQueriesResponse
newListSavedQueriesResponse :: ListSavedQueriesResponse
newListSavedQueriesResponse =
  ListSavedQueriesResponse
    { nextPageToken :: Maybe Text
nextPageToken = Maybe Text
forall a. Maybe a
Core.Nothing,
      savedQueries :: Maybe [SavedQuery]
savedQueries = Maybe [SavedQuery]
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON ListSavedQueriesResponse where
  parseJSON :: Value -> Parser ListSavedQueriesResponse
parseJSON =
    String
-> (Object -> Parser ListSavedQueriesResponse)
-> Value
-> Parser ListSavedQueriesResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"ListSavedQueriesResponse"
      ( \Object
o ->
          Maybe Text -> Maybe [SavedQuery] -> ListSavedQueriesResponse
ListSavedQueriesResponse
            (Maybe Text -> Maybe [SavedQuery] -> ListSavedQueriesResponse)
-> Parser (Maybe Text)
-> Parser (Maybe [SavedQuery] -> ListSavedQueriesResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"nextPageToken")
            Parser (Maybe [SavedQuery] -> ListSavedQueriesResponse)
-> Parser (Maybe [SavedQuery]) -> Parser ListSavedQueriesResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe [SavedQuery])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"savedQueries")
      )

instance Core.ToJSON ListSavedQueriesResponse where
  toJSON :: ListSavedQueriesResponse -> Value
toJSON ListSavedQueriesResponse {Maybe [SavedQuery]
Maybe Text
nextPageToken :: ListSavedQueriesResponse -> Maybe Text
savedQueries :: ListSavedQueriesResponse -> Maybe [SavedQuery]
nextPageToken :: Maybe Text
savedQueries :: Maybe [SavedQuery]
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"nextPageToken" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
nextPageToken,
            (Key
"savedQueries" Core..=) ([SavedQuery] -> Pair) -> Maybe [SavedQuery] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [SavedQuery]
savedQueries
          ]
      )

-- | Gmail and classic Hangouts-specific count metrics.
--
-- /See:/ 'newMailCountResult' smart constructor.
data MailCountResult = MailCountResult
  { -- | Errors occurred when querying these accounts.
    MailCountResult -> Maybe [AccountCountError]
accountCountErrors :: (Core.Maybe [AccountCountError]),
    -- | Subtotal count per matching account that have more than zero messages.
    MailCountResult -> Maybe [AccountCount]
accountCounts :: (Core.Maybe [AccountCount]),
    -- | Total number of accounts that can be queried and have more than zero messages.
    MailCountResult -> Maybe Int64
matchingAccountsCount :: (Core.Maybe Core.Int64),
    -- | When __DataScope__ is **HELD_DATA** and when account emails are passed in explicitly, the list of accounts in the request that are not queried because they are not on hold in the matter. For other data scopes, this field is not set.
    MailCountResult -> Maybe [Text]
nonQueryableAccounts :: (Core.Maybe [Core.Text]),
    -- | Total number of accounts involved in this count operation.
    MailCountResult -> Maybe Int64
queriedAccountsCount :: (Core.Maybe Core.Int64)
  }
  deriving (MailCountResult -> MailCountResult -> Bool
(MailCountResult -> MailCountResult -> Bool)
-> (MailCountResult -> MailCountResult -> Bool)
-> Eq MailCountResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MailCountResult -> MailCountResult -> Bool
== :: MailCountResult -> MailCountResult -> Bool
$c/= :: MailCountResult -> MailCountResult -> Bool
/= :: MailCountResult -> MailCountResult -> Bool
Core.Eq, Int -> MailCountResult -> ShowS
[MailCountResult] -> ShowS
MailCountResult -> String
(Int -> MailCountResult -> ShowS)
-> (MailCountResult -> String)
-> ([MailCountResult] -> ShowS)
-> Show MailCountResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MailCountResult -> ShowS
showsPrec :: Int -> MailCountResult -> ShowS
$cshow :: MailCountResult -> String
show :: MailCountResult -> String
$cshowList :: [MailCountResult] -> ShowS
showList :: [MailCountResult] -> ShowS
Core.Show, (forall x. MailCountResult -> Rep MailCountResult x)
-> (forall x. Rep MailCountResult x -> MailCountResult)
-> Generic MailCountResult
forall x. Rep MailCountResult x -> MailCountResult
forall x. MailCountResult -> Rep MailCountResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MailCountResult -> Rep MailCountResult x
from :: forall x. MailCountResult -> Rep MailCountResult x
$cto :: forall x. Rep MailCountResult x -> MailCountResult
to :: forall x. Rep MailCountResult x -> MailCountResult
Core.Generic)

-- | Creates a value of 'MailCountResult' with the minimum fields required to make a request.
newMailCountResult ::
  MailCountResult
newMailCountResult :: MailCountResult
newMailCountResult =
  MailCountResult
    { accountCountErrors :: Maybe [AccountCountError]
accountCountErrors = Maybe [AccountCountError]
forall a. Maybe a
Core.Nothing,
      accountCounts :: Maybe [AccountCount]
accountCounts = Maybe [AccountCount]
forall a. Maybe a
Core.Nothing,
      matchingAccountsCount :: Maybe Int64
matchingAccountsCount = Maybe Int64
forall a. Maybe a
Core.Nothing,
      nonQueryableAccounts :: Maybe [Text]
nonQueryableAccounts = Maybe [Text]
forall a. Maybe a
Core.Nothing,
      queriedAccountsCount :: Maybe Int64
queriedAccountsCount = Maybe Int64
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON MailCountResult where
  parseJSON :: Value -> Parser MailCountResult
parseJSON =
    String
-> (Object -> Parser MailCountResult)
-> Value
-> Parser MailCountResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"MailCountResult"
      ( \Object
o ->
          Maybe [AccountCountError]
-> Maybe [AccountCount]
-> Maybe Int64
-> Maybe [Text]
-> Maybe Int64
-> MailCountResult
MailCountResult
            (Maybe [AccountCountError]
 -> Maybe [AccountCount]
 -> Maybe Int64
 -> Maybe [Text]
 -> Maybe Int64
 -> MailCountResult)
-> Parser (Maybe [AccountCountError])
-> Parser
     (Maybe [AccountCount]
      -> Maybe Int64 -> Maybe [Text] -> Maybe Int64 -> MailCountResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [AccountCountError])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"accountCountErrors")
            Parser
  (Maybe [AccountCount]
   -> Maybe Int64 -> Maybe [Text] -> Maybe Int64 -> MailCountResult)
-> Parser (Maybe [AccountCount])
-> Parser
     (Maybe Int64 -> Maybe [Text] -> Maybe Int64 -> MailCountResult)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe [AccountCount])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"accountCounts")
            Parser
  (Maybe Int64 -> Maybe [Text] -> Maybe Int64 -> MailCountResult)
-> Parser (Maybe Int64)
-> Parser (Maybe [Text] -> Maybe Int64 -> MailCountResult)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> ( Object
o
                         Object -> Key -> Parser (Maybe (AsText Int64))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"matchingAccountsCount"
                         Parser (Maybe (AsText Int64))
-> (Maybe (AsText Int64) -> Maybe Int64) -> Parser (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Core.<&> (AsText Int64 -> Int64) -> Maybe (AsText Int64) -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.fmap AsText Int64 -> Int64
forall a. AsText a -> a
Core.fromAsText
                     )
            Parser (Maybe [Text] -> Maybe Int64 -> MailCountResult)
-> Parser (Maybe [Text]) -> Parser (Maybe Int64 -> MailCountResult)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"nonQueryableAccounts")
            Parser (Maybe Int64 -> MailCountResult)
-> Parser (Maybe Int64) -> Parser MailCountResult
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> ( Object
o
                         Object -> Key -> Parser (Maybe (AsText Int64))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"queriedAccountsCount"
                         Parser (Maybe (AsText Int64))
-> (Maybe (AsText Int64) -> Maybe Int64) -> Parser (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Core.<&> (AsText Int64 -> Int64) -> Maybe (AsText Int64) -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.fmap AsText Int64 -> Int64
forall a. AsText a -> a
Core.fromAsText
                     )
      )

instance Core.ToJSON MailCountResult where
  toJSON :: MailCountResult -> Value
toJSON MailCountResult {Maybe Int64
Maybe [Text]
Maybe [AccountCountError]
Maybe [AccountCount]
accountCountErrors :: MailCountResult -> Maybe [AccountCountError]
accountCounts :: MailCountResult -> Maybe [AccountCount]
matchingAccountsCount :: MailCountResult -> Maybe Int64
nonQueryableAccounts :: MailCountResult -> Maybe [Text]
queriedAccountsCount :: MailCountResult -> Maybe Int64
accountCountErrors :: Maybe [AccountCountError]
accountCounts :: Maybe [AccountCount]
matchingAccountsCount :: Maybe Int64
nonQueryableAccounts :: Maybe [Text]
queriedAccountsCount :: Maybe Int64
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"accountCountErrors" Core..=) ([AccountCountError] -> Pair)
-> Maybe [AccountCountError] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [AccountCountError]
accountCountErrors,
            (Key
"accountCounts" Core..=) ([AccountCount] -> Pair) -> Maybe [AccountCount] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [AccountCount]
accountCounts,
            (Key
"matchingAccountsCount" Core..=)
              (AsText Int64 -> Pair) -> (Int64 -> AsText Int64) -> Int64 -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
Core.. Int64 -> AsText Int64
forall a. a -> AsText a
Core.AsText
              (Int64 -> Pair) -> Maybe Int64 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int64
matchingAccountsCount,
            (Key
"nonQueryableAccounts" Core..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Text]
nonQueryableAccounts,
            (Key
"queriedAccountsCount" Core..=)
              (AsText Int64 -> Pair) -> (Int64 -> AsText Int64) -> Int64 -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
Core.. Int64 -> AsText Int64
forall a. a -> AsText a
Core.AsText
              (Int64 -> Pair) -> Maybe Int64 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int64
queriedAccountsCount
          ]
      )

-- | Options for Gmail exports.
--
-- /See:/ 'newMailExportOptions' smart constructor.
data MailExportOptions = MailExportOptions
  { -- | The file format for exported messages.
    MailExportOptions -> Maybe MailExportOptions_ExportFormat
exportFormat :: (Core.Maybe MailExportOptions_ExportFormat),
    -- | Optional. To enable exporting linked Drive files, set to __true__.
    MailExportOptions -> Maybe Bool
exportLinkedDriveFiles :: (Core.Maybe Core.Bool),
    -- | To export confidential mode content, set to __true__.
    MailExportOptions -> Maybe Bool
showConfidentialModeContent :: (Core.Maybe Core.Bool),
    -- | To use the new export system, set to __true__.
    MailExportOptions -> Maybe Bool
useNewExport :: (Core.Maybe Core.Bool)
  }
  deriving (MailExportOptions -> MailExportOptions -> Bool
(MailExportOptions -> MailExportOptions -> Bool)
-> (MailExportOptions -> MailExportOptions -> Bool)
-> Eq MailExportOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MailExportOptions -> MailExportOptions -> Bool
== :: MailExportOptions -> MailExportOptions -> Bool
$c/= :: MailExportOptions -> MailExportOptions -> Bool
/= :: MailExportOptions -> MailExportOptions -> Bool
Core.Eq, Int -> MailExportOptions -> ShowS
[MailExportOptions] -> ShowS
MailExportOptions -> String
(Int -> MailExportOptions -> ShowS)
-> (MailExportOptions -> String)
-> ([MailExportOptions] -> ShowS)
-> Show MailExportOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MailExportOptions -> ShowS
showsPrec :: Int -> MailExportOptions -> ShowS
$cshow :: MailExportOptions -> String
show :: MailExportOptions -> String
$cshowList :: [MailExportOptions] -> ShowS
showList :: [MailExportOptions] -> ShowS
Core.Show, (forall x. MailExportOptions -> Rep MailExportOptions x)
-> (forall x. Rep MailExportOptions x -> MailExportOptions)
-> Generic MailExportOptions
forall x. Rep MailExportOptions x -> MailExportOptions
forall x. MailExportOptions -> Rep MailExportOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MailExportOptions -> Rep MailExportOptions x
from :: forall x. MailExportOptions -> Rep MailExportOptions x
$cto :: forall x. Rep MailExportOptions x -> MailExportOptions
to :: forall x. Rep MailExportOptions x -> MailExportOptions
Core.Generic)

-- | Creates a value of 'MailExportOptions' with the minimum fields required to make a request.
newMailExportOptions ::
  MailExportOptions
newMailExportOptions :: MailExportOptions
newMailExportOptions =
  MailExportOptions
    { exportFormat :: Maybe MailExportOptions_ExportFormat
exportFormat = Maybe MailExportOptions_ExportFormat
forall a. Maybe a
Core.Nothing,
      exportLinkedDriveFiles :: Maybe Bool
exportLinkedDriveFiles = Maybe Bool
forall a. Maybe a
Core.Nothing,
      showConfidentialModeContent :: Maybe Bool
showConfidentialModeContent = Maybe Bool
forall a. Maybe a
Core.Nothing,
      useNewExport :: Maybe Bool
useNewExport = Maybe Bool
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON MailExportOptions where
  parseJSON :: Value -> Parser MailExportOptions
parseJSON =
    String
-> (Object -> Parser MailExportOptions)
-> Value
-> Parser MailExportOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"MailExportOptions"
      ( \Object
o ->
          Maybe MailExportOptions_ExportFormat
-> Maybe Bool -> Maybe Bool -> Maybe Bool -> MailExportOptions
MailExportOptions
            (Maybe MailExportOptions_ExportFormat
 -> Maybe Bool -> Maybe Bool -> Maybe Bool -> MailExportOptions)
-> Parser (Maybe MailExportOptions_ExportFormat)
-> Parser
     (Maybe Bool -> Maybe Bool -> Maybe Bool -> MailExportOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe MailExportOptions_ExportFormat)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"exportFormat")
            Parser
  (Maybe Bool -> Maybe Bool -> Maybe Bool -> MailExportOptions)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> Maybe Bool -> MailExportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"exportLinkedDriveFiles")
            Parser (Maybe Bool -> Maybe Bool -> MailExportOptions)
-> Parser (Maybe Bool) -> Parser (Maybe Bool -> MailExportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"showConfidentialModeContent")
            Parser (Maybe Bool -> MailExportOptions)
-> Parser (Maybe Bool) -> Parser MailExportOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"useNewExport")
      )

instance Core.ToJSON MailExportOptions where
  toJSON :: MailExportOptions -> Value
toJSON MailExportOptions {Maybe Bool
Maybe MailExportOptions_ExportFormat
exportFormat :: MailExportOptions -> Maybe MailExportOptions_ExportFormat
exportLinkedDriveFiles :: MailExportOptions -> Maybe Bool
showConfidentialModeContent :: MailExportOptions -> Maybe Bool
useNewExport :: MailExportOptions -> Maybe Bool
exportFormat :: Maybe MailExportOptions_ExportFormat
exportLinkedDriveFiles :: Maybe Bool
showConfidentialModeContent :: Maybe Bool
useNewExport :: Maybe Bool
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"exportFormat" Core..=) (MailExportOptions_ExportFormat -> Pair)
-> Maybe MailExportOptions_ExportFormat -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe MailExportOptions_ExportFormat
exportFormat,
            (Key
"exportLinkedDriveFiles" Core..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Bool
exportLinkedDriveFiles,
            (Key
"showConfidentialModeContent" Core..=)
              (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Bool
showConfidentialModeContent,
            (Key
"useNewExport" Core..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Bool
useNewExport
          ]
      )

-- | Additional options for Gmail search
--
-- /See:/ 'newMailOptions' smart constructor.
data MailOptions = MailOptions
  { -- | Specifies whether the results should include encrypted content, unencrypted content, or both. Defaults to including both.
    MailOptions -> Maybe MailOptions_ClientSideEncryptedOption
clientSideEncryptedOption :: (Core.Maybe MailOptions_ClientSideEncryptedOption),
    -- | Set to __true__ to exclude drafts.
    MailOptions -> Maybe Bool
excludeDrafts :: (Core.Maybe Core.Bool)
  }
  deriving (MailOptions -> MailOptions -> Bool
(MailOptions -> MailOptions -> Bool)
-> (MailOptions -> MailOptions -> Bool) -> Eq MailOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MailOptions -> MailOptions -> Bool
== :: MailOptions -> MailOptions -> Bool
$c/= :: MailOptions -> MailOptions -> Bool
/= :: MailOptions -> MailOptions -> Bool
Core.Eq, Int -> MailOptions -> ShowS
[MailOptions] -> ShowS
MailOptions -> String
(Int -> MailOptions -> ShowS)
-> (MailOptions -> String)
-> ([MailOptions] -> ShowS)
-> Show MailOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MailOptions -> ShowS
showsPrec :: Int -> MailOptions -> ShowS
$cshow :: MailOptions -> String
show :: MailOptions -> String
$cshowList :: [MailOptions] -> ShowS
showList :: [MailOptions] -> ShowS
Core.Show, (forall x. MailOptions -> Rep MailOptions x)
-> (forall x. Rep MailOptions x -> MailOptions)
-> Generic MailOptions
forall x. Rep MailOptions x -> MailOptions
forall x. MailOptions -> Rep MailOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MailOptions -> Rep MailOptions x
from :: forall x. MailOptions -> Rep MailOptions x
$cto :: forall x. Rep MailOptions x -> MailOptions
to :: forall x. Rep MailOptions x -> MailOptions
Core.Generic)

-- | Creates a value of 'MailOptions' with the minimum fields required to make a request.
newMailOptions ::
  MailOptions
newMailOptions :: MailOptions
newMailOptions =
  MailOptions
    { clientSideEncryptedOption :: Maybe MailOptions_ClientSideEncryptedOption
clientSideEncryptedOption = Maybe MailOptions_ClientSideEncryptedOption
forall a. Maybe a
Core.Nothing,
      excludeDrafts :: Maybe Bool
excludeDrafts = Maybe Bool
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON MailOptions where
  parseJSON :: Value -> Parser MailOptions
parseJSON =
    String
-> (Object -> Parser MailOptions) -> Value -> Parser MailOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"MailOptions"
      ( \Object
o ->
          Maybe MailOptions_ClientSideEncryptedOption
-> Maybe Bool -> MailOptions
MailOptions
            (Maybe MailOptions_ClientSideEncryptedOption
 -> Maybe Bool -> MailOptions)
-> Parser (Maybe MailOptions_ClientSideEncryptedOption)
-> Parser (Maybe Bool -> MailOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object
-> Key -> Parser (Maybe MailOptions_ClientSideEncryptedOption)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"clientSideEncryptedOption")
            Parser (Maybe Bool -> MailOptions)
-> Parser (Maybe Bool) -> Parser MailOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"excludeDrafts")
      )

instance Core.ToJSON MailOptions where
  toJSON :: MailOptions -> Value
toJSON MailOptions {Maybe Bool
Maybe MailOptions_ClientSideEncryptedOption
clientSideEncryptedOption :: MailOptions -> Maybe MailOptions_ClientSideEncryptedOption
excludeDrafts :: MailOptions -> Maybe Bool
clientSideEncryptedOption :: Maybe MailOptions_ClientSideEncryptedOption
excludeDrafts :: Maybe Bool
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"clientSideEncryptedOption" Core..=)
              (MailOptions_ClientSideEncryptedOption -> Pair)
-> Maybe MailOptions_ClientSideEncryptedOption -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe MailOptions_ClientSideEncryptedOption
clientSideEncryptedOption,
            (Key
"excludeDrafts" Core..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Bool
excludeDrafts
          ]
      )

-- | Represents a matter. To work with Vault resources, the account must have the [required Vault privileges] (https:\/\/support.google.com\/vault\/answer\/2799699) and access to the matter. To access a matter, the account must have created the matter, have the matter shared with them, or have the __View All Matters__ privilege.
--
-- /See:/ 'newMatter' smart constructor.
data Matter = Matter
  { -- | An optional description for the matter.
    Matter -> Maybe Text
description :: (Core.Maybe Core.Text),
    -- | The matter ID, which is generated by the server. Leave blank when creating a matter.
    Matter -> Maybe Text
matterId :: (Core.Maybe Core.Text),
    -- | Lists the users and their permission for the matter. Currently there is no programmer defined limit on the number of permissions a matter can have.
    Matter -> Maybe [MatterPermission]
matterPermissions :: (Core.Maybe [MatterPermission]),
    -- | Optional. The requested data region for the matter.
    Matter -> Maybe Matter_MatterRegion
matterRegion :: (Core.Maybe Matter_MatterRegion),
    -- | The name of the matter.
    Matter -> Maybe Text
name :: (Core.Maybe Core.Text),
    -- | The state of the matter.
    Matter -> Maybe Matter_State
state :: (Core.Maybe Matter_State)
  }
  deriving (Matter -> Matter -> Bool
(Matter -> Matter -> Bool)
-> (Matter -> Matter -> Bool) -> Eq Matter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Matter -> Matter -> Bool
== :: Matter -> Matter -> Bool
$c/= :: Matter -> Matter -> Bool
/= :: Matter -> Matter -> Bool
Core.Eq, Int -> Matter -> ShowS
[Matter] -> ShowS
Matter -> String
(Int -> Matter -> ShowS)
-> (Matter -> String) -> ([Matter] -> ShowS) -> Show Matter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Matter -> ShowS
showsPrec :: Int -> Matter -> ShowS
$cshow :: Matter -> String
show :: Matter -> String
$cshowList :: [Matter] -> ShowS
showList :: [Matter] -> ShowS
Core.Show, (forall x. Matter -> Rep Matter x)
-> (forall x. Rep Matter x -> Matter) -> Generic Matter
forall x. Rep Matter x -> Matter
forall x. Matter -> Rep Matter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Matter -> Rep Matter x
from :: forall x. Matter -> Rep Matter x
$cto :: forall x. Rep Matter x -> Matter
to :: forall x. Rep Matter x -> Matter
Core.Generic)

-- | Creates a value of 'Matter' with the minimum fields required to make a request.
newMatter ::
  Matter
newMatter :: Matter
newMatter =
  Matter
    { description :: Maybe Text
description = Maybe Text
forall a. Maybe a
Core.Nothing,
      matterId :: Maybe Text
matterId = Maybe Text
forall a. Maybe a
Core.Nothing,
      matterPermissions :: Maybe [MatterPermission]
matterPermissions = Maybe [MatterPermission]
forall a. Maybe a
Core.Nothing,
      matterRegion :: Maybe Matter_MatterRegion
matterRegion = Maybe Matter_MatterRegion
forall a. Maybe a
Core.Nothing,
      name :: Maybe Text
name = Maybe Text
forall a. Maybe a
Core.Nothing,
      state :: Maybe Matter_State
state = Maybe Matter_State
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON Matter where
  parseJSON :: Value -> Parser Matter
parseJSON =
    String -> (Object -> Parser Matter) -> Value -> Parser Matter
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"Matter"
      ( \Object
o ->
          Maybe Text
-> Maybe Text
-> Maybe [MatterPermission]
-> Maybe Matter_MatterRegion
-> Maybe Text
-> Maybe Matter_State
-> Matter
Matter
            (Maybe Text
 -> Maybe Text
 -> Maybe [MatterPermission]
 -> Maybe Matter_MatterRegion
 -> Maybe Text
 -> Maybe Matter_State
 -> Matter)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe [MatterPermission]
      -> Maybe Matter_MatterRegion
      -> Maybe Text
      -> Maybe Matter_State
      -> Matter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"description")
            Parser
  (Maybe Text
   -> Maybe [MatterPermission]
   -> Maybe Matter_MatterRegion
   -> Maybe Text
   -> Maybe Matter_State
   -> Matter)
-> Parser (Maybe Text)
-> Parser
     (Maybe [MatterPermission]
      -> Maybe Matter_MatterRegion
      -> Maybe Text
      -> Maybe Matter_State
      -> Matter)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"matterId")
            Parser
  (Maybe [MatterPermission]
   -> Maybe Matter_MatterRegion
   -> Maybe Text
   -> Maybe Matter_State
   -> Matter)
-> Parser (Maybe [MatterPermission])
-> Parser
     (Maybe Matter_MatterRegion
      -> Maybe Text -> Maybe Matter_State -> Matter)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe [MatterPermission])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"matterPermissions")
            Parser
  (Maybe Matter_MatterRegion
   -> Maybe Text -> Maybe Matter_State -> Matter)
-> Parser (Maybe Matter_MatterRegion)
-> Parser (Maybe Text -> Maybe Matter_State -> Matter)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Matter_MatterRegion)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"matterRegion")
            Parser (Maybe Text -> Maybe Matter_State -> Matter)
-> Parser (Maybe Text) -> Parser (Maybe Matter_State -> Matter)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"name")
            Parser (Maybe Matter_State -> Matter)
-> Parser (Maybe Matter_State) -> Parser Matter
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Matter_State)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"state")
      )

instance Core.ToJSON Matter where
  toJSON :: Matter -> Value
toJSON Matter {Maybe [MatterPermission]
Maybe Text
Maybe Matter_State
Maybe Matter_MatterRegion
description :: Matter -> Maybe Text
matterId :: Matter -> Maybe Text
matterPermissions :: Matter -> Maybe [MatterPermission]
matterRegion :: Matter -> Maybe Matter_MatterRegion
name :: Matter -> Maybe Text
state :: Matter -> Maybe Matter_State
description :: Maybe Text
matterId :: Maybe Text
matterPermissions :: Maybe [MatterPermission]
matterRegion :: Maybe Matter_MatterRegion
name :: Maybe Text
state :: Maybe Matter_State
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"description" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
description,
            (Key
"matterId" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
matterId,
            (Key
"matterPermissions" Core..=) ([MatterPermission] -> Pair)
-> Maybe [MatterPermission] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [MatterPermission]
matterPermissions,
            (Key
"matterRegion" Core..=) (Matter_MatterRegion -> Pair)
-> Maybe Matter_MatterRegion -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Matter_MatterRegion
matterRegion,
            (Key
"name" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
name,
            (Key
"state" Core..=) (Matter_State -> Pair) -> Maybe Matter_State -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Matter_State
state
          ]
      )

-- | Users can be matter owners or collaborators. Each matter has only one owner. All others users who can access the matter are collaborators. When an account is purged, its corresponding MatterPermission resources cease to exist.
--
-- /See:/ 'newMatterPermission' smart constructor.
data MatterPermission = MatterPermission
  { -- | The account ID, as provided by the <https://developers.google.com/admin-sdk/ Admin SDK>.
    MatterPermission -> Maybe Text
accountId :: (Core.Maybe Core.Text),
    -- | The user\'s role for the matter.
    MatterPermission -> Maybe MatterPermission_Role
role' :: (Core.Maybe MatterPermission_Role)
  }
  deriving (MatterPermission -> MatterPermission -> Bool
(MatterPermission -> MatterPermission -> Bool)
-> (MatterPermission -> MatterPermission -> Bool)
-> Eq MatterPermission
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MatterPermission -> MatterPermission -> Bool
== :: MatterPermission -> MatterPermission -> Bool
$c/= :: MatterPermission -> MatterPermission -> Bool
/= :: MatterPermission -> MatterPermission -> Bool
Core.Eq, Int -> MatterPermission -> ShowS
[MatterPermission] -> ShowS
MatterPermission -> String
(Int -> MatterPermission -> ShowS)
-> (MatterPermission -> String)
-> ([MatterPermission] -> ShowS)
-> Show MatterPermission
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatterPermission -> ShowS
showsPrec :: Int -> MatterPermission -> ShowS
$cshow :: MatterPermission -> String
show :: MatterPermission -> String
$cshowList :: [MatterPermission] -> ShowS
showList :: [MatterPermission] -> ShowS
Core.Show, (forall x. MatterPermission -> Rep MatterPermission x)
-> (forall x. Rep MatterPermission x -> MatterPermission)
-> Generic MatterPermission
forall x. Rep MatterPermission x -> MatterPermission
forall x. MatterPermission -> Rep MatterPermission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MatterPermission -> Rep MatterPermission x
from :: forall x. MatterPermission -> Rep MatterPermission x
$cto :: forall x. Rep MatterPermission x -> MatterPermission
to :: forall x. Rep MatterPermission x -> MatterPermission
Core.Generic)

-- | Creates a value of 'MatterPermission' with the minimum fields required to make a request.
newMatterPermission ::
  MatterPermission
newMatterPermission :: MatterPermission
newMatterPermission =
  MatterPermission {accountId :: Maybe Text
accountId = Maybe Text
forall a. Maybe a
Core.Nothing, role' :: Maybe MatterPermission_Role
role' = Maybe MatterPermission_Role
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON MatterPermission where
  parseJSON :: Value -> Parser MatterPermission
parseJSON =
    String
-> (Object -> Parser MatterPermission)
-> Value
-> Parser MatterPermission
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"MatterPermission"
      ( \Object
o ->
          Maybe Text -> Maybe MatterPermission_Role -> MatterPermission
MatterPermission
            (Maybe Text -> Maybe MatterPermission_Role -> MatterPermission)
-> Parser (Maybe Text)
-> Parser (Maybe MatterPermission_Role -> MatterPermission)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"accountId")
            Parser (Maybe MatterPermission_Role -> MatterPermission)
-> Parser (Maybe MatterPermission_Role) -> Parser MatterPermission
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe MatterPermission_Role)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"role")
      )

instance Core.ToJSON MatterPermission where
  toJSON :: MatterPermission -> Value
toJSON MatterPermission {Maybe Text
Maybe MatterPermission_Role
accountId :: MatterPermission -> Maybe Text
role' :: MatterPermission -> Maybe MatterPermission_Role
accountId :: Maybe Text
role' :: Maybe MatterPermission_Role
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"accountId" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
accountId,
            (Key
"role" Core..=) (MatterPermission_Role -> Pair)
-> Maybe MatterPermission_Role -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe MatterPermission_Role
role'
          ]
      )

-- | This resource represents a long-running operation that is the result of a network API call.
--
-- /See:/ 'newOperation' smart constructor.
data Operation = Operation
  { -- | If the value is @false@, it means the operation is still in progress. If @true@, the operation is completed, and either @error@ or @response@ is available.
    Operation -> Maybe Bool
done :: (Core.Maybe Core.Bool),
    -- | The error result of the operation in case of failure or cancellation.
    Operation -> Maybe Status
error :: (Core.Maybe Status),
    -- | Service-specific metadata associated with the operation. It typically contains progress information and common metadata such as create time. Some services might not provide such metadata. Any method that returns a long-running operation should document the metadata type, if any.
    Operation -> Maybe Operation_Metadata
metadata :: (Core.Maybe Operation_Metadata),
    -- | The server-assigned name, which is only unique within the same service that originally returns it. If you use the default HTTP mapping, the @name@ should be a resource name ending with @operations\/{unique_id}@.
    Operation -> Maybe Text
name :: (Core.Maybe Core.Text),
    -- | The normal, successful response of the operation. If the original method returns no data on success, such as @Delete@, the response is @google.protobuf.Empty@. If the original method is standard @Get@\/@Create@\/@Update@, the response should be the resource. For other methods, the response should have the type @XxxResponse@, where @Xxx@ is the original method name. For example, if the original method name is @TakeSnapshot()@, the inferred response type is @TakeSnapshotResponse@.
    Operation -> Maybe Operation_Response
response :: (Core.Maybe Operation_Response)
  }
  deriving (Operation -> Operation -> Bool
(Operation -> Operation -> Bool)
-> (Operation -> Operation -> Bool) -> Eq Operation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Operation -> Operation -> Bool
== :: Operation -> Operation -> Bool
$c/= :: Operation -> Operation -> Bool
/= :: Operation -> Operation -> Bool
Core.Eq, Int -> Operation -> ShowS
[Operation] -> ShowS
Operation -> String
(Int -> Operation -> ShowS)
-> (Operation -> String)
-> ([Operation] -> ShowS)
-> Show Operation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Operation -> ShowS
showsPrec :: Int -> Operation -> ShowS
$cshow :: Operation -> String
show :: Operation -> String
$cshowList :: [Operation] -> ShowS
showList :: [Operation] -> ShowS
Core.Show, (forall x. Operation -> Rep Operation x)
-> (forall x. Rep Operation x -> Operation) -> Generic Operation
forall x. Rep Operation x -> Operation
forall x. Operation -> Rep Operation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Operation -> Rep Operation x
from :: forall x. Operation -> Rep Operation x
$cto :: forall x. Rep Operation x -> Operation
to :: forall x. Rep Operation x -> Operation
Core.Generic)

-- | Creates a value of 'Operation' with the minimum fields required to make a request.
newOperation ::
  Operation
newOperation :: Operation
newOperation =
  Operation
    { done :: Maybe Bool
done = Maybe Bool
forall a. Maybe a
Core.Nothing,
      error :: Maybe Status
error = Maybe Status
forall a. Maybe a
Core.Nothing,
      metadata :: Maybe Operation_Metadata
metadata = Maybe Operation_Metadata
forall a. Maybe a
Core.Nothing,
      name :: Maybe Text
name = Maybe Text
forall a. Maybe a
Core.Nothing,
      response :: Maybe Operation_Response
response = Maybe Operation_Response
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON Operation where
  parseJSON :: Value -> Parser Operation
parseJSON =
    String -> (Object -> Parser Operation) -> Value -> Parser Operation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"Operation"
      ( \Object
o ->
          Maybe Bool
-> Maybe Status
-> Maybe Operation_Metadata
-> Maybe Text
-> Maybe Operation_Response
-> Operation
Operation
            (Maybe Bool
 -> Maybe Status
 -> Maybe Operation_Metadata
 -> Maybe Text
 -> Maybe Operation_Response
 -> Operation)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Status
      -> Maybe Operation_Metadata
      -> Maybe Text
      -> Maybe Operation_Response
      -> Operation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"done")
            Parser
  (Maybe Status
   -> Maybe Operation_Metadata
   -> Maybe Text
   -> Maybe Operation_Response
   -> Operation)
-> Parser (Maybe Status)
-> Parser
     (Maybe Operation_Metadata
      -> Maybe Text -> Maybe Operation_Response -> Operation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Status)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"error")
            Parser
  (Maybe Operation_Metadata
   -> Maybe Text -> Maybe Operation_Response -> Operation)
-> Parser (Maybe Operation_Metadata)
-> Parser (Maybe Text -> Maybe Operation_Response -> Operation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Operation_Metadata)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"metadata")
            Parser (Maybe Text -> Maybe Operation_Response -> Operation)
-> Parser (Maybe Text)
-> Parser (Maybe Operation_Response -> Operation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"name")
            Parser (Maybe Operation_Response -> Operation)
-> Parser (Maybe Operation_Response) -> Parser Operation
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Operation_Response)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"response")
      )

instance Core.ToJSON Operation where
  toJSON :: Operation -> Value
toJSON Operation {Maybe Bool
Maybe Text
Maybe Status
Maybe Operation_Response
Maybe Operation_Metadata
done :: Operation -> Maybe Bool
error :: Operation -> Maybe Status
metadata :: Operation -> Maybe Operation_Metadata
name :: Operation -> Maybe Text
response :: Operation -> Maybe Operation_Response
done :: Maybe Bool
error :: Maybe Status
metadata :: Maybe Operation_Metadata
name :: Maybe Text
response :: Maybe Operation_Response
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"done" Core..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Bool
done,
            (Key
"error" Core..=) (Status -> Pair) -> Maybe Status -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Status
error,
            (Key
"metadata" Core..=) (Operation_Metadata -> Pair)
-> Maybe Operation_Metadata -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Operation_Metadata
metadata,
            (Key
"name" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
name,
            (Key
"response" Core..=) (Operation_Response -> Pair)
-> Maybe Operation_Response -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Operation_Response
response
          ]
      )

-- | Service-specific metadata associated with the operation. It typically contains progress information and common metadata such as create time. Some services might not provide such metadata. Any method that returns a long-running operation should document the metadata type, if any.
--
-- /See:/ 'newOperation_Metadata' smart constructor.
newtype Operation_Metadata = Operation_Metadata
  { -- | Properties of the object. Contains field \@type with type URL.
    Operation_Metadata -> HashMap Text Value
additional :: (Core.HashMap Core.Text Core.Value)
  }
  deriving (Operation_Metadata -> Operation_Metadata -> Bool
(Operation_Metadata -> Operation_Metadata -> Bool)
-> (Operation_Metadata -> Operation_Metadata -> Bool)
-> Eq Operation_Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Operation_Metadata -> Operation_Metadata -> Bool
== :: Operation_Metadata -> Operation_Metadata -> Bool
$c/= :: Operation_Metadata -> Operation_Metadata -> Bool
/= :: Operation_Metadata -> Operation_Metadata -> Bool
Core.Eq, Int -> Operation_Metadata -> ShowS
[Operation_Metadata] -> ShowS
Operation_Metadata -> String
(Int -> Operation_Metadata -> ShowS)
-> (Operation_Metadata -> String)
-> ([Operation_Metadata] -> ShowS)
-> Show Operation_Metadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Operation_Metadata -> ShowS
showsPrec :: Int -> Operation_Metadata -> ShowS
$cshow :: Operation_Metadata -> String
show :: Operation_Metadata -> String
$cshowList :: [Operation_Metadata] -> ShowS
showList :: [Operation_Metadata] -> ShowS
Core.Show, (forall x. Operation_Metadata -> Rep Operation_Metadata x)
-> (forall x. Rep Operation_Metadata x -> Operation_Metadata)
-> Generic Operation_Metadata
forall x. Rep Operation_Metadata x -> Operation_Metadata
forall x. Operation_Metadata -> Rep Operation_Metadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Operation_Metadata -> Rep Operation_Metadata x
from :: forall x. Operation_Metadata -> Rep Operation_Metadata x
$cto :: forall x. Rep Operation_Metadata x -> Operation_Metadata
to :: forall x. Rep Operation_Metadata x -> Operation_Metadata
Core.Generic)

-- | Creates a value of 'Operation_Metadata' with the minimum fields required to make a request.
newOperation_Metadata ::
  -- |  Properties of the object. Contains field \@type with type URL. See 'additional'.
  Core.HashMap Core.Text Core.Value ->
  Operation_Metadata
newOperation_Metadata :: HashMap Text Value -> Operation_Metadata
newOperation_Metadata HashMap Text Value
additional =
  Operation_Metadata {additional :: HashMap Text Value
additional = HashMap Text Value
additional}

instance Core.FromJSON Operation_Metadata where
  parseJSON :: Value -> Parser Operation_Metadata
parseJSON =
    String
-> (Object -> Parser Operation_Metadata)
-> Value
-> Parser Operation_Metadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"Operation_Metadata"
      (\Object
o -> HashMap Text Value -> Operation_Metadata
Operation_Metadata (HashMap Text Value -> Operation_Metadata)
-> Parser (HashMap Text Value) -> Parser Operation_Metadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object -> Parser (HashMap Text Value)
forall a. FromJSON a => Object -> Parser a
Core.parseJSONObject Object
o))

instance Core.ToJSON Operation_Metadata where
  toJSON :: Operation_Metadata -> Value
toJSON Operation_Metadata {HashMap Text Value
additional :: Operation_Metadata -> HashMap Text Value
additional :: HashMap Text Value
..} = HashMap Text Value -> Value
forall a. ToJSON a => a -> Value
Core.toJSON HashMap Text Value
additional

-- | The normal, successful response of the operation. If the original method returns no data on success, such as @Delete@, the response is @google.protobuf.Empty@. If the original method is standard @Get@\/@Create@\/@Update@, the response should be the resource. For other methods, the response should have the type @XxxResponse@, where @Xxx@ is the original method name. For example, if the original method name is @TakeSnapshot()@, the inferred response type is @TakeSnapshotResponse@.
--
-- /See:/ 'newOperation_Response' smart constructor.
newtype Operation_Response = Operation_Response
  { -- | Properties of the object. Contains field \@type with type URL.
    Operation_Response -> HashMap Text Value
additional :: (Core.HashMap Core.Text Core.Value)
  }
  deriving (Operation_Response -> Operation_Response -> Bool
(Operation_Response -> Operation_Response -> Bool)
-> (Operation_Response -> Operation_Response -> Bool)
-> Eq Operation_Response
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Operation_Response -> Operation_Response -> Bool
== :: Operation_Response -> Operation_Response -> Bool
$c/= :: Operation_Response -> Operation_Response -> Bool
/= :: Operation_Response -> Operation_Response -> Bool
Core.Eq, Int -> Operation_Response -> ShowS
[Operation_Response] -> ShowS
Operation_Response -> String
(Int -> Operation_Response -> ShowS)
-> (Operation_Response -> String)
-> ([Operation_Response] -> ShowS)
-> Show Operation_Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Operation_Response -> ShowS
showsPrec :: Int -> Operation_Response -> ShowS
$cshow :: Operation_Response -> String
show :: Operation_Response -> String
$cshowList :: [Operation_Response] -> ShowS
showList :: [Operation_Response] -> ShowS
Core.Show, (forall x. Operation_Response -> Rep Operation_Response x)
-> (forall x. Rep Operation_Response x -> Operation_Response)
-> Generic Operation_Response
forall x. Rep Operation_Response x -> Operation_Response
forall x. Operation_Response -> Rep Operation_Response x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Operation_Response -> Rep Operation_Response x
from :: forall x. Operation_Response -> Rep Operation_Response x
$cto :: forall x. Rep Operation_Response x -> Operation_Response
to :: forall x. Rep Operation_Response x -> Operation_Response
Core.Generic)

-- | Creates a value of 'Operation_Response' with the minimum fields required to make a request.
newOperation_Response ::
  -- |  Properties of the object. Contains field \@type with type URL. See 'additional'.
  Core.HashMap Core.Text Core.Value ->
  Operation_Response
newOperation_Response :: HashMap Text Value -> Operation_Response
newOperation_Response HashMap Text Value
additional =
  Operation_Response {additional :: HashMap Text Value
additional = HashMap Text Value
additional}

instance Core.FromJSON Operation_Response where
  parseJSON :: Value -> Parser Operation_Response
parseJSON =
    String
-> (Object -> Parser Operation_Response)
-> Value
-> Parser Operation_Response
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"Operation_Response"
      (\Object
o -> HashMap Text Value -> Operation_Response
Operation_Response (HashMap Text Value -> Operation_Response)
-> Parser (HashMap Text Value) -> Parser Operation_Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object -> Parser (HashMap Text Value)
forall a. FromJSON a => Object -> Parser a
Core.parseJSONObject Object
o))

instance Core.ToJSON Operation_Response where
  toJSON :: Operation_Response -> Value
toJSON Operation_Response {HashMap Text Value
additional :: Operation_Response -> HashMap Text Value
additional :: HashMap Text Value
..} = HashMap Text Value -> Value
forall a. ToJSON a => a -> Value
Core.toJSON HashMap Text Value
additional

-- | The organizational unit to search
--
-- /See:/ 'newOrgUnitInfo' smart constructor.
newtype OrgUnitInfo = OrgUnitInfo
  { -- | The name of the organizational unit to search, as provided by the <https://developers.google.com/admin-sdk/directory/ Admin SDK Directory API>.
    OrgUnitInfo -> Maybe Text
orgUnitId :: (Core.Maybe Core.Text)
  }
  deriving (OrgUnitInfo -> OrgUnitInfo -> Bool
(OrgUnitInfo -> OrgUnitInfo -> Bool)
-> (OrgUnitInfo -> OrgUnitInfo -> Bool) -> Eq OrgUnitInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OrgUnitInfo -> OrgUnitInfo -> Bool
== :: OrgUnitInfo -> OrgUnitInfo -> Bool
$c/= :: OrgUnitInfo -> OrgUnitInfo -> Bool
/= :: OrgUnitInfo -> OrgUnitInfo -> Bool
Core.Eq, Int -> OrgUnitInfo -> ShowS
[OrgUnitInfo] -> ShowS
OrgUnitInfo -> String
(Int -> OrgUnitInfo -> ShowS)
-> (OrgUnitInfo -> String)
-> ([OrgUnitInfo] -> ShowS)
-> Show OrgUnitInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OrgUnitInfo -> ShowS
showsPrec :: Int -> OrgUnitInfo -> ShowS
$cshow :: OrgUnitInfo -> String
show :: OrgUnitInfo -> String
$cshowList :: [OrgUnitInfo] -> ShowS
showList :: [OrgUnitInfo] -> ShowS
Core.Show, (forall x. OrgUnitInfo -> Rep OrgUnitInfo x)
-> (forall x. Rep OrgUnitInfo x -> OrgUnitInfo)
-> Generic OrgUnitInfo
forall x. Rep OrgUnitInfo x -> OrgUnitInfo
forall x. OrgUnitInfo -> Rep OrgUnitInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OrgUnitInfo -> Rep OrgUnitInfo x
from :: forall x. OrgUnitInfo -> Rep OrgUnitInfo x
$cto :: forall x. Rep OrgUnitInfo x -> OrgUnitInfo
to :: forall x. Rep OrgUnitInfo x -> OrgUnitInfo
Core.Generic)

-- | Creates a value of 'OrgUnitInfo' with the minimum fields required to make a request.
newOrgUnitInfo ::
  OrgUnitInfo
newOrgUnitInfo :: OrgUnitInfo
newOrgUnitInfo = OrgUnitInfo {orgUnitId :: Maybe Text
orgUnitId = Maybe Text
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON OrgUnitInfo where
  parseJSON :: Value -> Parser OrgUnitInfo
parseJSON =
    String
-> (Object -> Parser OrgUnitInfo) -> Value -> Parser OrgUnitInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"OrgUnitInfo"
      (\Object
o -> Maybe Text -> OrgUnitInfo
OrgUnitInfo (Maybe Text -> OrgUnitInfo)
-> Parser (Maybe Text) -> Parser OrgUnitInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"orgUnitId"))

instance Core.ToJSON OrgUnitInfo where
  toJSON :: OrgUnitInfo -> Value
toJSON OrgUnitInfo {Maybe Text
orgUnitId :: OrgUnitInfo -> Maybe Text
orgUnitId :: Maybe Text
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"orgUnitId" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
orgUnitId])

-- | The query definition used for search and export.
--
-- /See:/ 'newQuery' smart constructor.
data Query = Query
  { -- | Required when __SearchMethod__ is __ACCOUNT__.
    Query -> Maybe AccountInfo
accountInfo :: (Core.Maybe AccountInfo),
    -- | Set Calendar search-specific options.
    Query -> Maybe CalendarOptions
calendarOptions :: (Core.Maybe CalendarOptions),
    -- | The Google Workspace service to search.
    Query -> Maybe Query_Corpus
corpus :: (Core.Maybe Query_Corpus),
    -- | The data source to search.
    Query -> Maybe Query_DataScope
dataScope :: (Core.Maybe Query_DataScope),
    -- | Required when __SearchMethod__ is **DRIVE_DOCUMENT**.
    Query -> Maybe DriveDocumentInfo
driveDocumentInfo :: (Core.Maybe DriveDocumentInfo),
    -- | Set Drive search-specific options.
    Query -> Maybe DriveOptions
driveOptions :: (Core.Maybe DriveOptions),
    -- | The end time for the search query. Specify in GMT. The value is rounded to 12 AM on the specified date.
    Query -> Maybe DateTime
endTime :: (Core.Maybe Core.DateTime),
    -- | Set Gemini search-specific options.
    Query -> Maybe GeminiOptions
geminiOptions :: (Core.Maybe GeminiOptions),
    -- | Required when __SearchMethod__ is __ROOM__. (read-only)
    Query -> Maybe HangoutsChatInfo
hangoutsChatInfo :: (Core.Maybe HangoutsChatInfo),
    -- | Set Chat search-specific options. (read-only)
    Query -> Maybe HangoutsChatOptions
hangoutsChatOptions :: (Core.Maybe HangoutsChatOptions),
    -- | Set Gmail search-specific options.
    Query -> Maybe MailOptions
mailOptions :: (Core.Maybe MailOptions),
    -- | The entity to search. This field replaces __searchMethod__ to support shared drives. When __searchMethod__ is __TEAM/DRIVE__, the response of this field is __SHARED/DRIVE__.
    Query -> Maybe Query_Method
method :: (Core.Maybe Query_Method),
    -- | Required when __SearchMethod__ is **ORG_UNIT**.
    Query -> Maybe OrgUnitInfo
orgUnitInfo :: (Core.Maybe OrgUnitInfo),
    -- | The search method to use.
    Query -> Maybe Query_SearchMethod
searchMethod :: (Core.Maybe Query_SearchMethod),
    -- | Required when __SearchMethod__ is **SHARED_DRIVE**.
    Query -> Maybe SharedDriveInfo
sharedDriveInfo :: (Core.Maybe SharedDriveInfo),
    -- | Required when __SearchMethod__ is **SITES_URL**.
    Query -> Maybe SitesUrlInfo
sitesUrlInfo :: (Core.Maybe SitesUrlInfo),
    -- | The start time for the search query. Specify in GMT. The value is rounded to 12 AM on the specified date.
    Query -> Maybe DateTime
startTime :: (Core.Maybe Core.DateTime),
    -- | Required when __SearchMethod__ is **TEAM_DRIVE**.
    Query -> Maybe TeamDriveInfo
teamDriveInfo :: (Core.Maybe TeamDriveInfo),
    -- | Service-specific <https://support.google.com/vault/answer/2474474 search operators> to filter search results.
    Query -> Maybe Text
terms :: (Core.Maybe Core.Text),
    -- | The time zone name. It should be an IANA TZ name, such as \"America\/Los_Angeles\". For a list of time zone names, see <https://en.wikipedia.org/wiki/List_of_tz_database_time_zones Time Zone>. For more information about how Vault uses time zones, see <https://support.google.com/vault/answer/6092995#time the Vault help center>.
    Query -> Maybe Text
timeZone :: (Core.Maybe Core.Text),
    -- | Set Voice search-specific options.
    Query -> Maybe VoiceOptions
voiceOptions :: (Core.Maybe VoiceOptions)
  }
  deriving (Query -> Query -> Bool
(Query -> Query -> Bool) -> (Query -> Query -> Bool) -> Eq Query
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Query -> Query -> Bool
== :: Query -> Query -> Bool
$c/= :: Query -> Query -> Bool
/= :: Query -> Query -> Bool
Core.Eq, Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
(Int -> Query -> ShowS)
-> (Query -> String) -> ([Query] -> ShowS) -> Show Query
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Query -> ShowS
showsPrec :: Int -> Query -> ShowS
$cshow :: Query -> String
show :: Query -> String
$cshowList :: [Query] -> ShowS
showList :: [Query] -> ShowS
Core.Show, (forall x. Query -> Rep Query x)
-> (forall x. Rep Query x -> Query) -> Generic Query
forall x. Rep Query x -> Query
forall x. Query -> Rep Query x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Query -> Rep Query x
from :: forall x. Query -> Rep Query x
$cto :: forall x. Rep Query x -> Query
to :: forall x. Rep Query x -> Query
Core.Generic)

-- | Creates a value of 'Query' with the minimum fields required to make a request.
newQuery ::
  Query
newQuery :: Query
newQuery =
  Query
    { accountInfo :: Maybe AccountInfo
accountInfo = Maybe AccountInfo
forall a. Maybe a
Core.Nothing,
      calendarOptions :: Maybe CalendarOptions
calendarOptions = Maybe CalendarOptions
forall a. Maybe a
Core.Nothing,
      corpus :: Maybe Query_Corpus
corpus = Maybe Query_Corpus
forall a. Maybe a
Core.Nothing,
      dataScope :: Maybe Query_DataScope
dataScope = Maybe Query_DataScope
forall a. Maybe a
Core.Nothing,
      driveDocumentInfo :: Maybe DriveDocumentInfo
driveDocumentInfo = Maybe DriveDocumentInfo
forall a. Maybe a
Core.Nothing,
      driveOptions :: Maybe DriveOptions
driveOptions = Maybe DriveOptions
forall a. Maybe a
Core.Nothing,
      endTime :: Maybe DateTime
endTime = Maybe DateTime
forall a. Maybe a
Core.Nothing,
      geminiOptions :: Maybe GeminiOptions
geminiOptions = Maybe GeminiOptions
forall a. Maybe a
Core.Nothing,
      hangoutsChatInfo :: Maybe HangoutsChatInfo
hangoutsChatInfo = Maybe HangoutsChatInfo
forall a. Maybe a
Core.Nothing,
      hangoutsChatOptions :: Maybe HangoutsChatOptions
hangoutsChatOptions = Maybe HangoutsChatOptions
forall a. Maybe a
Core.Nothing,
      mailOptions :: Maybe MailOptions
mailOptions = Maybe MailOptions
forall a. Maybe a
Core.Nothing,
      method :: Maybe Query_Method
method = Maybe Query_Method
forall a. Maybe a
Core.Nothing,
      orgUnitInfo :: Maybe OrgUnitInfo
orgUnitInfo = Maybe OrgUnitInfo
forall a. Maybe a
Core.Nothing,
      searchMethod :: Maybe Query_SearchMethod
searchMethod = Maybe Query_SearchMethod
forall a. Maybe a
Core.Nothing,
      sharedDriveInfo :: Maybe SharedDriveInfo
sharedDriveInfo = Maybe SharedDriveInfo
forall a. Maybe a
Core.Nothing,
      sitesUrlInfo :: Maybe SitesUrlInfo
sitesUrlInfo = Maybe SitesUrlInfo
forall a. Maybe a
Core.Nothing,
      startTime :: Maybe DateTime
startTime = Maybe DateTime
forall a. Maybe a
Core.Nothing,
      teamDriveInfo :: Maybe TeamDriveInfo
teamDriveInfo = Maybe TeamDriveInfo
forall a. Maybe a
Core.Nothing,
      terms :: Maybe Text
terms = Maybe Text
forall a. Maybe a
Core.Nothing,
      timeZone :: Maybe Text
timeZone = Maybe Text
forall a. Maybe a
Core.Nothing,
      voiceOptions :: Maybe VoiceOptions
voiceOptions = Maybe VoiceOptions
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON Query where
  parseJSON :: Value -> Parser Query
parseJSON =
    String -> (Object -> Parser Query) -> Value -> Parser Query
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"Query"
      ( \Object
o ->
          Maybe AccountInfo
-> Maybe CalendarOptions
-> Maybe Query_Corpus
-> Maybe Query_DataScope
-> Maybe DriveDocumentInfo
-> Maybe DriveOptions
-> Maybe DateTime
-> Maybe GeminiOptions
-> Maybe HangoutsChatInfo
-> Maybe HangoutsChatOptions
-> Maybe MailOptions
-> Maybe Query_Method
-> Maybe OrgUnitInfo
-> Maybe Query_SearchMethod
-> Maybe SharedDriveInfo
-> Maybe SitesUrlInfo
-> Maybe DateTime
-> Maybe TeamDriveInfo
-> Maybe Text
-> Maybe Text
-> Maybe VoiceOptions
-> Query
Query
            (Maybe AccountInfo
 -> Maybe CalendarOptions
 -> Maybe Query_Corpus
 -> Maybe Query_DataScope
 -> Maybe DriveDocumentInfo
 -> Maybe DriveOptions
 -> Maybe DateTime
 -> Maybe GeminiOptions
 -> Maybe HangoutsChatInfo
 -> Maybe HangoutsChatOptions
 -> Maybe MailOptions
 -> Maybe Query_Method
 -> Maybe OrgUnitInfo
 -> Maybe Query_SearchMethod
 -> Maybe SharedDriveInfo
 -> Maybe SitesUrlInfo
 -> Maybe DateTime
 -> Maybe TeamDriveInfo
 -> Maybe Text
 -> Maybe Text
 -> Maybe VoiceOptions
 -> Query)
-> Parser (Maybe AccountInfo)
-> Parser
     (Maybe CalendarOptions
      -> Maybe Query_Corpus
      -> Maybe Query_DataScope
      -> Maybe DriveDocumentInfo
      -> Maybe DriveOptions
      -> Maybe DateTime
      -> Maybe GeminiOptions
      -> Maybe HangoutsChatInfo
      -> Maybe HangoutsChatOptions
      -> Maybe MailOptions
      -> Maybe Query_Method
      -> Maybe OrgUnitInfo
      -> Maybe Query_SearchMethod
      -> Maybe SharedDriveInfo
      -> Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe AccountInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"accountInfo")
            Parser
  (Maybe CalendarOptions
   -> Maybe Query_Corpus
   -> Maybe Query_DataScope
   -> Maybe DriveDocumentInfo
   -> Maybe DriveOptions
   -> Maybe DateTime
   -> Maybe GeminiOptions
   -> Maybe HangoutsChatInfo
   -> Maybe HangoutsChatOptions
   -> Maybe MailOptions
   -> Maybe Query_Method
   -> Maybe OrgUnitInfo
   -> Maybe Query_SearchMethod
   -> Maybe SharedDriveInfo
   -> Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe CalendarOptions)
-> Parser
     (Maybe Query_Corpus
      -> Maybe Query_DataScope
      -> Maybe DriveDocumentInfo
      -> Maybe DriveOptions
      -> Maybe DateTime
      -> Maybe GeminiOptions
      -> Maybe HangoutsChatInfo
      -> Maybe HangoutsChatOptions
      -> Maybe MailOptions
      -> Maybe Query_Method
      -> Maybe OrgUnitInfo
      -> Maybe Query_SearchMethod
      -> Maybe SharedDriveInfo
      -> Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe CalendarOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"calendarOptions")
            Parser
  (Maybe Query_Corpus
   -> Maybe Query_DataScope
   -> Maybe DriveDocumentInfo
   -> Maybe DriveOptions
   -> Maybe DateTime
   -> Maybe GeminiOptions
   -> Maybe HangoutsChatInfo
   -> Maybe HangoutsChatOptions
   -> Maybe MailOptions
   -> Maybe Query_Method
   -> Maybe OrgUnitInfo
   -> Maybe Query_SearchMethod
   -> Maybe SharedDriveInfo
   -> Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe Query_Corpus)
-> Parser
     (Maybe Query_DataScope
      -> Maybe DriveDocumentInfo
      -> Maybe DriveOptions
      -> Maybe DateTime
      -> Maybe GeminiOptions
      -> Maybe HangoutsChatInfo
      -> Maybe HangoutsChatOptions
      -> Maybe MailOptions
      -> Maybe Query_Method
      -> Maybe OrgUnitInfo
      -> Maybe Query_SearchMethod
      -> Maybe SharedDriveInfo
      -> Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Query_Corpus)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"corpus")
            Parser
  (Maybe Query_DataScope
   -> Maybe DriveDocumentInfo
   -> Maybe DriveOptions
   -> Maybe DateTime
   -> Maybe GeminiOptions
   -> Maybe HangoutsChatInfo
   -> Maybe HangoutsChatOptions
   -> Maybe MailOptions
   -> Maybe Query_Method
   -> Maybe OrgUnitInfo
   -> Maybe Query_SearchMethod
   -> Maybe SharedDriveInfo
   -> Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe Query_DataScope)
-> Parser
     (Maybe DriveDocumentInfo
      -> Maybe DriveOptions
      -> Maybe DateTime
      -> Maybe GeminiOptions
      -> Maybe HangoutsChatInfo
      -> Maybe HangoutsChatOptions
      -> Maybe MailOptions
      -> Maybe Query_Method
      -> Maybe OrgUnitInfo
      -> Maybe Query_SearchMethod
      -> Maybe SharedDriveInfo
      -> Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Query_DataScope)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"dataScope")
            Parser
  (Maybe DriveDocumentInfo
   -> Maybe DriveOptions
   -> Maybe DateTime
   -> Maybe GeminiOptions
   -> Maybe HangoutsChatInfo
   -> Maybe HangoutsChatOptions
   -> Maybe MailOptions
   -> Maybe Query_Method
   -> Maybe OrgUnitInfo
   -> Maybe Query_SearchMethod
   -> Maybe SharedDriveInfo
   -> Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe DriveDocumentInfo)
-> Parser
     (Maybe DriveOptions
      -> Maybe DateTime
      -> Maybe GeminiOptions
      -> Maybe HangoutsChatInfo
      -> Maybe HangoutsChatOptions
      -> Maybe MailOptions
      -> Maybe Query_Method
      -> Maybe OrgUnitInfo
      -> Maybe Query_SearchMethod
      -> Maybe SharedDriveInfo
      -> Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe DriveDocumentInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"driveDocumentInfo")
            Parser
  (Maybe DriveOptions
   -> Maybe DateTime
   -> Maybe GeminiOptions
   -> Maybe HangoutsChatInfo
   -> Maybe HangoutsChatOptions
   -> Maybe MailOptions
   -> Maybe Query_Method
   -> Maybe OrgUnitInfo
   -> Maybe Query_SearchMethod
   -> Maybe SharedDriveInfo
   -> Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe DriveOptions)
-> Parser
     (Maybe DateTime
      -> Maybe GeminiOptions
      -> Maybe HangoutsChatInfo
      -> Maybe HangoutsChatOptions
      -> Maybe MailOptions
      -> Maybe Query_Method
      -> Maybe OrgUnitInfo
      -> Maybe Query_SearchMethod
      -> Maybe SharedDriveInfo
      -> Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe DriveOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"driveOptions")
            Parser
  (Maybe DateTime
   -> Maybe GeminiOptions
   -> Maybe HangoutsChatInfo
   -> Maybe HangoutsChatOptions
   -> Maybe MailOptions
   -> Maybe Query_Method
   -> Maybe OrgUnitInfo
   -> Maybe Query_SearchMethod
   -> Maybe SharedDriveInfo
   -> Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe GeminiOptions
      -> Maybe HangoutsChatInfo
      -> Maybe HangoutsChatOptions
      -> Maybe MailOptions
      -> Maybe Query_Method
      -> Maybe OrgUnitInfo
      -> Maybe Query_SearchMethod
      -> Maybe SharedDriveInfo
      -> Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"endTime")
            Parser
  (Maybe GeminiOptions
   -> Maybe HangoutsChatInfo
   -> Maybe HangoutsChatOptions
   -> Maybe MailOptions
   -> Maybe Query_Method
   -> Maybe OrgUnitInfo
   -> Maybe Query_SearchMethod
   -> Maybe SharedDriveInfo
   -> Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe GeminiOptions)
-> Parser
     (Maybe HangoutsChatInfo
      -> Maybe HangoutsChatOptions
      -> Maybe MailOptions
      -> Maybe Query_Method
      -> Maybe OrgUnitInfo
      -> Maybe Query_SearchMethod
      -> Maybe SharedDriveInfo
      -> Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe GeminiOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"geminiOptions")
            Parser
  (Maybe HangoutsChatInfo
   -> Maybe HangoutsChatOptions
   -> Maybe MailOptions
   -> Maybe Query_Method
   -> Maybe OrgUnitInfo
   -> Maybe Query_SearchMethod
   -> Maybe SharedDriveInfo
   -> Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe HangoutsChatInfo)
-> Parser
     (Maybe HangoutsChatOptions
      -> Maybe MailOptions
      -> Maybe Query_Method
      -> Maybe OrgUnitInfo
      -> Maybe Query_SearchMethod
      -> Maybe SharedDriveInfo
      -> Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe HangoutsChatInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"hangoutsChatInfo")
            Parser
  (Maybe HangoutsChatOptions
   -> Maybe MailOptions
   -> Maybe Query_Method
   -> Maybe OrgUnitInfo
   -> Maybe Query_SearchMethod
   -> Maybe SharedDriveInfo
   -> Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe HangoutsChatOptions)
-> Parser
     (Maybe MailOptions
      -> Maybe Query_Method
      -> Maybe OrgUnitInfo
      -> Maybe Query_SearchMethod
      -> Maybe SharedDriveInfo
      -> Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe HangoutsChatOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"hangoutsChatOptions")
            Parser
  (Maybe MailOptions
   -> Maybe Query_Method
   -> Maybe OrgUnitInfo
   -> Maybe Query_SearchMethod
   -> Maybe SharedDriveInfo
   -> Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe MailOptions)
-> Parser
     (Maybe Query_Method
      -> Maybe OrgUnitInfo
      -> Maybe Query_SearchMethod
      -> Maybe SharedDriveInfo
      -> Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe MailOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"mailOptions")
            Parser
  (Maybe Query_Method
   -> Maybe OrgUnitInfo
   -> Maybe Query_SearchMethod
   -> Maybe SharedDriveInfo
   -> Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe Query_Method)
-> Parser
     (Maybe OrgUnitInfo
      -> Maybe Query_SearchMethod
      -> Maybe SharedDriveInfo
      -> Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Query_Method)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"method")
            Parser
  (Maybe OrgUnitInfo
   -> Maybe Query_SearchMethod
   -> Maybe SharedDriveInfo
   -> Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe OrgUnitInfo)
-> Parser
     (Maybe Query_SearchMethod
      -> Maybe SharedDriveInfo
      -> Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe OrgUnitInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"orgUnitInfo")
            Parser
  (Maybe Query_SearchMethod
   -> Maybe SharedDriveInfo
   -> Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe Query_SearchMethod)
-> Parser
     (Maybe SharedDriveInfo
      -> Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Query_SearchMethod)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"searchMethod")
            Parser
  (Maybe SharedDriveInfo
   -> Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe SharedDriveInfo)
-> Parser
     (Maybe SitesUrlInfo
      -> Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe SharedDriveInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"sharedDriveInfo")
            Parser
  (Maybe SitesUrlInfo
   -> Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe SitesUrlInfo)
-> Parser
     (Maybe DateTime
      -> Maybe TeamDriveInfo
      -> Maybe Text
      -> Maybe Text
      -> Maybe VoiceOptions
      -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe SitesUrlInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"sitesUrlInfo")
            Parser
  (Maybe DateTime
   -> Maybe TeamDriveInfo
   -> Maybe Text
   -> Maybe Text
   -> Maybe VoiceOptions
   -> Query)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe TeamDriveInfo
      -> Maybe Text -> Maybe Text -> Maybe VoiceOptions -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"startTime")
            Parser
  (Maybe TeamDriveInfo
   -> Maybe Text -> Maybe Text -> Maybe VoiceOptions -> Query)
-> Parser (Maybe TeamDriveInfo)
-> Parser (Maybe Text -> Maybe Text -> Maybe VoiceOptions -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe TeamDriveInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"teamDriveInfo")
            Parser (Maybe Text -> Maybe Text -> Maybe VoiceOptions -> Query)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe VoiceOptions -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"terms")
            Parser (Maybe Text -> Maybe VoiceOptions -> Query)
-> Parser (Maybe Text) -> Parser (Maybe VoiceOptions -> Query)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"timeZone")
            Parser (Maybe VoiceOptions -> Query)
-> Parser (Maybe VoiceOptions) -> Parser Query
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe VoiceOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"voiceOptions")
      )

instance Core.ToJSON Query where
  toJSON :: Query -> Value
toJSON Query {Maybe Text
Maybe DateTime
Maybe Query_SearchMethod
Maybe Query_Method
Maybe Query_DataScope
Maybe Query_Corpus
Maybe VoiceOptions
Maybe TeamDriveInfo
Maybe SitesUrlInfo
Maybe SharedDriveInfo
Maybe OrgUnitInfo
Maybe MailOptions
Maybe HangoutsChatOptions
Maybe HangoutsChatInfo
Maybe GeminiOptions
Maybe DriveOptions
Maybe DriveDocumentInfo
Maybe CalendarOptions
Maybe AccountInfo
accountInfo :: Query -> Maybe AccountInfo
calendarOptions :: Query -> Maybe CalendarOptions
corpus :: Query -> Maybe Query_Corpus
dataScope :: Query -> Maybe Query_DataScope
driveDocumentInfo :: Query -> Maybe DriveDocumentInfo
driveOptions :: Query -> Maybe DriveOptions
endTime :: Query -> Maybe DateTime
geminiOptions :: Query -> Maybe GeminiOptions
hangoutsChatInfo :: Query -> Maybe HangoutsChatInfo
hangoutsChatOptions :: Query -> Maybe HangoutsChatOptions
mailOptions :: Query -> Maybe MailOptions
method :: Query -> Maybe Query_Method
orgUnitInfo :: Query -> Maybe OrgUnitInfo
searchMethod :: Query -> Maybe Query_SearchMethod
sharedDriveInfo :: Query -> Maybe SharedDriveInfo
sitesUrlInfo :: Query -> Maybe SitesUrlInfo
startTime :: Query -> Maybe DateTime
teamDriveInfo :: Query -> Maybe TeamDriveInfo
terms :: Query -> Maybe Text
timeZone :: Query -> Maybe Text
voiceOptions :: Query -> Maybe VoiceOptions
accountInfo :: Maybe AccountInfo
calendarOptions :: Maybe CalendarOptions
corpus :: Maybe Query_Corpus
dataScope :: Maybe Query_DataScope
driveDocumentInfo :: Maybe DriveDocumentInfo
driveOptions :: Maybe DriveOptions
endTime :: Maybe DateTime
geminiOptions :: Maybe GeminiOptions
hangoutsChatInfo :: Maybe HangoutsChatInfo
hangoutsChatOptions :: Maybe HangoutsChatOptions
mailOptions :: Maybe MailOptions
method :: Maybe Query_Method
orgUnitInfo :: Maybe OrgUnitInfo
searchMethod :: Maybe Query_SearchMethod
sharedDriveInfo :: Maybe SharedDriveInfo
sitesUrlInfo :: Maybe SitesUrlInfo
startTime :: Maybe DateTime
teamDriveInfo :: Maybe TeamDriveInfo
terms :: Maybe Text
timeZone :: Maybe Text
voiceOptions :: Maybe VoiceOptions
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"accountInfo" Core..=) (AccountInfo -> Pair) -> Maybe AccountInfo -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe AccountInfo
accountInfo,
            (Key
"calendarOptions" Core..=) (CalendarOptions -> Pair) -> Maybe CalendarOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe CalendarOptions
calendarOptions,
            (Key
"corpus" Core..=) (Query_Corpus -> Pair) -> Maybe Query_Corpus -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Query_Corpus
corpus,
            (Key
"dataScope" Core..=) (Query_DataScope -> Pair) -> Maybe Query_DataScope -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Query_DataScope
dataScope,
            (Key
"driveDocumentInfo" Core..=) (DriveDocumentInfo -> Pair)
-> Maybe DriveDocumentInfo -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DriveDocumentInfo
driveDocumentInfo,
            (Key
"driveOptions" Core..=) (DriveOptions -> Pair) -> Maybe DriveOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DriveOptions
driveOptions,
            (Key
"endTime" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
endTime,
            (Key
"geminiOptions" Core..=) (GeminiOptions -> Pair) -> Maybe GeminiOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe GeminiOptions
geminiOptions,
            (Key
"hangoutsChatInfo" Core..=) (HangoutsChatInfo -> Pair) -> Maybe HangoutsChatInfo -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe HangoutsChatInfo
hangoutsChatInfo,
            (Key
"hangoutsChatOptions" Core..=) (HangoutsChatOptions -> Pair)
-> Maybe HangoutsChatOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe HangoutsChatOptions
hangoutsChatOptions,
            (Key
"mailOptions" Core..=) (MailOptions -> Pair) -> Maybe MailOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe MailOptions
mailOptions,
            (Key
"method" Core..=) (Query_Method -> Pair) -> Maybe Query_Method -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Query_Method
method,
            (Key
"orgUnitInfo" Core..=) (OrgUnitInfo -> Pair) -> Maybe OrgUnitInfo -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe OrgUnitInfo
orgUnitInfo,
            (Key
"searchMethod" Core..=) (Query_SearchMethod -> Pair)
-> Maybe Query_SearchMethod -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Query_SearchMethod
searchMethod,
            (Key
"sharedDriveInfo" Core..=) (SharedDriveInfo -> Pair) -> Maybe SharedDriveInfo -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe SharedDriveInfo
sharedDriveInfo,
            (Key
"sitesUrlInfo" Core..=) (SitesUrlInfo -> Pair) -> Maybe SitesUrlInfo -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe SitesUrlInfo
sitesUrlInfo,
            (Key
"startTime" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
startTime,
            (Key
"teamDriveInfo" Core..=) (TeamDriveInfo -> Pair) -> Maybe TeamDriveInfo -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe TeamDriveInfo
teamDriveInfo,
            (Key
"terms" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
terms,
            (Key
"timeZone" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
timeZone,
            (Key
"voiceOptions" Core..=) (VoiceOptions -> Pair) -> Maybe VoiceOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe VoiceOptions
voiceOptions
          ]
      )

-- | Remove a list of accounts from a hold.
--
-- /See:/ 'newRemoveHeldAccountsRequest' smart constructor.
newtype RemoveHeldAccountsRequest = RemoveHeldAccountsRequest
  { -- | The account IDs of the accounts to remove from the hold.
    RemoveHeldAccountsRequest -> Maybe [Text]
accountIds :: (Core.Maybe [Core.Text])
  }
  deriving (RemoveHeldAccountsRequest -> RemoveHeldAccountsRequest -> Bool
(RemoveHeldAccountsRequest -> RemoveHeldAccountsRequest -> Bool)
-> (RemoveHeldAccountsRequest -> RemoveHeldAccountsRequest -> Bool)
-> Eq RemoveHeldAccountsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoveHeldAccountsRequest -> RemoveHeldAccountsRequest -> Bool
== :: RemoveHeldAccountsRequest -> RemoveHeldAccountsRequest -> Bool
$c/= :: RemoveHeldAccountsRequest -> RemoveHeldAccountsRequest -> Bool
/= :: RemoveHeldAccountsRequest -> RemoveHeldAccountsRequest -> Bool
Core.Eq, Int -> RemoveHeldAccountsRequest -> ShowS
[RemoveHeldAccountsRequest] -> ShowS
RemoveHeldAccountsRequest -> String
(Int -> RemoveHeldAccountsRequest -> ShowS)
-> (RemoveHeldAccountsRequest -> String)
-> ([RemoveHeldAccountsRequest] -> ShowS)
-> Show RemoveHeldAccountsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoveHeldAccountsRequest -> ShowS
showsPrec :: Int -> RemoveHeldAccountsRequest -> ShowS
$cshow :: RemoveHeldAccountsRequest -> String
show :: RemoveHeldAccountsRequest -> String
$cshowList :: [RemoveHeldAccountsRequest] -> ShowS
showList :: [RemoveHeldAccountsRequest] -> ShowS
Core.Show, (forall x.
 RemoveHeldAccountsRequest -> Rep RemoveHeldAccountsRequest x)
-> (forall x.
    Rep RemoveHeldAccountsRequest x -> RemoveHeldAccountsRequest)
-> Generic RemoveHeldAccountsRequest
forall x.
Rep RemoveHeldAccountsRequest x -> RemoveHeldAccountsRequest
forall x.
RemoveHeldAccountsRequest -> Rep RemoveHeldAccountsRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RemoveHeldAccountsRequest -> Rep RemoveHeldAccountsRequest x
from :: forall x.
RemoveHeldAccountsRequest -> Rep RemoveHeldAccountsRequest x
$cto :: forall x.
Rep RemoveHeldAccountsRequest x -> RemoveHeldAccountsRequest
to :: forall x.
Rep RemoveHeldAccountsRequest x -> RemoveHeldAccountsRequest
Core.Generic)

-- | Creates a value of 'RemoveHeldAccountsRequest' with the minimum fields required to make a request.
newRemoveHeldAccountsRequest ::
  RemoveHeldAccountsRequest
newRemoveHeldAccountsRequest :: RemoveHeldAccountsRequest
newRemoveHeldAccountsRequest =
  RemoveHeldAccountsRequest {accountIds :: Maybe [Text]
accountIds = Maybe [Text]
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON RemoveHeldAccountsRequest where
  parseJSON :: Value -> Parser RemoveHeldAccountsRequest
parseJSON =
    String
-> (Object -> Parser RemoveHeldAccountsRequest)
-> Value
-> Parser RemoveHeldAccountsRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"RemoveHeldAccountsRequest"
      ( \Object
o ->
          Maybe [Text] -> RemoveHeldAccountsRequest
RemoveHeldAccountsRequest (Maybe [Text] -> RemoveHeldAccountsRequest)
-> Parser (Maybe [Text]) -> Parser RemoveHeldAccountsRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"accountIds")
      )

instance Core.ToJSON RemoveHeldAccountsRequest where
  toJSON :: RemoveHeldAccountsRequest -> Value
toJSON RemoveHeldAccountsRequest {Maybe [Text]
accountIds :: RemoveHeldAccountsRequest -> Maybe [Text]
accountIds :: Maybe [Text]
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"accountIds" Core..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Text]
accountIds])

-- | Response for batch delete held accounts.
--
-- /See:/ 'newRemoveHeldAccountsResponse' smart constructor.
newtype RemoveHeldAccountsResponse = RemoveHeldAccountsResponse
  { -- | A list of statuses for the deleted accounts. Results have the same order as the request.
    RemoveHeldAccountsResponse -> Maybe [Status]
statuses :: (Core.Maybe [Status])
  }
  deriving (RemoveHeldAccountsResponse -> RemoveHeldAccountsResponse -> Bool
(RemoveHeldAccountsResponse -> RemoveHeldAccountsResponse -> Bool)
-> (RemoveHeldAccountsResponse
    -> RemoveHeldAccountsResponse -> Bool)
-> Eq RemoveHeldAccountsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoveHeldAccountsResponse -> RemoveHeldAccountsResponse -> Bool
== :: RemoveHeldAccountsResponse -> RemoveHeldAccountsResponse -> Bool
$c/= :: RemoveHeldAccountsResponse -> RemoveHeldAccountsResponse -> Bool
/= :: RemoveHeldAccountsResponse -> RemoveHeldAccountsResponse -> Bool
Core.Eq, Int -> RemoveHeldAccountsResponse -> ShowS
[RemoveHeldAccountsResponse] -> ShowS
RemoveHeldAccountsResponse -> String
(Int -> RemoveHeldAccountsResponse -> ShowS)
-> (RemoveHeldAccountsResponse -> String)
-> ([RemoveHeldAccountsResponse] -> ShowS)
-> Show RemoveHeldAccountsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoveHeldAccountsResponse -> ShowS
showsPrec :: Int -> RemoveHeldAccountsResponse -> ShowS
$cshow :: RemoveHeldAccountsResponse -> String
show :: RemoveHeldAccountsResponse -> String
$cshowList :: [RemoveHeldAccountsResponse] -> ShowS
showList :: [RemoveHeldAccountsResponse] -> ShowS
Core.Show, (forall x.
 RemoveHeldAccountsResponse -> Rep RemoveHeldAccountsResponse x)
-> (forall x.
    Rep RemoveHeldAccountsResponse x -> RemoveHeldAccountsResponse)
-> Generic RemoveHeldAccountsResponse
forall x.
Rep RemoveHeldAccountsResponse x -> RemoveHeldAccountsResponse
forall x.
RemoveHeldAccountsResponse -> Rep RemoveHeldAccountsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RemoveHeldAccountsResponse -> Rep RemoveHeldAccountsResponse x
from :: forall x.
RemoveHeldAccountsResponse -> Rep RemoveHeldAccountsResponse x
$cto :: forall x.
Rep RemoveHeldAccountsResponse x -> RemoveHeldAccountsResponse
to :: forall x.
Rep RemoveHeldAccountsResponse x -> RemoveHeldAccountsResponse
Core.Generic)

-- | Creates a value of 'RemoveHeldAccountsResponse' with the minimum fields required to make a request.
newRemoveHeldAccountsResponse ::
  RemoveHeldAccountsResponse
newRemoveHeldAccountsResponse :: RemoveHeldAccountsResponse
newRemoveHeldAccountsResponse =
  RemoveHeldAccountsResponse {statuses :: Maybe [Status]
statuses = Maybe [Status]
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON RemoveHeldAccountsResponse where
  parseJSON :: Value -> Parser RemoveHeldAccountsResponse
parseJSON =
    String
-> (Object -> Parser RemoveHeldAccountsResponse)
-> Value
-> Parser RemoveHeldAccountsResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"RemoveHeldAccountsResponse"
      ( \Object
o ->
          Maybe [Status] -> RemoveHeldAccountsResponse
RemoveHeldAccountsResponse (Maybe [Status] -> RemoveHeldAccountsResponse)
-> Parser (Maybe [Status]) -> Parser RemoveHeldAccountsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [Status])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"statuses")
      )

instance Core.ToJSON RemoveHeldAccountsResponse where
  toJSON :: RemoveHeldAccountsResponse -> Value
toJSON RemoveHeldAccountsResponse {Maybe [Status]
statuses :: RemoveHeldAccountsResponse -> Maybe [Status]
statuses :: Maybe [Status]
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"statuses" Core..=) ([Status] -> Pair) -> Maybe [Status] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Status]
statuses])

-- | Remove an account as a matter collaborator.
--
-- /See:/ 'newRemoveMatterPermissionsRequest' smart constructor.
newtype RemoveMatterPermissionsRequest = RemoveMatterPermissionsRequest
  { -- | The account ID.
    RemoveMatterPermissionsRequest -> Maybe Text
accountId :: (Core.Maybe Core.Text)
  }
  deriving (RemoveMatterPermissionsRequest
-> RemoveMatterPermissionsRequest -> Bool
(RemoveMatterPermissionsRequest
 -> RemoveMatterPermissionsRequest -> Bool)
-> (RemoveMatterPermissionsRequest
    -> RemoveMatterPermissionsRequest -> Bool)
-> Eq RemoveMatterPermissionsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoveMatterPermissionsRequest
-> RemoveMatterPermissionsRequest -> Bool
== :: RemoveMatterPermissionsRequest
-> RemoveMatterPermissionsRequest -> Bool
$c/= :: RemoveMatterPermissionsRequest
-> RemoveMatterPermissionsRequest -> Bool
/= :: RemoveMatterPermissionsRequest
-> RemoveMatterPermissionsRequest -> Bool
Core.Eq, Int -> RemoveMatterPermissionsRequest -> ShowS
[RemoveMatterPermissionsRequest] -> ShowS
RemoveMatterPermissionsRequest -> String
(Int -> RemoveMatterPermissionsRequest -> ShowS)
-> (RemoveMatterPermissionsRequest -> String)
-> ([RemoveMatterPermissionsRequest] -> ShowS)
-> Show RemoveMatterPermissionsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoveMatterPermissionsRequest -> ShowS
showsPrec :: Int -> RemoveMatterPermissionsRequest -> ShowS
$cshow :: RemoveMatterPermissionsRequest -> String
show :: RemoveMatterPermissionsRequest -> String
$cshowList :: [RemoveMatterPermissionsRequest] -> ShowS
showList :: [RemoveMatterPermissionsRequest] -> ShowS
Core.Show, (forall x.
 RemoveMatterPermissionsRequest
 -> Rep RemoveMatterPermissionsRequest x)
-> (forall x.
    Rep RemoveMatterPermissionsRequest x
    -> RemoveMatterPermissionsRequest)
-> Generic RemoveMatterPermissionsRequest
forall x.
Rep RemoveMatterPermissionsRequest x
-> RemoveMatterPermissionsRequest
forall x.
RemoveMatterPermissionsRequest
-> Rep RemoveMatterPermissionsRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RemoveMatterPermissionsRequest
-> Rep RemoveMatterPermissionsRequest x
from :: forall x.
RemoveMatterPermissionsRequest
-> Rep RemoveMatterPermissionsRequest x
$cto :: forall x.
Rep RemoveMatterPermissionsRequest x
-> RemoveMatterPermissionsRequest
to :: forall x.
Rep RemoveMatterPermissionsRequest x
-> RemoveMatterPermissionsRequest
Core.Generic)

-- | Creates a value of 'RemoveMatterPermissionsRequest' with the minimum fields required to make a request.
newRemoveMatterPermissionsRequest ::
  RemoveMatterPermissionsRequest
newRemoveMatterPermissionsRequest :: RemoveMatterPermissionsRequest
newRemoveMatterPermissionsRequest =
  RemoveMatterPermissionsRequest {accountId :: Maybe Text
accountId = Maybe Text
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON RemoveMatterPermissionsRequest where
  parseJSON :: Value -> Parser RemoveMatterPermissionsRequest
parseJSON =
    String
-> (Object -> Parser RemoveMatterPermissionsRequest)
-> Value
-> Parser RemoveMatterPermissionsRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"RemoveMatterPermissionsRequest"
      ( \Object
o ->
          Maybe Text -> RemoveMatterPermissionsRequest
RemoveMatterPermissionsRequest (Maybe Text -> RemoveMatterPermissionsRequest)
-> Parser (Maybe Text) -> Parser RemoveMatterPermissionsRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"accountId")
      )

instance Core.ToJSON RemoveMatterPermissionsRequest where
  toJSON :: RemoveMatterPermissionsRequest -> Value
toJSON RemoveMatterPermissionsRequest {Maybe Text
accountId :: RemoveMatterPermissionsRequest -> Maybe Text
accountId :: Maybe Text
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"accountId" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
accountId])

-- | Reopen a matter by ID.
--
-- /See:/ 'newReopenMatterRequest' smart constructor.
data ReopenMatterRequest = ReopenMatterRequest
  deriving (ReopenMatterRequest -> ReopenMatterRequest -> Bool
(ReopenMatterRequest -> ReopenMatterRequest -> Bool)
-> (ReopenMatterRequest -> ReopenMatterRequest -> Bool)
-> Eq ReopenMatterRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReopenMatterRequest -> ReopenMatterRequest -> Bool
== :: ReopenMatterRequest -> ReopenMatterRequest -> Bool
$c/= :: ReopenMatterRequest -> ReopenMatterRequest -> Bool
/= :: ReopenMatterRequest -> ReopenMatterRequest -> Bool
Core.Eq, Int -> ReopenMatterRequest -> ShowS
[ReopenMatterRequest] -> ShowS
ReopenMatterRequest -> String
(Int -> ReopenMatterRequest -> ShowS)
-> (ReopenMatterRequest -> String)
-> ([ReopenMatterRequest] -> ShowS)
-> Show ReopenMatterRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReopenMatterRequest -> ShowS
showsPrec :: Int -> ReopenMatterRequest -> ShowS
$cshow :: ReopenMatterRequest -> String
show :: ReopenMatterRequest -> String
$cshowList :: [ReopenMatterRequest] -> ShowS
showList :: [ReopenMatterRequest] -> ShowS
Core.Show, (forall x. ReopenMatterRequest -> Rep ReopenMatterRequest x)
-> (forall x. Rep ReopenMatterRequest x -> ReopenMatterRequest)
-> Generic ReopenMatterRequest
forall x. Rep ReopenMatterRequest x -> ReopenMatterRequest
forall x. ReopenMatterRequest -> Rep ReopenMatterRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReopenMatterRequest -> Rep ReopenMatterRequest x
from :: forall x. ReopenMatterRequest -> Rep ReopenMatterRequest x
$cto :: forall x. Rep ReopenMatterRequest x -> ReopenMatterRequest
to :: forall x. Rep ReopenMatterRequest x -> ReopenMatterRequest
Core.Generic)

-- | Creates a value of 'ReopenMatterRequest' with the minimum fields required to make a request.
newReopenMatterRequest ::
  ReopenMatterRequest
newReopenMatterRequest :: ReopenMatterRequest
newReopenMatterRequest = ReopenMatterRequest
ReopenMatterRequest

instance Core.FromJSON ReopenMatterRequest where
  parseJSON :: Value -> Parser ReopenMatterRequest
parseJSON =
    String
-> (Object -> Parser ReopenMatterRequest)
-> Value
-> Parser ReopenMatterRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"ReopenMatterRequest"
      (\Object
o -> ReopenMatterRequest -> Parser ReopenMatterRequest
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Core.pure ReopenMatterRequest
ReopenMatterRequest)

instance Core.ToJSON ReopenMatterRequest where
  toJSON :: ReopenMatterRequest -> Value
toJSON = Value -> ReopenMatterRequest -> Value
forall a b. a -> b -> a
Core.const Value
Core.emptyObject

-- | Response to a ReopenMatterRequest.
--
-- /See:/ 'newReopenMatterResponse' smart constructor.
newtype ReopenMatterResponse = ReopenMatterResponse
  { -- | The updated matter, with state __OPEN__.
    ReopenMatterResponse -> Maybe Matter
matter :: (Core.Maybe Matter)
  }
  deriving (ReopenMatterResponse -> ReopenMatterResponse -> Bool
(ReopenMatterResponse -> ReopenMatterResponse -> Bool)
-> (ReopenMatterResponse -> ReopenMatterResponse -> Bool)
-> Eq ReopenMatterResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReopenMatterResponse -> ReopenMatterResponse -> Bool
== :: ReopenMatterResponse -> ReopenMatterResponse -> Bool
$c/= :: ReopenMatterResponse -> ReopenMatterResponse -> Bool
/= :: ReopenMatterResponse -> ReopenMatterResponse -> Bool
Core.Eq, Int -> ReopenMatterResponse -> ShowS
[ReopenMatterResponse] -> ShowS
ReopenMatterResponse -> String
(Int -> ReopenMatterResponse -> ShowS)
-> (ReopenMatterResponse -> String)
-> ([ReopenMatterResponse] -> ShowS)
-> Show ReopenMatterResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReopenMatterResponse -> ShowS
showsPrec :: Int -> ReopenMatterResponse -> ShowS
$cshow :: ReopenMatterResponse -> String
show :: ReopenMatterResponse -> String
$cshowList :: [ReopenMatterResponse] -> ShowS
showList :: [ReopenMatterResponse] -> ShowS
Core.Show, (forall x. ReopenMatterResponse -> Rep ReopenMatterResponse x)
-> (forall x. Rep ReopenMatterResponse x -> ReopenMatterResponse)
-> Generic ReopenMatterResponse
forall x. Rep ReopenMatterResponse x -> ReopenMatterResponse
forall x. ReopenMatterResponse -> Rep ReopenMatterResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReopenMatterResponse -> Rep ReopenMatterResponse x
from :: forall x. ReopenMatterResponse -> Rep ReopenMatterResponse x
$cto :: forall x. Rep ReopenMatterResponse x -> ReopenMatterResponse
to :: forall x. Rep ReopenMatterResponse x -> ReopenMatterResponse
Core.Generic)

-- | Creates a value of 'ReopenMatterResponse' with the minimum fields required to make a request.
newReopenMatterResponse ::
  ReopenMatterResponse
newReopenMatterResponse :: ReopenMatterResponse
newReopenMatterResponse =
  ReopenMatterResponse {matter :: Maybe Matter
matter = Maybe Matter
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON ReopenMatterResponse where
  parseJSON :: Value -> Parser ReopenMatterResponse
parseJSON =
    String
-> (Object -> Parser ReopenMatterResponse)
-> Value
-> Parser ReopenMatterResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"ReopenMatterResponse"
      (\Object
o -> Maybe Matter -> ReopenMatterResponse
ReopenMatterResponse (Maybe Matter -> ReopenMatterResponse)
-> Parser (Maybe Matter) -> Parser ReopenMatterResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Matter)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"matter"))

instance Core.ToJSON ReopenMatterResponse where
  toJSON :: ReopenMatterResponse -> Value
toJSON ReopenMatterResponse {Maybe Matter
matter :: ReopenMatterResponse -> Maybe Matter
matter :: Maybe Matter
..} =
    [Pair] -> Value
Core.object ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"matter" Core..=) (Matter -> Pair) -> Maybe Matter -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Matter
matter])

-- | The definition of a saved query. To work with Vault resources, the account must have the <https://support.google.com/vault/answer/2799699 required Vault privileges> and access to the matter. To access a matter, the account must have created the matter, have the matter shared with them, or have the __View All Matters__ privilege.
--
-- /See:/ 'newSavedQuery' smart constructor.
data SavedQuery = SavedQuery
  { -- | Output only. The server-generated timestamp when the saved query was created.
    SavedQuery -> Maybe DateTime
createTime :: (Core.Maybe Core.DateTime),
    -- | The name of the saved query.
    SavedQuery -> Maybe Text
displayName :: (Core.Maybe Core.Text),
    -- | Output only. The matter ID of the matter the saved query is saved in. The server does not use this field during create and always uses matter ID in the URL.
    SavedQuery -> Maybe Text
matterId :: (Core.Maybe Core.Text),
    -- | The search parameters of the saved query.
    SavedQuery -> Maybe Query
query :: (Core.Maybe Query),
    -- | A unique identifier for the saved query.
    SavedQuery -> Maybe Text
savedQueryId :: (Core.Maybe Core.Text)
  }
  deriving (SavedQuery -> SavedQuery -> Bool
(SavedQuery -> SavedQuery -> Bool)
-> (SavedQuery -> SavedQuery -> Bool) -> Eq SavedQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SavedQuery -> SavedQuery -> Bool
== :: SavedQuery -> SavedQuery -> Bool
$c/= :: SavedQuery -> SavedQuery -> Bool
/= :: SavedQuery -> SavedQuery -> Bool
Core.Eq, Int -> SavedQuery -> ShowS
[SavedQuery] -> ShowS
SavedQuery -> String
(Int -> SavedQuery -> ShowS)
-> (SavedQuery -> String)
-> ([SavedQuery] -> ShowS)
-> Show SavedQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SavedQuery -> ShowS
showsPrec :: Int -> SavedQuery -> ShowS
$cshow :: SavedQuery -> String
show :: SavedQuery -> String
$cshowList :: [SavedQuery] -> ShowS
showList :: [SavedQuery] -> ShowS
Core.Show, (forall x. SavedQuery -> Rep SavedQuery x)
-> (forall x. Rep SavedQuery x -> SavedQuery) -> Generic SavedQuery
forall x. Rep SavedQuery x -> SavedQuery
forall x. SavedQuery -> Rep SavedQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SavedQuery -> Rep SavedQuery x
from :: forall x. SavedQuery -> Rep SavedQuery x
$cto :: forall x. Rep SavedQuery x -> SavedQuery
to :: forall x. Rep SavedQuery x -> SavedQuery
Core.Generic)

-- | Creates a value of 'SavedQuery' with the minimum fields required to make a request.
newSavedQuery ::
  SavedQuery
newSavedQuery :: SavedQuery
newSavedQuery =
  SavedQuery
    { createTime :: Maybe DateTime
createTime = Maybe DateTime
forall a. Maybe a
Core.Nothing,
      displayName :: Maybe Text
displayName = Maybe Text
forall a. Maybe a
Core.Nothing,
      matterId :: Maybe Text
matterId = Maybe Text
forall a. Maybe a
Core.Nothing,
      query :: Maybe Query
query = Maybe Query
forall a. Maybe a
Core.Nothing,
      savedQueryId :: Maybe Text
savedQueryId = Maybe Text
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON SavedQuery where
  parseJSON :: Value -> Parser SavedQuery
parseJSON =
    String
-> (Object -> Parser SavedQuery) -> Value -> Parser SavedQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"SavedQuery"
      ( \Object
o ->
          Maybe DateTime
-> Maybe Text
-> Maybe Text
-> Maybe Query
-> Maybe Text
-> SavedQuery
SavedQuery
            (Maybe DateTime
 -> Maybe Text
 -> Maybe Text
 -> Maybe Query
 -> Maybe Text
 -> SavedQuery)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Query -> Maybe Text -> SavedQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"createTime")
            Parser
  (Maybe Text
   -> Maybe Text -> Maybe Query -> Maybe Text -> SavedQuery)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Query -> Maybe Text -> SavedQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"displayName")
            Parser (Maybe Text -> Maybe Query -> Maybe Text -> SavedQuery)
-> Parser (Maybe Text)
-> Parser (Maybe Query -> Maybe Text -> SavedQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"matterId")
            Parser (Maybe Query -> Maybe Text -> SavedQuery)
-> Parser (Maybe Query) -> Parser (Maybe Text -> SavedQuery)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Query)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"query")
            Parser (Maybe Text -> SavedQuery)
-> Parser (Maybe Text) -> Parser SavedQuery
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"savedQueryId")
      )

instance Core.ToJSON SavedQuery where
  toJSON :: SavedQuery -> Value
toJSON SavedQuery {Maybe Text
Maybe DateTime
Maybe Query
createTime :: SavedQuery -> Maybe DateTime
displayName :: SavedQuery -> Maybe Text
matterId :: SavedQuery -> Maybe Text
query :: SavedQuery -> Maybe Query
savedQueryId :: SavedQuery -> Maybe Text
createTime :: Maybe DateTime
displayName :: Maybe Text
matterId :: Maybe Text
query :: Maybe Query
savedQueryId :: Maybe Text
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"createTime" Core..=) (DateTime -> Pair) -> Maybe DateTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe DateTime
createTime,
            (Key
"displayName" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
displayName,
            (Key
"matterId" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
matterId,
            (Key
"query" Core..=) (Query -> Pair) -> Maybe Query -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Query
query,
            (Key
"savedQueryId" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
savedQueryId
          ]
      )

-- | The shared drives to search
--
-- /See:/ 'newSharedDriveInfo' smart constructor.
newtype SharedDriveInfo = SharedDriveInfo
  { -- | A list of shared drive IDs, as provided by the <https://developers.google.com/drive Drive API>.
    SharedDriveInfo -> Maybe [Text]
sharedDriveIds :: (Core.Maybe [Core.Text])
  }
  deriving (SharedDriveInfo -> SharedDriveInfo -> Bool
(SharedDriveInfo -> SharedDriveInfo -> Bool)
-> (SharedDriveInfo -> SharedDriveInfo -> Bool)
-> Eq SharedDriveInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SharedDriveInfo -> SharedDriveInfo -> Bool
== :: SharedDriveInfo -> SharedDriveInfo -> Bool
$c/= :: SharedDriveInfo -> SharedDriveInfo -> Bool
/= :: SharedDriveInfo -> SharedDriveInfo -> Bool
Core.Eq, Int -> SharedDriveInfo -> ShowS
[SharedDriveInfo] -> ShowS
SharedDriveInfo -> String
(Int -> SharedDriveInfo -> ShowS)
-> (SharedDriveInfo -> String)
-> ([SharedDriveInfo] -> ShowS)
-> Show SharedDriveInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SharedDriveInfo -> ShowS
showsPrec :: Int -> SharedDriveInfo -> ShowS
$cshow :: SharedDriveInfo -> String
show :: SharedDriveInfo -> String
$cshowList :: [SharedDriveInfo] -> ShowS
showList :: [SharedDriveInfo] -> ShowS
Core.Show, (forall x. SharedDriveInfo -> Rep SharedDriveInfo x)
-> (forall x. Rep SharedDriveInfo x -> SharedDriveInfo)
-> Generic SharedDriveInfo
forall x. Rep SharedDriveInfo x -> SharedDriveInfo
forall x. SharedDriveInfo -> Rep SharedDriveInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SharedDriveInfo -> Rep SharedDriveInfo x
from :: forall x. SharedDriveInfo -> Rep SharedDriveInfo x
$cto :: forall x. Rep SharedDriveInfo x -> SharedDriveInfo
to :: forall x. Rep SharedDriveInfo x -> SharedDriveInfo
Core.Generic)

-- | Creates a value of 'SharedDriveInfo' with the minimum fields required to make a request.
newSharedDriveInfo ::
  SharedDriveInfo
newSharedDriveInfo :: SharedDriveInfo
newSharedDriveInfo = SharedDriveInfo {sharedDriveIds :: Maybe [Text]
sharedDriveIds = Maybe [Text]
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON SharedDriveInfo where
  parseJSON :: Value -> Parser SharedDriveInfo
parseJSON =
    String
-> (Object -> Parser SharedDriveInfo)
-> Value
-> Parser SharedDriveInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"SharedDriveInfo"
      (\Object
o -> Maybe [Text] -> SharedDriveInfo
SharedDriveInfo (Maybe [Text] -> SharedDriveInfo)
-> Parser (Maybe [Text]) -> Parser SharedDriveInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"sharedDriveIds"))

instance Core.ToJSON SharedDriveInfo where
  toJSON :: SharedDriveInfo -> Value
toJSON SharedDriveInfo {Maybe [Text]
sharedDriveIds :: SharedDriveInfo -> Maybe [Text]
sharedDriveIds :: Maybe [Text]
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [(Key
"sharedDriveIds" Core..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Text]
sharedDriveIds]
      )

-- | The published site URLs of new Google Sites to search
--
-- /See:/ 'newSitesUrlInfo' smart constructor.
newtype SitesUrlInfo = SitesUrlInfo
  { -- | A list of published site URLs.
    SitesUrlInfo -> Maybe [Text]
urls :: (Core.Maybe [Core.Text])
  }
  deriving (SitesUrlInfo -> SitesUrlInfo -> Bool
(SitesUrlInfo -> SitesUrlInfo -> Bool)
-> (SitesUrlInfo -> SitesUrlInfo -> Bool) -> Eq SitesUrlInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SitesUrlInfo -> SitesUrlInfo -> Bool
== :: SitesUrlInfo -> SitesUrlInfo -> Bool
$c/= :: SitesUrlInfo -> SitesUrlInfo -> Bool
/= :: SitesUrlInfo -> SitesUrlInfo -> Bool
Core.Eq, Int -> SitesUrlInfo -> ShowS
[SitesUrlInfo] -> ShowS
SitesUrlInfo -> String
(Int -> SitesUrlInfo -> ShowS)
-> (SitesUrlInfo -> String)
-> ([SitesUrlInfo] -> ShowS)
-> Show SitesUrlInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SitesUrlInfo -> ShowS
showsPrec :: Int -> SitesUrlInfo -> ShowS
$cshow :: SitesUrlInfo -> String
show :: SitesUrlInfo -> String
$cshowList :: [SitesUrlInfo] -> ShowS
showList :: [SitesUrlInfo] -> ShowS
Core.Show, (forall x. SitesUrlInfo -> Rep SitesUrlInfo x)
-> (forall x. Rep SitesUrlInfo x -> SitesUrlInfo)
-> Generic SitesUrlInfo
forall x. Rep SitesUrlInfo x -> SitesUrlInfo
forall x. SitesUrlInfo -> Rep SitesUrlInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SitesUrlInfo -> Rep SitesUrlInfo x
from :: forall x. SitesUrlInfo -> Rep SitesUrlInfo x
$cto :: forall x. Rep SitesUrlInfo x -> SitesUrlInfo
to :: forall x. Rep SitesUrlInfo x -> SitesUrlInfo
Core.Generic)

-- | Creates a value of 'SitesUrlInfo' with the minimum fields required to make a request.
newSitesUrlInfo ::
  SitesUrlInfo
newSitesUrlInfo :: SitesUrlInfo
newSitesUrlInfo = SitesUrlInfo {urls :: Maybe [Text]
urls = Maybe [Text]
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON SitesUrlInfo where
  parseJSON :: Value -> Parser SitesUrlInfo
parseJSON =
    String
-> (Object -> Parser SitesUrlInfo) -> Value -> Parser SitesUrlInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"SitesUrlInfo"
      (\Object
o -> Maybe [Text] -> SitesUrlInfo
SitesUrlInfo (Maybe [Text] -> SitesUrlInfo)
-> Parser (Maybe [Text]) -> Parser SitesUrlInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"urls"))

instance Core.ToJSON SitesUrlInfo where
  toJSON :: SitesUrlInfo -> Value
toJSON SitesUrlInfo {Maybe [Text]
urls :: SitesUrlInfo -> Maybe [Text]
urls :: Maybe [Text]
..} =
    [Pair] -> Value
Core.object ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"urls" Core..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Text]
urls])

-- | The @Status@ type defines a logical error model that is suitable for different programming environments, including REST APIs and RPC APIs. It is used by <https://github.com/grpc gRPC>. Each @Status@ message contains three pieces of data: error code, error message, and error details. You can find out more about this error model and how to work with it in the <https://cloud.google.com/apis/design/errors API Design Guide>.
--
-- /See:/ 'newStatus' smart constructor.
data Status = Status
  { -- | The status code, which should be an enum value of google.rpc.Code.
    Status -> Maybe Int32
code :: (Core.Maybe Core.Int32),
    -- | A list of messages that carry the error details. There is a common set of message types for APIs to use.
    Status -> Maybe [Status_DetailsItem]
details :: (Core.Maybe [Status_DetailsItem]),
    -- | A developer-facing error message, which should be in English. Any user-facing error message should be localized and sent in the google.rpc.Status.details field, or localized by the client.
    Status -> Maybe Text
message :: (Core.Maybe Core.Text)
  }
  deriving (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: Status -> Status -> Bool
Core.Eq, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Core.Show, (forall x. Status -> Rep Status x)
-> (forall x. Rep Status x -> Status) -> Generic Status
forall x. Rep Status x -> Status
forall x. Status -> Rep Status x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Status -> Rep Status x
from :: forall x. Status -> Rep Status x
$cto :: forall x. Rep Status x -> Status
to :: forall x. Rep Status x -> Status
Core.Generic)

-- | Creates a value of 'Status' with the minimum fields required to make a request.
newStatus ::
  Status
newStatus :: Status
newStatus =
  Status
    { code :: Maybe Int32
code = Maybe Int32
forall a. Maybe a
Core.Nothing,
      details :: Maybe [Status_DetailsItem]
details = Maybe [Status_DetailsItem]
forall a. Maybe a
Core.Nothing,
      message :: Maybe Text
message = Maybe Text
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON Status where
  parseJSON :: Value -> Parser Status
parseJSON =
    String -> (Object -> Parser Status) -> Value -> Parser Status
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"Status"
      ( \Object
o ->
          Maybe Int32 -> Maybe [Status_DetailsItem] -> Maybe Text -> Status
Status
            (Maybe Int32 -> Maybe [Status_DetailsItem] -> Maybe Text -> Status)
-> Parser (Maybe Int32)
-> Parser (Maybe [Status_DetailsItem] -> Maybe Text -> Status)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Int32)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"code")
            Parser (Maybe [Status_DetailsItem] -> Maybe Text -> Status)
-> Parser (Maybe [Status_DetailsItem])
-> Parser (Maybe Text -> Status)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe [Status_DetailsItem])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"details")
            Parser (Maybe Text -> Status)
-> Parser (Maybe Text) -> Parser Status
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"message")
      )

instance Core.ToJSON Status where
  toJSON :: Status -> Value
toJSON Status {Maybe Int32
Maybe [Status_DetailsItem]
Maybe Text
code :: Status -> Maybe Int32
details :: Status -> Maybe [Status_DetailsItem]
message :: Status -> Maybe Text
code :: Maybe Int32
details :: Maybe [Status_DetailsItem]
message :: Maybe Text
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"code" Core..=) (Int32 -> Pair) -> Maybe Int32 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int32
code,
            (Key
"details" Core..=) ([Status_DetailsItem] -> Pair)
-> Maybe [Status_DetailsItem] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Status_DetailsItem]
details,
            (Key
"message" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
message
          ]
      )

--
-- /See:/ 'newStatus_DetailsItem' smart constructor.
newtype Status_DetailsItem = Status_DetailsItem
  { -- | Properties of the object. Contains field \@type with type URL.
    Status_DetailsItem -> HashMap Text Value
additional :: (Core.HashMap Core.Text Core.Value)
  }
  deriving (Status_DetailsItem -> Status_DetailsItem -> Bool
(Status_DetailsItem -> Status_DetailsItem -> Bool)
-> (Status_DetailsItem -> Status_DetailsItem -> Bool)
-> Eq Status_DetailsItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status_DetailsItem -> Status_DetailsItem -> Bool
== :: Status_DetailsItem -> Status_DetailsItem -> Bool
$c/= :: Status_DetailsItem -> Status_DetailsItem -> Bool
/= :: Status_DetailsItem -> Status_DetailsItem -> Bool
Core.Eq, Int -> Status_DetailsItem -> ShowS
[Status_DetailsItem] -> ShowS
Status_DetailsItem -> String
(Int -> Status_DetailsItem -> ShowS)
-> (Status_DetailsItem -> String)
-> ([Status_DetailsItem] -> ShowS)
-> Show Status_DetailsItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status_DetailsItem -> ShowS
showsPrec :: Int -> Status_DetailsItem -> ShowS
$cshow :: Status_DetailsItem -> String
show :: Status_DetailsItem -> String
$cshowList :: [Status_DetailsItem] -> ShowS
showList :: [Status_DetailsItem] -> ShowS
Core.Show, (forall x. Status_DetailsItem -> Rep Status_DetailsItem x)
-> (forall x. Rep Status_DetailsItem x -> Status_DetailsItem)
-> Generic Status_DetailsItem
forall x. Rep Status_DetailsItem x -> Status_DetailsItem
forall x. Status_DetailsItem -> Rep Status_DetailsItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Status_DetailsItem -> Rep Status_DetailsItem x
from :: forall x. Status_DetailsItem -> Rep Status_DetailsItem x
$cto :: forall x. Rep Status_DetailsItem x -> Status_DetailsItem
to :: forall x. Rep Status_DetailsItem x -> Status_DetailsItem
Core.Generic)

-- | Creates a value of 'Status_DetailsItem' with the minimum fields required to make a request.
newStatus_DetailsItem ::
  -- |  Properties of the object. Contains field \@type with type URL. See 'additional'.
  Core.HashMap Core.Text Core.Value ->
  Status_DetailsItem
newStatus_DetailsItem :: HashMap Text Value -> Status_DetailsItem
newStatus_DetailsItem HashMap Text Value
additional =
  Status_DetailsItem {additional :: HashMap Text Value
additional = HashMap Text Value
additional}

instance Core.FromJSON Status_DetailsItem where
  parseJSON :: Value -> Parser Status_DetailsItem
parseJSON =
    String
-> (Object -> Parser Status_DetailsItem)
-> Value
-> Parser Status_DetailsItem
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"Status_DetailsItem"
      (\Object
o -> HashMap Text Value -> Status_DetailsItem
Status_DetailsItem (HashMap Text Value -> Status_DetailsItem)
-> Parser (HashMap Text Value) -> Parser Status_DetailsItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object -> Parser (HashMap Text Value)
forall a. FromJSON a => Object -> Parser a
Core.parseJSONObject Object
o))

instance Core.ToJSON Status_DetailsItem where
  toJSON :: Status_DetailsItem -> Value
toJSON Status_DetailsItem {HashMap Text Value
additional :: Status_DetailsItem -> HashMap Text Value
additional :: HashMap Text Value
..} = HashMap Text Value -> Value
forall a. ToJSON a => a -> Value
Core.toJSON HashMap Text Value
additional

-- | Team Drives to search
--
-- /See:/ 'newTeamDriveInfo' smart constructor.
newtype TeamDriveInfo = TeamDriveInfo
  { -- | List of Team Drive IDs, as provided by the <https://developers.google.com/drive Drive API>.
    TeamDriveInfo -> Maybe [Text]
teamDriveIds :: (Core.Maybe [Core.Text])
  }
  deriving (TeamDriveInfo -> TeamDriveInfo -> Bool
(TeamDriveInfo -> TeamDriveInfo -> Bool)
-> (TeamDriveInfo -> TeamDriveInfo -> Bool) -> Eq TeamDriveInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TeamDriveInfo -> TeamDriveInfo -> Bool
== :: TeamDriveInfo -> TeamDriveInfo -> Bool
$c/= :: TeamDriveInfo -> TeamDriveInfo -> Bool
/= :: TeamDriveInfo -> TeamDriveInfo -> Bool
Core.Eq, Int -> TeamDriveInfo -> ShowS
[TeamDriveInfo] -> ShowS
TeamDriveInfo -> String
(Int -> TeamDriveInfo -> ShowS)
-> (TeamDriveInfo -> String)
-> ([TeamDriveInfo] -> ShowS)
-> Show TeamDriveInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TeamDriveInfo -> ShowS
showsPrec :: Int -> TeamDriveInfo -> ShowS
$cshow :: TeamDriveInfo -> String
show :: TeamDriveInfo -> String
$cshowList :: [TeamDriveInfo] -> ShowS
showList :: [TeamDriveInfo] -> ShowS
Core.Show, (forall x. TeamDriveInfo -> Rep TeamDriveInfo x)
-> (forall x. Rep TeamDriveInfo x -> TeamDriveInfo)
-> Generic TeamDriveInfo
forall x. Rep TeamDriveInfo x -> TeamDriveInfo
forall x. TeamDriveInfo -> Rep TeamDriveInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TeamDriveInfo -> Rep TeamDriveInfo x
from :: forall x. TeamDriveInfo -> Rep TeamDriveInfo x
$cto :: forall x. Rep TeamDriveInfo x -> TeamDriveInfo
to :: forall x. Rep TeamDriveInfo x -> TeamDriveInfo
Core.Generic)

-- | Creates a value of 'TeamDriveInfo' with the minimum fields required to make a request.
newTeamDriveInfo ::
  TeamDriveInfo
newTeamDriveInfo :: TeamDriveInfo
newTeamDriveInfo = TeamDriveInfo {teamDriveIds :: Maybe [Text]
teamDriveIds = Maybe [Text]
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON TeamDriveInfo where
  parseJSON :: Value -> Parser TeamDriveInfo
parseJSON =
    String
-> (Object -> Parser TeamDriveInfo)
-> Value
-> Parser TeamDriveInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"TeamDriveInfo"
      (\Object
o -> Maybe [Text] -> TeamDriveInfo
TeamDriveInfo (Maybe [Text] -> TeamDriveInfo)
-> Parser (Maybe [Text]) -> Parser TeamDriveInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"teamDriveIds"))

instance Core.ToJSON TeamDriveInfo where
  toJSON :: TeamDriveInfo -> Value
toJSON TeamDriveInfo {Maybe [Text]
teamDriveIds :: TeamDriveInfo -> Maybe [Text]
teamDriveIds :: Maybe [Text]
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"teamDriveIds" Core..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Text]
teamDriveIds])

-- | Undelete a matter by ID.
--
-- /See:/ 'newUndeleteMatterRequest' smart constructor.
data UndeleteMatterRequest = UndeleteMatterRequest
  deriving (UndeleteMatterRequest -> UndeleteMatterRequest -> Bool
(UndeleteMatterRequest -> UndeleteMatterRequest -> Bool)
-> (UndeleteMatterRequest -> UndeleteMatterRequest -> Bool)
-> Eq UndeleteMatterRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UndeleteMatterRequest -> UndeleteMatterRequest -> Bool
== :: UndeleteMatterRequest -> UndeleteMatterRequest -> Bool
$c/= :: UndeleteMatterRequest -> UndeleteMatterRequest -> Bool
/= :: UndeleteMatterRequest -> UndeleteMatterRequest -> Bool
Core.Eq, Int -> UndeleteMatterRequest -> ShowS
[UndeleteMatterRequest] -> ShowS
UndeleteMatterRequest -> String
(Int -> UndeleteMatterRequest -> ShowS)
-> (UndeleteMatterRequest -> String)
-> ([UndeleteMatterRequest] -> ShowS)
-> Show UndeleteMatterRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UndeleteMatterRequest -> ShowS
showsPrec :: Int -> UndeleteMatterRequest -> ShowS
$cshow :: UndeleteMatterRequest -> String
show :: UndeleteMatterRequest -> String
$cshowList :: [UndeleteMatterRequest] -> ShowS
showList :: [UndeleteMatterRequest] -> ShowS
Core.Show, (forall x. UndeleteMatterRequest -> Rep UndeleteMatterRequest x)
-> (forall x. Rep UndeleteMatterRequest x -> UndeleteMatterRequest)
-> Generic UndeleteMatterRequest
forall x. Rep UndeleteMatterRequest x -> UndeleteMatterRequest
forall x. UndeleteMatterRequest -> Rep UndeleteMatterRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UndeleteMatterRequest -> Rep UndeleteMatterRequest x
from :: forall x. UndeleteMatterRequest -> Rep UndeleteMatterRequest x
$cto :: forall x. Rep UndeleteMatterRequest x -> UndeleteMatterRequest
to :: forall x. Rep UndeleteMatterRequest x -> UndeleteMatterRequest
Core.Generic)

-- | Creates a value of 'UndeleteMatterRequest' with the minimum fields required to make a request.
newUndeleteMatterRequest ::
  UndeleteMatterRequest
newUndeleteMatterRequest :: UndeleteMatterRequest
newUndeleteMatterRequest = UndeleteMatterRequest
UndeleteMatterRequest

instance Core.FromJSON UndeleteMatterRequest where
  parseJSON :: Value -> Parser UndeleteMatterRequest
parseJSON =
    String
-> (Object -> Parser UndeleteMatterRequest)
-> Value
-> Parser UndeleteMatterRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"UndeleteMatterRequest"
      (\Object
o -> UndeleteMatterRequest -> Parser UndeleteMatterRequest
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Core.pure UndeleteMatterRequest
UndeleteMatterRequest)

instance Core.ToJSON UndeleteMatterRequest where
  toJSON :: UndeleteMatterRequest -> Value
toJSON = Value -> UndeleteMatterRequest -> Value
forall a b. a -> b -> a
Core.const Value
Core.emptyObject

-- | User\'s information.
--
-- /See:/ 'newUserInfo' smart constructor.
data UserInfo = UserInfo
  { -- | The displayed name of the user.
    UserInfo -> Maybe Text
displayName :: (Core.Maybe Core.Text),
    -- | The email address of the user.
    UserInfo -> Maybe Text
email :: (Core.Maybe Core.Text)
  }
  deriving (UserInfo -> UserInfo -> Bool
(UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool) -> Eq UserInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserInfo -> UserInfo -> Bool
== :: UserInfo -> UserInfo -> Bool
$c/= :: UserInfo -> UserInfo -> Bool
/= :: UserInfo -> UserInfo -> Bool
Core.Eq, Int -> UserInfo -> ShowS
[UserInfo] -> ShowS
UserInfo -> String
(Int -> UserInfo -> ShowS)
-> (UserInfo -> String) -> ([UserInfo] -> ShowS) -> Show UserInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserInfo -> ShowS
showsPrec :: Int -> UserInfo -> ShowS
$cshow :: UserInfo -> String
show :: UserInfo -> String
$cshowList :: [UserInfo] -> ShowS
showList :: [UserInfo] -> ShowS
Core.Show, (forall x. UserInfo -> Rep UserInfo x)
-> (forall x. Rep UserInfo x -> UserInfo) -> Generic UserInfo
forall x. Rep UserInfo x -> UserInfo
forall x. UserInfo -> Rep UserInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserInfo -> Rep UserInfo x
from :: forall x. UserInfo -> Rep UserInfo x
$cto :: forall x. Rep UserInfo x -> UserInfo
to :: forall x. Rep UserInfo x -> UserInfo
Core.Generic)

-- | Creates a value of 'UserInfo' with the minimum fields required to make a request.
newUserInfo ::
  UserInfo
newUserInfo :: UserInfo
newUserInfo =
  UserInfo {displayName :: Maybe Text
displayName = Maybe Text
forall a. Maybe a
Core.Nothing, email :: Maybe Text
email = Maybe Text
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON UserInfo where
  parseJSON :: Value -> Parser UserInfo
parseJSON =
    String -> (Object -> Parser UserInfo) -> Value -> Parser UserInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"UserInfo"
      ( \Object
o ->
          Maybe Text -> Maybe Text -> UserInfo
UserInfo
            (Maybe Text -> Maybe Text -> UserInfo)
-> Parser (Maybe Text) -> Parser (Maybe Text -> UserInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"displayName")
            Parser (Maybe Text -> UserInfo)
-> Parser (Maybe Text) -> Parser UserInfo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"email")
      )

instance Core.ToJSON UserInfo where
  toJSON :: UserInfo -> Value
toJSON UserInfo {Maybe Text
displayName :: UserInfo -> Maybe Text
email :: UserInfo -> Maybe Text
displayName :: Maybe Text
email :: Maybe Text
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"displayName" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
displayName,
            (Key
"email" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
email
          ]
      )

-- | The options for Voice exports.
--
-- /See:/ 'newVoiceExportOptions' smart constructor.
newtype VoiceExportOptions = VoiceExportOptions
  { -- | The file format for exported text messages.
    VoiceExportOptions -> Maybe VoiceExportOptions_ExportFormat
exportFormat :: (Core.Maybe VoiceExportOptions_ExportFormat)
  }
  deriving (VoiceExportOptions -> VoiceExportOptions -> Bool
(VoiceExportOptions -> VoiceExportOptions -> Bool)
-> (VoiceExportOptions -> VoiceExportOptions -> Bool)
-> Eq VoiceExportOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VoiceExportOptions -> VoiceExportOptions -> Bool
== :: VoiceExportOptions -> VoiceExportOptions -> Bool
$c/= :: VoiceExportOptions -> VoiceExportOptions -> Bool
/= :: VoiceExportOptions -> VoiceExportOptions -> Bool
Core.Eq, Int -> VoiceExportOptions -> ShowS
[VoiceExportOptions] -> ShowS
VoiceExportOptions -> String
(Int -> VoiceExportOptions -> ShowS)
-> (VoiceExportOptions -> String)
-> ([VoiceExportOptions] -> ShowS)
-> Show VoiceExportOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VoiceExportOptions -> ShowS
showsPrec :: Int -> VoiceExportOptions -> ShowS
$cshow :: VoiceExportOptions -> String
show :: VoiceExportOptions -> String
$cshowList :: [VoiceExportOptions] -> ShowS
showList :: [VoiceExportOptions] -> ShowS
Core.Show, (forall x. VoiceExportOptions -> Rep VoiceExportOptions x)
-> (forall x. Rep VoiceExportOptions x -> VoiceExportOptions)
-> Generic VoiceExportOptions
forall x. Rep VoiceExportOptions x -> VoiceExportOptions
forall x. VoiceExportOptions -> Rep VoiceExportOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VoiceExportOptions -> Rep VoiceExportOptions x
from :: forall x. VoiceExportOptions -> Rep VoiceExportOptions x
$cto :: forall x. Rep VoiceExportOptions x -> VoiceExportOptions
to :: forall x. Rep VoiceExportOptions x -> VoiceExportOptions
Core.Generic)

-- | Creates a value of 'VoiceExportOptions' with the minimum fields required to make a request.
newVoiceExportOptions ::
  VoiceExportOptions
newVoiceExportOptions :: VoiceExportOptions
newVoiceExportOptions =
  VoiceExportOptions {exportFormat :: Maybe VoiceExportOptions_ExportFormat
exportFormat = Maybe VoiceExportOptions_ExportFormat
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON VoiceExportOptions where
  parseJSON :: Value -> Parser VoiceExportOptions
parseJSON =
    String
-> (Object -> Parser VoiceExportOptions)
-> Value
-> Parser VoiceExportOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"VoiceExportOptions"
      (\Object
o -> Maybe VoiceExportOptions_ExportFormat -> VoiceExportOptions
VoiceExportOptions (Maybe VoiceExportOptions_ExportFormat -> VoiceExportOptions)
-> Parser (Maybe VoiceExportOptions_ExportFormat)
-> Parser VoiceExportOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe VoiceExportOptions_ExportFormat)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"exportFormat"))

instance Core.ToJSON VoiceExportOptions where
  toJSON :: VoiceExportOptions -> Value
toJSON VoiceExportOptions {Maybe VoiceExportOptions_ExportFormat
exportFormat :: VoiceExportOptions -> Maybe VoiceExportOptions_ExportFormat
exportFormat :: Maybe VoiceExportOptions_ExportFormat
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"exportFormat" Core..=) (VoiceExportOptions_ExportFormat -> Pair)
-> Maybe VoiceExportOptions_ExportFormat -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe VoiceExportOptions_ExportFormat
exportFormat])

-- | Additional options for Voice search
--
-- /See:/ 'newVoiceOptions' smart constructor.
newtype VoiceOptions = VoiceOptions
  { -- | Datatypes to search
    VoiceOptions -> Maybe [VoiceOptions_CoveredDataItem]
coveredData :: (Core.Maybe [VoiceOptions_CoveredDataItem])
  }
  deriving (VoiceOptions -> VoiceOptions -> Bool
(VoiceOptions -> VoiceOptions -> Bool)
-> (VoiceOptions -> VoiceOptions -> Bool) -> Eq VoiceOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VoiceOptions -> VoiceOptions -> Bool
== :: VoiceOptions -> VoiceOptions -> Bool
$c/= :: VoiceOptions -> VoiceOptions -> Bool
/= :: VoiceOptions -> VoiceOptions -> Bool
Core.Eq, Int -> VoiceOptions -> ShowS
[VoiceOptions] -> ShowS
VoiceOptions -> String
(Int -> VoiceOptions -> ShowS)
-> (VoiceOptions -> String)
-> ([VoiceOptions] -> ShowS)
-> Show VoiceOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VoiceOptions -> ShowS
showsPrec :: Int -> VoiceOptions -> ShowS
$cshow :: VoiceOptions -> String
show :: VoiceOptions -> String
$cshowList :: [VoiceOptions] -> ShowS
showList :: [VoiceOptions] -> ShowS
Core.Show, (forall x. VoiceOptions -> Rep VoiceOptions x)
-> (forall x. Rep VoiceOptions x -> VoiceOptions)
-> Generic VoiceOptions
forall x. Rep VoiceOptions x -> VoiceOptions
forall x. VoiceOptions -> Rep VoiceOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VoiceOptions -> Rep VoiceOptions x
from :: forall x. VoiceOptions -> Rep VoiceOptions x
$cto :: forall x. Rep VoiceOptions x -> VoiceOptions
to :: forall x. Rep VoiceOptions x -> VoiceOptions
Core.Generic)

-- | Creates a value of 'VoiceOptions' with the minimum fields required to make a request.
newVoiceOptions ::
  VoiceOptions
newVoiceOptions :: VoiceOptions
newVoiceOptions = VoiceOptions {coveredData :: Maybe [VoiceOptions_CoveredDataItem]
coveredData = Maybe [VoiceOptions_CoveredDataItem]
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON VoiceOptions where
  parseJSON :: Value -> Parser VoiceOptions
parseJSON =
    String
-> (Object -> Parser VoiceOptions) -> Value -> Parser VoiceOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"VoiceOptions"
      (\Object
o -> Maybe [VoiceOptions_CoveredDataItem] -> VoiceOptions
VoiceOptions (Maybe [VoiceOptions_CoveredDataItem] -> VoiceOptions)
-> Parser (Maybe [VoiceOptions_CoveredDataItem])
-> Parser VoiceOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [VoiceOptions_CoveredDataItem])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"coveredData"))

instance Core.ToJSON VoiceOptions where
  toJSON :: VoiceOptions -> Value
toJSON VoiceOptions {Maybe [VoiceOptions_CoveredDataItem]
coveredData :: VoiceOptions -> Maybe [VoiceOptions_CoveredDataItem]
coveredData :: Maybe [VoiceOptions_CoveredDataItem]
..} =
    [Pair] -> Value
Core.object
      ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes [(Key
"coveredData" Core..=) ([VoiceOptions_CoveredDataItem] -> Pair)
-> Maybe [VoiceOptions_CoveredDataItem] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [VoiceOptions_CoveredDataItem]
coveredData])