{-# 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 PG
import Hasura.Backends.Postgres.Connection
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.SchemaCache
  ( MetadataResourceVersion (..),
    MetadataWithResourceVersion (..),
    initialResourceVersion,
  )
import Hasura.RQL.Types.SchemaCache.Build (CacheInvalidations)
import Hasura.Server.Types (InstanceId (..))

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

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

fetchMetadataResourceVersionFromCatalog :: PG.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
PG.withQE
      PGTxErr -> QErr
defaultTxErrorHandler
      [PG.sql|
       SELECT resource_version from hdb_catalog.hdb_metadata
    |]
      ()
      Bool
True
  case [Identity Int64]
rows of
    [] -> MetadataResourceVersion -> TxE QErr MetadataResourceVersion
forall a. a -> TxET QErr IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MetadataResourceVersion
initialResourceVersion
    [Identity Int64
resourceVersion] -> MetadataResourceVersion -> TxE QErr MetadataResourceVersion
forall a. a -> TxET QErr IO a
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 -> PG.TxE QErr [(MetadataResourceVersion, CacheInvalidations)]
fetchMetadataNotificationsFromCatalog :: MetadataResourceVersion
-> InstanceId
-> TxE QErr [(MetadataResourceVersion, CacheInvalidations)]
fetchMetadataNotificationsFromCatalog (MetadataResourceVersion Int64
resourceVersion) InstanceId
instanceId = do
  ((Int64, ViaJSON CacheInvalidations)
 -> (MetadataResourceVersion, CacheInvalidations))
-> [(Int64, ViaJSON CacheInvalidations)]
-> [(MetadataResourceVersion, CacheInvalidations)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int64 -> MetadataResourceVersion)
-> (ViaJSON CacheInvalidations -> CacheInvalidations)
-> (Int64, ViaJSON CacheInvalidations)
-> (MetadataResourceVersion, CacheInvalidations)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Int64 -> MetadataResourceVersion
MetadataResourceVersion ViaJSON CacheInvalidations -> CacheInvalidations
forall a. ViaJSON a -> a
PG.getViaJSON)
    ([(Int64, ViaJSON CacheInvalidations)]
 -> [(MetadataResourceVersion, CacheInvalidations)])
-> TxET QErr IO [(Int64, ViaJSON 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, ViaJSON CacheInvalidations)]
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
PG.withQE
      PGTxErr -> QErr
defaultTxErrorHandler
      [PG.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 :: PG.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 ()
PG.unitQE
    PGTxErr -> QErr
defaultTxErrorHandler
    [PG.sql|
      UPDATE hdb_catalog.hdb_metadata
      SET resource_version = hdb_catalog.hdb_metadata.resource_version + 1
      |]
    ()
    Bool
True

insertMetadataInCatalog :: Metadata -> PG.TxE QErr ()
insertMetadataInCatalog :: Metadata -> TxE QErr ()
insertMetadataInCatalog Metadata
metadata =
  (PGTxErr -> QErr)
-> Query -> Identity (ViaJSON Metadata) -> Bool -> TxE QErr ()
forall (m :: * -> *) r e.
(MonadIO m, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m ()
PG.unitQE
    PGTxErr -> QErr
defaultTxErrorHandler
    [PG.sql|
    INSERT INTO hdb_catalog.hdb_metadata(id, metadata)
    VALUES (1, $1::json)
    |]
    (ViaJSON Metadata -> Identity (ViaJSON Metadata)
forall a. a -> Identity a
Identity (ViaJSON Metadata -> Identity (ViaJSON Metadata))
-> ViaJSON Metadata -> Identity (ViaJSON Metadata)
forall a b. (a -> b) -> a -> b
$ Metadata -> ViaJSON Metadata
forall a. a -> ViaJSON a
PG.ViaJSON 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 -> PG.TxE QErr MetadataResourceVersion
setMetadataInCatalog :: MetadataResourceVersion
-> Metadata -> TxE QErr MetadataResourceVersion
setMetadataInCatalog MetadataResourceVersion
resourceVersion Metadata
metadata = do
  [Identity Int64]
rows <-
    (PGTxErr -> QErr)
-> Query
-> (ViaJSON 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
PG.withQE
      PGTxErr -> QErr
defaultTxErrorHandler
      [PG.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 -> ViaJSON Metadata
forall a. a -> ViaJSON a
PG.ViaJSON 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 a. a -> TxET QErr IO a
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"