{-# LANGUAGE QuasiQuotes #-}

-- | Functions for fetching and updating @'Metadata' in the catalog.
module Hasura.RQL.DDL.Schema.Catalog
  ( fetchMetadataFromCatalog,
    fetchMetadataAndResourceVersionFromCatalog,
    fetchMetadataResourceVersionFromCatalog,
    fetchMetadataNotificationsFromCatalog,
    insertMetadataInCatalog,
    setMetadataInCatalog,
    bumpMetadataVersionInCatalog,
  )
where

import Data.Bifunctor (bimap)
import Database.PG.Query qualified as Q
import Hasura.Backends.Postgres.Connection
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.SchemaCache
  ( MetadataResourceVersion (..),
    initialResourceVersion,
  )
import Hasura.RQL.Types.SchemaCache.Build (CacheInvalidations)
import Hasura.Server.Types (InstanceId (..))

fetchMetadataFromCatalog :: Q.TxE QErr Metadata
fetchMetadataFromCatalog :: TxE QErr Metadata
fetchMetadataFromCatalog = do
  [Identity (AltJ Metadata)]
rows <-
    (PGTxErr -> QErr)
-> Query -> () -> Bool -> TxET QErr IO [Identity (AltJ Metadata)]
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
Q.withQE
      PGTxErr -> QErr
defaultTxErrorHandler
      [Q.sql|
       SELECT metadata from hdb_catalog.hdb_metadata
    |]
      ()
      Bool
True
  case [Identity (AltJ Metadata)]
rows of
    [] -> Metadata -> TxE QErr Metadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure Metadata
emptyMetadata
    [Identity (Q.AltJ Metadata
metadata)] -> Metadata -> TxE QErr Metadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure Metadata
metadata
    [Identity (AltJ Metadata)]
_ -> Text -> TxE QErr Metadata
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"multiple rows in hdb_metadata table"

fetchMetadataAndResourceVersionFromCatalog :: Q.TxE QErr (Metadata, MetadataResourceVersion)
fetchMetadataAndResourceVersionFromCatalog :: TxE QErr (Metadata, MetadataResourceVersion)
fetchMetadataAndResourceVersionFromCatalog = do
  [(AltJ Metadata, Int64)]
rows <-
    (PGTxErr -> QErr)
-> Query -> () -> Bool -> TxET QErr IO [(AltJ Metadata, Int64)]
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
Q.withQE
      PGTxErr -> QErr
defaultTxErrorHandler
      [Q.sql|
       SELECT metadata, resource_version from hdb_catalog.hdb_metadata
    |]
      ()
      Bool
True
  case [(AltJ Metadata, Int64)]
rows of
    [] -> (Metadata, MetadataResourceVersion)
-> TxE QErr (Metadata, MetadataResourceVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Metadata
emptyMetadata, MetadataResourceVersion
initialResourceVersion)
    [(Q.AltJ Metadata
metadata, Int64
resourceVersion)] -> (Metadata, MetadataResourceVersion)
-> TxE QErr (Metadata, MetadataResourceVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Metadata
metadata, Int64 -> MetadataResourceVersion
MetadataResourceVersion Int64
resourceVersion)
    [(AltJ Metadata, Int64)]
_ -> Text -> TxE QErr (Metadata, MetadataResourceVersion)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"multiple rows in hdb_metadata table"

fetchMetadataResourceVersionFromCatalog :: Q.TxE QErr MetadataResourceVersion
fetchMetadataResourceVersionFromCatalog :: TxE QErr MetadataResourceVersion
fetchMetadataResourceVersionFromCatalog = do
  [Identity Int64]
rows <-
    (PGTxErr -> QErr)
-> Query -> () -> Bool -> TxET QErr IO [Identity Int64]
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
Q.withQE
      PGTxErr -> QErr
defaultTxErrorHandler
      [Q.sql|
       SELECT resource_version from hdb_catalog.hdb_metadata
    |]
      ()
      Bool
True
  case [Identity Int64]
rows of
    [] -> MetadataResourceVersion -> TxE QErr MetadataResourceVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure MetadataResourceVersion
initialResourceVersion
    [Identity Int64
resourceVersion] -> MetadataResourceVersion -> TxE QErr MetadataResourceVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> MetadataResourceVersion
MetadataResourceVersion Int64
resourceVersion)
    [Identity Int64]
_ -> Text -> TxE QErr MetadataResourceVersion
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"multiple rows in hdb_metadata table"

fetchMetadataNotificationsFromCatalog :: MetadataResourceVersion -> InstanceId -> Q.TxE QErr [(MetadataResourceVersion, CacheInvalidations)]
fetchMetadataNotificationsFromCatalog :: MetadataResourceVersion
-> InstanceId
-> TxE QErr [(MetadataResourceVersion, CacheInvalidations)]
fetchMetadataNotificationsFromCatalog (MetadataResourceVersion Int64
resourceVersion) InstanceId
instanceId = do
  ((Int64, AltJ CacheInvalidations)
 -> (MetadataResourceVersion, CacheInvalidations))
-> [(Int64, AltJ CacheInvalidations)]
-> [(MetadataResourceVersion, CacheInvalidations)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int64 -> MetadataResourceVersion)
-> (AltJ CacheInvalidations -> CacheInvalidations)
-> (Int64, AltJ CacheInvalidations)
-> (MetadataResourceVersion, CacheInvalidations)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Int64 -> MetadataResourceVersion
MetadataResourceVersion AltJ CacheInvalidations -> CacheInvalidations
forall a. AltJ a -> a
Q.getAltJ)
    ([(Int64, AltJ CacheInvalidations)]
 -> [(MetadataResourceVersion, CacheInvalidations)])
-> TxET QErr IO [(Int64, AltJ CacheInvalidations)]
-> TxE QErr [(MetadataResourceVersion, CacheInvalidations)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PGTxErr -> QErr)
-> Query
-> (Int64, InstanceId)
-> Bool
-> TxET QErr IO [(Int64, AltJ CacheInvalidations)]
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
Q.withQE
      PGTxErr -> QErr
defaultTxErrorHandler
      [Q.sql|
         SELECT resource_version, notification
         FROM hdb_catalog.hdb_schema_notifications
         WHERE resource_version > $1 AND instance_id != ($2::uuid)
      |]
      (Int64
resourceVersion, InstanceId
instanceId)
      Bool
True

-- Used to increment metadata version when no other changes are required
bumpMetadataVersionInCatalog :: Q.TxE QErr ()
bumpMetadataVersionInCatalog :: TxE QErr ()
bumpMetadataVersionInCatalog = do
  (PGTxErr -> QErr) -> Query -> () -> Bool -> TxE QErr ()
forall (m :: * -> *) r e.
(MonadIO m, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m ()
Q.unitQE
    PGTxErr -> QErr
defaultTxErrorHandler
    [Q.sql|
      UPDATE hdb_catalog.hdb_metadata
      SET resource_version = hdb_catalog.hdb_metadata.resource_version + 1
      |]
    ()
    Bool
True

insertMetadataInCatalog :: Metadata -> Q.TxE QErr ()
insertMetadataInCatalog :: Metadata -> TxE QErr ()
insertMetadataInCatalog Metadata
metadata =
  (PGTxErr -> QErr)
-> Query -> Identity (AltJ Metadata) -> Bool -> TxE QErr ()
forall (m :: * -> *) r e.
(MonadIO m, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m ()
Q.unitQE
    PGTxErr -> QErr
defaultTxErrorHandler
    [Q.sql|
    INSERT INTO hdb_catalog.hdb_metadata(id, metadata)
    VALUES (1, $1::json)
    |]
    (AltJ Metadata -> Identity (AltJ Metadata)
forall a. a -> Identity a
Identity (AltJ Metadata -> Identity (AltJ Metadata))
-> AltJ Metadata -> Identity (AltJ Metadata)
forall a b. (a -> b) -> a -> b
$ Metadata -> AltJ Metadata
forall a. a -> AltJ a
Q.AltJ Metadata
metadata)
    Bool
True

-- | Check that the specified resource version matches the currently stored one, and...
--
-- - If so: Update the metadata and bump the version
-- - If not: Throw a 409 error
setMetadataInCatalog :: MetadataResourceVersion -> Metadata -> Q.TxE QErr MetadataResourceVersion
setMetadataInCatalog :: MetadataResourceVersion
-> Metadata -> TxE QErr MetadataResourceVersion
setMetadataInCatalog MetadataResourceVersion
resourceVersion Metadata
metadata = do
  [Identity Int64]
rows <-
    (PGTxErr -> QErr)
-> Query
-> (AltJ Metadata, Int64)
-> Bool
-> TxET QErr IO [Identity Int64]
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
Q.withQE
      PGTxErr -> QErr
defaultTxErrorHandler
      [Q.sql|
    INSERT INTO hdb_catalog.hdb_metadata(id, metadata)
    VALUES (1, $1::json)
    ON CONFLICT (id) DO UPDATE SET
      metadata = $1::json,
      resource_version = hdb_catalog.hdb_metadata.resource_version + 1
      WHERE hdb_catalog.hdb_metadata.resource_version = $2
    RETURNING resource_version
    |]
      (Metadata -> AltJ Metadata
forall a. a -> AltJ a
Q.AltJ Metadata
metadata, MetadataResourceVersion -> Int64
getMetadataResourceVersion MetadataResourceVersion
resourceVersion)
      Bool
True
  case [Identity Int64]
rows of
    [] -> Text -> TxE QErr MetadataResourceVersion
forall (m :: * -> *) a. QErrM m => Text -> m a
throw409 (Text -> TxE QErr MetadataResourceVersion)
-> Text -> TxE QErr MetadataResourceVersion
forall a b. (a -> b) -> a -> b
$ Text
"metadata resource version referenced (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow (MetadataResourceVersion -> Int64
getMetadataResourceVersion MetadataResourceVersion
resourceVersion) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") did not match current version"
    [Identity Int64
newResourceVersion] -> MetadataResourceVersion -> TxE QErr MetadataResourceVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetadataResourceVersion -> TxE QErr MetadataResourceVersion)
-> MetadataResourceVersion -> TxE QErr MetadataResourceVersion
forall a b. (a -> b) -> a -> b
$ Int64 -> MetadataResourceVersion
MetadataResourceVersion Int64
newResourceVersion
    [Identity Int64]
_ -> Text -> TxE QErr MetadataResourceVersion
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"multiple rows in hdb_metadata table"