Retry.hs

{-
  Copyright (c) Meta Platforms, Inc. and affiliates.
  All rights reserved.

  This source code is licensed under the BSD-style license found in the
  LICENSE file in the root directory of this source tree.
-}

module Glean.Backend.Retry
  ( RetryWritesBackend(..)
  , backendRetryWrites
  , RetryReadsBackend(..)
  , backendRetryReads
  ) where

import Glean.Backend.Types
import Glean.Util.RetryChannelException
import Glean.Util.Some

data RetryWritesBackend = RetryWritesBackend RetryPolicy (Some Backend)

-- | Make a 'Backend' that will retry all write-related operations
-- according to the given 'RetryPolicy'
backendRetryWrites :: Backend b => b -> RetryPolicy -> RetryWritesBackend
backendRetryWrites backend policy = RetryWritesBackend policy (Some backend)

instance Backend RetryWritesBackend where
  queryFact (RetryWritesBackend _ backend) = queryFact backend
  factIdRange (RetryWritesBackend _ backend) = factIdRange backend
  getSchemaInfo (RetryWritesBackend _ backend) = getSchemaInfo backend
  validateSchema (RetryWritesBackend _ backend) = validateSchema backend
  predicateStats (RetryWritesBackend _ backend) = predicateStats backend
  listDatabases (RetryWritesBackend _ backend) = listDatabases backend
  getDatabase (RetryWritesBackend _ backend) = getDatabase backend
  userQueryFacts (RetryWritesBackend _ backend) = userQueryFacts backend
  userQuery (RetryWritesBackend _ backend) = userQuery backend
  userQueryBatch (RetryWritesBackend _ backend) = userQueryBatch backend
  deriveStored (RetryWritesBackend _ backend) = deriveStored backend

  kickOffDatabase (RetryWritesBackend policy backend) kickOff =
    retryChannelExceptions policy $ kickOffDatabase backend kickOff
  finishDatabase (RetryWritesBackend policy backend) repo =
    retryChannelExceptions policy $ finishDatabase backend repo
  finalizeDatabase (RetryWritesBackend policy backend) repo =
    retryChannelExceptions policy $ finalizeDatabase backend repo
  updateProperties (RetryWritesBackend policy backend) repo props vals =
    retryChannelExceptions policy $ updateProperties backend repo props vals
  completePredicates_ (RetryWritesBackend policy backend) repo preds =
    retryChannelExceptions policy $ completePredicates_ backend repo preds

  restoreDatabase (RetryWritesBackend _ backend) = restoreDatabase backend
  deleteDatabase (RetryWritesBackend _ backend) = deleteDatabase backend

  enqueueBatch (RetryWritesBackend policy backend) batch =
    retryChannelExceptions policy $ enqueueBatch backend batch
  enqueueJsonBatch (RetryWritesBackend policy backend) repo batch =
    retryChannelExceptions policy $ enqueueJsonBatch backend repo batch
  enqueueBatchDescriptor (RetryWritesBackend policy backend)
    repo batch waitPolicy =
      retryChannelExceptions policy
        $ enqueueBatchDescriptor backend repo batch waitPolicy
  pollBatch (RetryWritesBackend policy backend) handle =
    retryChannelExceptions policy $ pollBatch backend handle

  displayBackend (RetryWritesBackend _ backend) = displayBackend backend
  hasDatabase (RetryWritesBackend _ backend) = hasDatabase backend
  schemaId (RetryWritesBackend _ backend) = schemaId backend
  usingShards (RetryWritesBackend _ backend) = usingShards backend
  initGlobalState (RetryWritesBackend _ backend) = initGlobalState backend

data RetryReadsBackend = RetryReadsBackend RetryPolicy (Some Backend)

-- | Make a 'Backend' that will retry all read-related operations
-- according to the given 'RetryPolicy'
backendRetryReads :: Backend b => b -> RetryPolicy -> RetryReadsBackend
backendRetryReads backend policy = RetryReadsBackend policy (Some backend)

instance Backend RetryReadsBackend where
  queryFact (RetryReadsBackend policy backend) repo id =
    retryChannelExceptions policy $ queryFact backend repo id
  factIdRange (RetryReadsBackend policy backend) repo =
    retryChannelExceptions policy $ factIdRange backend repo
  getSchemaInfo (RetryReadsBackend policy backend) repo opts =
    retryChannelExceptions policy $ getSchemaInfo backend repo opts
  validateSchema (RetryReadsBackend policy backend) req =
    retryChannelExceptions policy $ validateSchema backend req
  predicateStats (RetryReadsBackend policy backend) repo opts =
    retryChannelExceptions policy $ predicateStats backend repo opts
  listDatabases (RetryReadsBackend policy backend) req =
    retryChannelExceptions policy $ listDatabases backend req
  getDatabase (RetryReadsBackend policy backend) repo =
    retryChannelExceptions policy $ getDatabase backend repo
  userQueryFacts (RetryReadsBackend policy backend) repo req =
    retryChannelExceptions policy $ userQueryFacts backend repo req
  userQuery (RetryReadsBackend policy backend) repo req =
    retryChannelExceptions policy $ userQuery backend repo req
  userQueryBatch (RetryReadsBackend policy backend) repo req =
    retryChannelExceptions policy $ userQueryBatch backend repo req
  deriveStored (RetryReadsBackend _ backend) = deriveStored backend

  kickOffDatabase (RetryReadsBackend _ backend) = kickOffDatabase backend
  finishDatabase (RetryReadsBackend _ backend) = finishDatabase backend
  finalizeDatabase (RetryReadsBackend _ backend) = finalizeDatabase backend
  updateProperties (RetryReadsBackend _ backend) = updateProperties backend
  completePredicates_ (RetryReadsBackend _ backend) =
    completePredicates_ backend

  restoreDatabase (RetryReadsBackend _ backend) = restoreDatabase backend
  deleteDatabase (RetryReadsBackend _ backend) = deleteDatabase backend

  enqueueBatch (RetryReadsBackend _ backend) = enqueueBatch backend
  enqueueJsonBatch (RetryReadsBackend _ backend) = enqueueJsonBatch backend
  enqueueBatchDescriptor (RetryReadsBackend _ backend) =
    enqueueBatchDescriptor backend
  pollBatch (RetryReadsBackend _ backend) = pollBatch backend

  displayBackend (RetryReadsBackend _ backend) = displayBackend backend
  hasDatabase (RetryReadsBackend _ backend) = hasDatabase backend
  schemaId (RetryReadsBackend _ backend) = schemaId backend
  usingShards (RetryReadsBackend _ backend) = usingShards backend
  initGlobalState (RetryReadsBackend _ backend) = initGlobalState backend