{-# LANGUAGE DeriveAnyClass #-}

module Hasura.RQL.DDL.SchemaRegistry
  ( SchemaProjectId (..),
    IsMetadataInconsistent (..),
    SchemaSDL (..),
    SchemaHash (..),
    ProjectGQLSchemaInformation (..),
    SchemaRegistryConfig (..),
    SchemaRegistryDetails (..),
    GQLSchemaInformation (..),
    SchemaRegistryContext (..),
    SchemaRegistryControlRole (..),
    SchemaRegistryMap,
    SchemaRegistryDetailsList,
    SchemaRegistryAction,
    SchemaRegistryConfigRaw (..),
    calculateSchemaSDLHash,
    selectNowQuery,
  )
where

import Control.Concurrent.STM qualified as STM
import Data.Aeson qualified as J
import Data.Text qualified as T
import Data.Time (UTCTime)
import Database.PG.Query qualified as PG
import Hasura.Backends.Postgres.Execute.Types qualified as SQLTypes
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.Types.Metadata (Metadata)
import Hasura.RQL.Types.Metadata.Object (InconsistentMetadata)
import Hasura.RQL.Types.Roles
import Hasura.RQL.Types.SchemaCache (MetadataResourceVersion)
import Hasura.Server.Utils

{-
  SchemaRegistry

  About:
    The schema registry is a feature that is currently meant for
    our users of Hasura Cloud. This feature will help users track
    the evolution of their GraphQL schema across all Hasura roles.
    Additional functionality around tagging schemas and viewing
    the diff of the GraphQL schema across different versions of the
    schema.

    All of the types and other functions that are required for the
    functionality provided by the Hasura server pertaining to this
    feature are present in this file.

  Intended Current Functionality:
    1) Every time the `buildGQLContext` function is run to rebuild
       the GraphQL schema(s), the changes are captured and sent to
       the Hasura PRO server via a TQueue

    2) On the Hasura PRO server, a thread is always maintained to
       read from the aforementioned TQueue for new changes.

    3) The changes that are captured are then processed (more notes
       on this present on `HasuraPro.App` module) and a request with
       all relevant data is sent towards the schema_registry service.

  NOTE: The timestamp recorded as soon as the schema is rebuilt is
        obtained from the Metadata DB. This is done in order to
        make sure that we have only one source for the time to avoid
        clock-skew.

-}

newtype SchemaProjectId = SchemaProjectId {SchemaProjectId -> Text
_spiProjectId :: T.Text}
  deriving stock (SchemaProjectId -> SchemaProjectId -> Bool
(SchemaProjectId -> SchemaProjectId -> Bool)
-> (SchemaProjectId -> SchemaProjectId -> Bool)
-> Eq SchemaProjectId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaProjectId -> SchemaProjectId -> Bool
== :: SchemaProjectId -> SchemaProjectId -> Bool
$c/= :: SchemaProjectId -> SchemaProjectId -> Bool
/= :: SchemaProjectId -> SchemaProjectId -> Bool
Eq, Int -> SchemaProjectId -> ShowS
[SchemaProjectId] -> ShowS
SchemaProjectId -> String
(Int -> SchemaProjectId -> ShowS)
-> (SchemaProjectId -> String)
-> ([SchemaProjectId] -> ShowS)
-> Show SchemaProjectId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaProjectId -> ShowS
showsPrec :: Int -> SchemaProjectId -> ShowS
$cshow :: SchemaProjectId -> String
show :: SchemaProjectId -> String
$cshowList :: [SchemaProjectId] -> ShowS
showList :: [SchemaProjectId] -> ShowS
Show, (forall x. SchemaProjectId -> Rep SchemaProjectId x)
-> (forall x. Rep SchemaProjectId x -> SchemaProjectId)
-> Generic SchemaProjectId
forall x. Rep SchemaProjectId x -> SchemaProjectId
forall x. SchemaProjectId -> Rep SchemaProjectId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SchemaProjectId -> Rep SchemaProjectId x
from :: forall x. SchemaProjectId -> Rep SchemaProjectId x
$cto :: forall x. Rep SchemaProjectId x -> SchemaProjectId
to :: forall x. Rep SchemaProjectId x -> SchemaProjectId
Generic)
  deriving anyclass ([SchemaProjectId] -> Value
[SchemaProjectId] -> Encoding
SchemaProjectId -> Value
SchemaProjectId -> Encoding
(SchemaProjectId -> Value)
-> (SchemaProjectId -> Encoding)
-> ([SchemaProjectId] -> Value)
-> ([SchemaProjectId] -> Encoding)
-> ToJSON SchemaProjectId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SchemaProjectId -> Value
toJSON :: SchemaProjectId -> Value
$ctoEncoding :: SchemaProjectId -> Encoding
toEncoding :: SchemaProjectId -> Encoding
$ctoJSONList :: [SchemaProjectId] -> Value
toJSONList :: [SchemaProjectId] -> Value
$ctoEncodingList :: [SchemaProjectId] -> Encoding
toEncodingList :: [SchemaProjectId] -> Encoding
J.ToJSON, Value -> Parser [SchemaProjectId]
Value -> Parser SchemaProjectId
(Value -> Parser SchemaProjectId)
-> (Value -> Parser [SchemaProjectId]) -> FromJSON SchemaProjectId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SchemaProjectId
parseJSON :: Value -> Parser SchemaProjectId
$cparseJSONList :: Value -> Parser [SchemaProjectId]
parseJSONList :: Value -> Parser [SchemaProjectId]
J.FromJSON)

newtype IsMetadataInconsistent = IsMetadataInconsistent {IsMetadataInconsistent -> Bool
_isMdInconsistent :: Bool}
  deriving stock (IsMetadataInconsistent -> IsMetadataInconsistent -> Bool
(IsMetadataInconsistent -> IsMetadataInconsistent -> Bool)
-> (IsMetadataInconsistent -> IsMetadataInconsistent -> Bool)
-> Eq IsMetadataInconsistent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsMetadataInconsistent -> IsMetadataInconsistent -> Bool
== :: IsMetadataInconsistent -> IsMetadataInconsistent -> Bool
$c/= :: IsMetadataInconsistent -> IsMetadataInconsistent -> Bool
/= :: IsMetadataInconsistent -> IsMetadataInconsistent -> Bool
Eq, Int -> IsMetadataInconsistent -> ShowS
[IsMetadataInconsistent] -> ShowS
IsMetadataInconsistent -> String
(Int -> IsMetadataInconsistent -> ShowS)
-> (IsMetadataInconsistent -> String)
-> ([IsMetadataInconsistent] -> ShowS)
-> Show IsMetadataInconsistent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsMetadataInconsistent -> ShowS
showsPrec :: Int -> IsMetadataInconsistent -> ShowS
$cshow :: IsMetadataInconsistent -> String
show :: IsMetadataInconsistent -> String
$cshowList :: [IsMetadataInconsistent] -> ShowS
showList :: [IsMetadataInconsistent] -> ShowS
Show, (forall x. IsMetadataInconsistent -> Rep IsMetadataInconsistent x)
-> (forall x.
    Rep IsMetadataInconsistent x -> IsMetadataInconsistent)
-> Generic IsMetadataInconsistent
forall x. Rep IsMetadataInconsistent x -> IsMetadataInconsistent
forall x. IsMetadataInconsistent -> Rep IsMetadataInconsistent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IsMetadataInconsistent -> Rep IsMetadataInconsistent x
from :: forall x. IsMetadataInconsistent -> Rep IsMetadataInconsistent x
$cto :: forall x. Rep IsMetadataInconsistent x -> IsMetadataInconsistent
to :: forall x. Rep IsMetadataInconsistent x -> IsMetadataInconsistent
Generic)
  deriving anyclass ([IsMetadataInconsistent] -> Value
[IsMetadataInconsistent] -> Encoding
IsMetadataInconsistent -> Value
IsMetadataInconsistent -> Encoding
(IsMetadataInconsistent -> Value)
-> (IsMetadataInconsistent -> Encoding)
-> ([IsMetadataInconsistent] -> Value)
-> ([IsMetadataInconsistent] -> Encoding)
-> ToJSON IsMetadataInconsistent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: IsMetadataInconsistent -> Value
toJSON :: IsMetadataInconsistent -> Value
$ctoEncoding :: IsMetadataInconsistent -> Encoding
toEncoding :: IsMetadataInconsistent -> Encoding
$ctoJSONList :: [IsMetadataInconsistent] -> Value
toJSONList :: [IsMetadataInconsistent] -> Value
$ctoEncodingList :: [IsMetadataInconsistent] -> Encoding
toEncodingList :: [IsMetadataInconsistent] -> Encoding
J.ToJSON, Value -> Parser [IsMetadataInconsistent]
Value -> Parser IsMetadataInconsistent
(Value -> Parser IsMetadataInconsistent)
-> (Value -> Parser [IsMetadataInconsistent])
-> FromJSON IsMetadataInconsistent
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser IsMetadataInconsistent
parseJSON :: Value -> Parser IsMetadataInconsistent
$cparseJSONList :: Value -> Parser [IsMetadataInconsistent]
parseJSONList :: Value -> Parser [IsMetadataInconsistent]
J.FromJSON)

newtype SchemaSDL = SchemaSDL {SchemaSDL -> Text
_sdl :: T.Text}
  deriving stock (SchemaSDL -> SchemaSDL -> Bool
(SchemaSDL -> SchemaSDL -> Bool)
-> (SchemaSDL -> SchemaSDL -> Bool) -> Eq SchemaSDL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaSDL -> SchemaSDL -> Bool
== :: SchemaSDL -> SchemaSDL -> Bool
$c/= :: SchemaSDL -> SchemaSDL -> Bool
/= :: SchemaSDL -> SchemaSDL -> Bool
Eq, Int -> SchemaSDL -> ShowS
[SchemaSDL] -> ShowS
SchemaSDL -> String
(Int -> SchemaSDL -> ShowS)
-> (SchemaSDL -> String)
-> ([SchemaSDL] -> ShowS)
-> Show SchemaSDL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaSDL -> ShowS
showsPrec :: Int -> SchemaSDL -> ShowS
$cshow :: SchemaSDL -> String
show :: SchemaSDL -> String
$cshowList :: [SchemaSDL] -> ShowS
showList :: [SchemaSDL] -> ShowS
Show, (forall x. SchemaSDL -> Rep SchemaSDL x)
-> (forall x. Rep SchemaSDL x -> SchemaSDL) -> Generic SchemaSDL
forall x. Rep SchemaSDL x -> SchemaSDL
forall x. SchemaSDL -> Rep SchemaSDL x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SchemaSDL -> Rep SchemaSDL x
from :: forall x. SchemaSDL -> Rep SchemaSDL x
$cto :: forall x. Rep SchemaSDL x -> SchemaSDL
to :: forall x. Rep SchemaSDL x -> SchemaSDL
Generic)
  deriving anyclass ([SchemaSDL] -> Value
[SchemaSDL] -> Encoding
SchemaSDL -> Value
SchemaSDL -> Encoding
(SchemaSDL -> Value)
-> (SchemaSDL -> Encoding)
-> ([SchemaSDL] -> Value)
-> ([SchemaSDL] -> Encoding)
-> ToJSON SchemaSDL
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SchemaSDL -> Value
toJSON :: SchemaSDL -> Value
$ctoEncoding :: SchemaSDL -> Encoding
toEncoding :: SchemaSDL -> Encoding
$ctoJSONList :: [SchemaSDL] -> Value
toJSONList :: [SchemaSDL] -> Value
$ctoEncodingList :: [SchemaSDL] -> Encoding
toEncodingList :: [SchemaSDL] -> Encoding
J.ToJSON, Value -> Parser [SchemaSDL]
Value -> Parser SchemaSDL
(Value -> Parser SchemaSDL)
-> (Value -> Parser [SchemaSDL]) -> FromJSON SchemaSDL
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SchemaSDL
parseJSON :: Value -> Parser SchemaSDL
$cparseJSONList :: Value -> Parser [SchemaSDL]
parseJSONList :: Value -> Parser [SchemaSDL]
J.FromJSON)

newtype SchemaHash = SchemaHash {SchemaHash -> Text
_schemaHash :: T.Text}
  deriving stock (SchemaHash -> SchemaHash -> Bool
(SchemaHash -> SchemaHash -> Bool)
-> (SchemaHash -> SchemaHash -> Bool) -> Eq SchemaHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaHash -> SchemaHash -> Bool
== :: SchemaHash -> SchemaHash -> Bool
$c/= :: SchemaHash -> SchemaHash -> Bool
/= :: SchemaHash -> SchemaHash -> Bool
Eq, Int -> SchemaHash -> ShowS
[SchemaHash] -> ShowS
SchemaHash -> String
(Int -> SchemaHash -> ShowS)
-> (SchemaHash -> String)
-> ([SchemaHash] -> ShowS)
-> Show SchemaHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaHash -> ShowS
showsPrec :: Int -> SchemaHash -> ShowS
$cshow :: SchemaHash -> String
show :: SchemaHash -> String
$cshowList :: [SchemaHash] -> ShowS
showList :: [SchemaHash] -> ShowS
Show, (forall x. SchemaHash -> Rep SchemaHash x)
-> (forall x. Rep SchemaHash x -> SchemaHash) -> Generic SchemaHash
forall x. Rep SchemaHash x -> SchemaHash
forall x. SchemaHash -> Rep SchemaHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SchemaHash -> Rep SchemaHash x
from :: forall x. SchemaHash -> Rep SchemaHash x
$cto :: forall x. Rep SchemaHash x -> SchemaHash
to :: forall x. Rep SchemaHash x -> SchemaHash
Generic)
  deriving anyclass ([SchemaHash] -> Value
[SchemaHash] -> Encoding
SchemaHash -> Value
SchemaHash -> Encoding
(SchemaHash -> Value)
-> (SchemaHash -> Encoding)
-> ([SchemaHash] -> Value)
-> ([SchemaHash] -> Encoding)
-> ToJSON SchemaHash
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SchemaHash -> Value
toJSON :: SchemaHash -> Value
$ctoEncoding :: SchemaHash -> Encoding
toEncoding :: SchemaHash -> Encoding
$ctoJSONList :: [SchemaHash] -> Value
toJSONList :: [SchemaHash] -> Value
$ctoEncodingList :: [SchemaHash] -> Encoding
toEncodingList :: [SchemaHash] -> Encoding
J.ToJSON, Value -> Parser [SchemaHash]
Value -> Parser SchemaHash
(Value -> Parser SchemaHash)
-> (Value -> Parser [SchemaHash]) -> FromJSON SchemaHash
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SchemaHash
parseJSON :: Value -> Parser SchemaHash
$cparseJSONList :: Value -> Parser [SchemaHash]
parseJSONList :: Value -> Parser [SchemaHash]
J.FromJSON)

type SchemaRegistryMap = HashMap RoleName GQLSchemaInformation

type SchemaRegistryAction = Maybe (MetadataResourceVersion -> [InconsistentMetadata] -> Metadata -> IO ())

data GQLSchemaInformation = GQLSchemaInformation
  { GQLSchemaInformation -> SchemaSDL
_gsiSchemaSDL :: SchemaSDL,
    GQLSchemaInformation -> SchemaHash
_gsiSchemaHash :: SchemaHash
  }
  deriving stock (GQLSchemaInformation -> GQLSchemaInformation -> Bool
(GQLSchemaInformation -> GQLSchemaInformation -> Bool)
-> (GQLSchemaInformation -> GQLSchemaInformation -> Bool)
-> Eq GQLSchemaInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GQLSchemaInformation -> GQLSchemaInformation -> Bool
== :: GQLSchemaInformation -> GQLSchemaInformation -> Bool
$c/= :: GQLSchemaInformation -> GQLSchemaInformation -> Bool
/= :: GQLSchemaInformation -> GQLSchemaInformation -> Bool
Eq, Int -> GQLSchemaInformation -> ShowS
[GQLSchemaInformation] -> ShowS
GQLSchemaInformation -> String
(Int -> GQLSchemaInformation -> ShowS)
-> (GQLSchemaInformation -> String)
-> ([GQLSchemaInformation] -> ShowS)
-> Show GQLSchemaInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GQLSchemaInformation -> ShowS
showsPrec :: Int -> GQLSchemaInformation -> ShowS
$cshow :: GQLSchemaInformation -> String
show :: GQLSchemaInformation -> String
$cshowList :: [GQLSchemaInformation] -> ShowS
showList :: [GQLSchemaInformation] -> ShowS
Show, (forall x. GQLSchemaInformation -> Rep GQLSchemaInformation x)
-> (forall x. Rep GQLSchemaInformation x -> GQLSchemaInformation)
-> Generic GQLSchemaInformation
forall x. Rep GQLSchemaInformation x -> GQLSchemaInformation
forall x. GQLSchemaInformation -> Rep GQLSchemaInformation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GQLSchemaInformation -> Rep GQLSchemaInformation x
from :: forall x. GQLSchemaInformation -> Rep GQLSchemaInformation x
$cto :: forall x. Rep GQLSchemaInformation x -> GQLSchemaInformation
to :: forall x. Rep GQLSchemaInformation x -> GQLSchemaInformation
Generic)
  deriving anyclass (Value -> Parser [GQLSchemaInformation]
Value -> Parser GQLSchemaInformation
(Value -> Parser GQLSchemaInformation)
-> (Value -> Parser [GQLSchemaInformation])
-> FromJSON GQLSchemaInformation
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser GQLSchemaInformation
parseJSON :: Value -> Parser GQLSchemaInformation
$cparseJSONList :: Value -> Parser [GQLSchemaInformation]
parseJSONList :: Value -> Parser [GQLSchemaInformation]
J.FromJSON)

instance J.ToJSON GQLSchemaInformation where
  toJSON :: GQLSchemaInformation -> Value
toJSON (GQLSchemaInformation SchemaSDL
schemaSdl SchemaHash
schemaHash) =
    [Pair] -> Value
J.object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ Key
"schema_sdl" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= (SchemaSDL -> Text
_sdl SchemaSDL
schemaSdl),
          Key
"schema_hash" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= (SchemaHash -> Text
_schemaHash SchemaHash
schemaHash)
        ]

data ProjectGQLSchemaInformation = ProjectGQLSchemaInformation
  { ProjectGQLSchemaInformation -> SchemaRegistryMap
_pgsiSchemaRegistryMap :: SchemaRegistryMap,
    ProjectGQLSchemaInformation -> IsMetadataInconsistent
_pgsiIsMetadataInconsistent :: IsMetadataInconsistent,
    ProjectGQLSchemaInformation -> SchemaHash
_pgsiAdminSchemaHash :: SchemaHash,
    ProjectGQLSchemaInformation -> MetadataResourceVersion
_pgsiMetadataResourceVersion :: MetadataResourceVersion,
    ProjectGQLSchemaInformation -> UTCTime
_pgsiChangeRecordedAt :: UTCTime,
    ProjectGQLSchemaInformation -> Metadata
_pgsiMetadata :: Metadata
  }
  deriving stock (ProjectGQLSchemaInformation -> ProjectGQLSchemaInformation -> Bool
(ProjectGQLSchemaInformation
 -> ProjectGQLSchemaInformation -> Bool)
-> (ProjectGQLSchemaInformation
    -> ProjectGQLSchemaInformation -> Bool)
-> Eq ProjectGQLSchemaInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProjectGQLSchemaInformation -> ProjectGQLSchemaInformation -> Bool
== :: ProjectGQLSchemaInformation -> ProjectGQLSchemaInformation -> Bool
$c/= :: ProjectGQLSchemaInformation -> ProjectGQLSchemaInformation -> Bool
/= :: ProjectGQLSchemaInformation -> ProjectGQLSchemaInformation -> Bool
Eq, Int -> ProjectGQLSchemaInformation -> ShowS
[ProjectGQLSchemaInformation] -> ShowS
ProjectGQLSchemaInformation -> String
(Int -> ProjectGQLSchemaInformation -> ShowS)
-> (ProjectGQLSchemaInformation -> String)
-> ([ProjectGQLSchemaInformation] -> ShowS)
-> Show ProjectGQLSchemaInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjectGQLSchemaInformation -> ShowS
showsPrec :: Int -> ProjectGQLSchemaInformation -> ShowS
$cshow :: ProjectGQLSchemaInformation -> String
show :: ProjectGQLSchemaInformation -> String
$cshowList :: [ProjectGQLSchemaInformation] -> ShowS
showList :: [ProjectGQLSchemaInformation] -> ShowS
Show, (forall x.
 ProjectGQLSchemaInformation -> Rep ProjectGQLSchemaInformation x)
-> (forall x.
    Rep ProjectGQLSchemaInformation x -> ProjectGQLSchemaInformation)
-> Generic ProjectGQLSchemaInformation
forall x.
Rep ProjectGQLSchemaInformation x -> ProjectGQLSchemaInformation
forall x.
ProjectGQLSchemaInformation -> Rep ProjectGQLSchemaInformation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ProjectGQLSchemaInformation -> Rep ProjectGQLSchemaInformation x
from :: forall x.
ProjectGQLSchemaInformation -> Rep ProjectGQLSchemaInformation x
$cto :: forall x.
Rep ProjectGQLSchemaInformation x -> ProjectGQLSchemaInformation
to :: forall x.
Rep ProjectGQLSchemaInformation x -> ProjectGQLSchemaInformation
Generic)
  deriving anyclass (Value -> Parser [ProjectGQLSchemaInformation]
Value -> Parser ProjectGQLSchemaInformation
(Value -> Parser ProjectGQLSchemaInformation)
-> (Value -> Parser [ProjectGQLSchemaInformation])
-> FromJSON ProjectGQLSchemaInformation
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ProjectGQLSchemaInformation
parseJSON :: Value -> Parser ProjectGQLSchemaInformation
$cparseJSONList :: Value -> Parser [ProjectGQLSchemaInformation]
parseJSONList :: Value -> Parser [ProjectGQLSchemaInformation]
J.FromJSON, [ProjectGQLSchemaInformation] -> Value
[ProjectGQLSchemaInformation] -> Encoding
ProjectGQLSchemaInformation -> Value
ProjectGQLSchemaInformation -> Encoding
(ProjectGQLSchemaInformation -> Value)
-> (ProjectGQLSchemaInformation -> Encoding)
-> ([ProjectGQLSchemaInformation] -> Value)
-> ([ProjectGQLSchemaInformation] -> Encoding)
-> ToJSON ProjectGQLSchemaInformation
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ProjectGQLSchemaInformation -> Value
toJSON :: ProjectGQLSchemaInformation -> Value
$ctoEncoding :: ProjectGQLSchemaInformation -> Encoding
toEncoding :: ProjectGQLSchemaInformation -> Encoding
$ctoJSONList :: [ProjectGQLSchemaInformation] -> Value
toJSONList :: [ProjectGQLSchemaInformation] -> Value
$ctoEncodingList :: [ProjectGQLSchemaInformation] -> Encoding
toEncodingList :: [ProjectGQLSchemaInformation] -> Encoding
J.ToJSON)

data SchemaRegistryConfig = SchemaRegistryConfig
  { SchemaRegistryConfig -> Text
_srcSchemaRegistryWebhook :: T.Text,
    SchemaRegistryConfig -> Maybe Text
_srcSchemaRegistryAccessKey :: Maybe T.Text
  }
  deriving stock (SchemaRegistryConfig -> SchemaRegistryConfig -> Bool
(SchemaRegistryConfig -> SchemaRegistryConfig -> Bool)
-> (SchemaRegistryConfig -> SchemaRegistryConfig -> Bool)
-> Eq SchemaRegistryConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaRegistryConfig -> SchemaRegistryConfig -> Bool
== :: SchemaRegistryConfig -> SchemaRegistryConfig -> Bool
$c/= :: SchemaRegistryConfig -> SchemaRegistryConfig -> Bool
/= :: SchemaRegistryConfig -> SchemaRegistryConfig -> Bool
Eq, Int -> SchemaRegistryConfig -> ShowS
[SchemaRegistryConfig] -> ShowS
SchemaRegistryConfig -> String
(Int -> SchemaRegistryConfig -> ShowS)
-> (SchemaRegistryConfig -> String)
-> ([SchemaRegistryConfig] -> ShowS)
-> Show SchemaRegistryConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaRegistryConfig -> ShowS
showsPrec :: Int -> SchemaRegistryConfig -> ShowS
$cshow :: SchemaRegistryConfig -> String
show :: SchemaRegistryConfig -> String
$cshowList :: [SchemaRegistryConfig] -> ShowS
showList :: [SchemaRegistryConfig] -> ShowS
Show)

data SchemaRegistryConfigRaw = SchemaRegistryConfigRaw
  { SchemaRegistryConfigRaw -> Maybe Text
_srcrSchemaRegistryWebhook :: Maybe T.Text,
    SchemaRegistryConfigRaw -> Maybe Text
_srcrSchemaRegistryAccessKey :: Maybe T.Text
  }
  deriving stock (SchemaRegistryConfigRaw -> SchemaRegistryConfigRaw -> Bool
(SchemaRegistryConfigRaw -> SchemaRegistryConfigRaw -> Bool)
-> (SchemaRegistryConfigRaw -> SchemaRegistryConfigRaw -> Bool)
-> Eq SchemaRegistryConfigRaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaRegistryConfigRaw -> SchemaRegistryConfigRaw -> Bool
== :: SchemaRegistryConfigRaw -> SchemaRegistryConfigRaw -> Bool
$c/= :: SchemaRegistryConfigRaw -> SchemaRegistryConfigRaw -> Bool
/= :: SchemaRegistryConfigRaw -> SchemaRegistryConfigRaw -> Bool
Eq, Int -> SchemaRegistryConfigRaw -> ShowS
[SchemaRegistryConfigRaw] -> ShowS
SchemaRegistryConfigRaw -> String
(Int -> SchemaRegistryConfigRaw -> ShowS)
-> (SchemaRegistryConfigRaw -> String)
-> ([SchemaRegistryConfigRaw] -> ShowS)
-> Show SchemaRegistryConfigRaw
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaRegistryConfigRaw -> ShowS
showsPrec :: Int -> SchemaRegistryConfigRaw -> ShowS
$cshow :: SchemaRegistryConfigRaw -> String
show :: SchemaRegistryConfigRaw -> String
$cshowList :: [SchemaRegistryConfigRaw] -> ShowS
showList :: [SchemaRegistryConfigRaw] -> ShowS
Show)

data SchemaRegistryDetails = SchemaRegistryDetails
  { SchemaRegistryDetails -> RoleName
_srdlSchemaRole :: RoleName,
    SchemaRegistryDetails -> GQLSchemaInformation
_srdlSchemaInfo :: GQLSchemaInformation
  }
  deriving stock (SchemaRegistryDetails -> SchemaRegistryDetails -> Bool
(SchemaRegistryDetails -> SchemaRegistryDetails -> Bool)
-> (SchemaRegistryDetails -> SchemaRegistryDetails -> Bool)
-> Eq SchemaRegistryDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaRegistryDetails -> SchemaRegistryDetails -> Bool
== :: SchemaRegistryDetails -> SchemaRegistryDetails -> Bool
$c/= :: SchemaRegistryDetails -> SchemaRegistryDetails -> Bool
/= :: SchemaRegistryDetails -> SchemaRegistryDetails -> Bool
Eq, Int -> SchemaRegistryDetails -> ShowS
[SchemaRegistryDetails] -> ShowS
SchemaRegistryDetails -> String
(Int -> SchemaRegistryDetails -> ShowS)
-> (SchemaRegistryDetails -> String)
-> ([SchemaRegistryDetails] -> ShowS)
-> Show SchemaRegistryDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaRegistryDetails -> ShowS
showsPrec :: Int -> SchemaRegistryDetails -> ShowS
$cshow :: SchemaRegistryDetails -> String
show :: SchemaRegistryDetails -> String
$cshowList :: [SchemaRegistryDetails] -> ShowS
showList :: [SchemaRegistryDetails] -> ShowS
Show, (forall x. SchemaRegistryDetails -> Rep SchemaRegistryDetails x)
-> (forall x. Rep SchemaRegistryDetails x -> SchemaRegistryDetails)
-> Generic SchemaRegistryDetails
forall x. Rep SchemaRegistryDetails x -> SchemaRegistryDetails
forall x. SchemaRegistryDetails -> Rep SchemaRegistryDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SchemaRegistryDetails -> Rep SchemaRegistryDetails x
from :: forall x. SchemaRegistryDetails -> Rep SchemaRegistryDetails x
$cto :: forall x. Rep SchemaRegistryDetails x -> SchemaRegistryDetails
to :: forall x. Rep SchemaRegistryDetails x -> SchemaRegistryDetails
Generic)
  deriving anyclass (Value -> Parser [SchemaRegistryDetails]
Value -> Parser SchemaRegistryDetails
(Value -> Parser SchemaRegistryDetails)
-> (Value -> Parser [SchemaRegistryDetails])
-> FromJSON SchemaRegistryDetails
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SchemaRegistryDetails
parseJSON :: Value -> Parser SchemaRegistryDetails
$cparseJSONList :: Value -> Parser [SchemaRegistryDetails]
parseJSONList :: Value -> Parser [SchemaRegistryDetails]
J.FromJSON)

instance J.ToJSON SchemaRegistryDetails where
  toJSON :: SchemaRegistryDetails -> Value
toJSON (SchemaRegistryDetails RoleName
schemaRole GQLSchemaInformation
schemaInfo) =
    [Pair] -> Value
J.object
      [ Key
"hasura_schema_role" Key -> RoleName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= RoleName
schemaRole,
        Key
"schema_info" Key -> GQLSchemaInformation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= GQLSchemaInformation
schemaInfo
      ]

type SchemaRegistryDetailsList = [SchemaRegistryDetails]

-- | Context required to upate schema registry everytime the schema is updated
data SchemaRegistryContext = SchemaRegistryContext
  { SchemaRegistryContext -> TQueue ProjectGQLSchemaInformation
_srpaSchemaRegistryTQueueRef :: STM.TQueue ProjectGQLSchemaInformation,
    SchemaRegistryContext -> PGPool
_srpaMetadataDbPoolRef :: PG.PGPool
  }

newtype SchemaRegistryControlRole = SchemaRegistryControlRole {SchemaRegistryControlRole -> Text
unSchemaRegistryControlRole :: T.Text}
  deriving stock (SchemaRegistryControlRole -> SchemaRegistryControlRole -> Bool
(SchemaRegistryControlRole -> SchemaRegistryControlRole -> Bool)
-> (SchemaRegistryControlRole -> SchemaRegistryControlRole -> Bool)
-> Eq SchemaRegistryControlRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaRegistryControlRole -> SchemaRegistryControlRole -> Bool
== :: SchemaRegistryControlRole -> SchemaRegistryControlRole -> Bool
$c/= :: SchemaRegistryControlRole -> SchemaRegistryControlRole -> Bool
/= :: SchemaRegistryControlRole -> SchemaRegistryControlRole -> Bool
Eq, Int -> SchemaRegistryControlRole -> ShowS
[SchemaRegistryControlRole] -> ShowS
SchemaRegistryControlRole -> String
(Int -> SchemaRegistryControlRole -> ShowS)
-> (SchemaRegistryControlRole -> String)
-> ([SchemaRegistryControlRole] -> ShowS)
-> Show SchemaRegistryControlRole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaRegistryControlRole -> ShowS
showsPrec :: Int -> SchemaRegistryControlRole -> ShowS
$cshow :: SchemaRegistryControlRole -> String
show :: SchemaRegistryControlRole -> String
$cshowList :: [SchemaRegistryControlRole] -> ShowS
showList :: [SchemaRegistryControlRole] -> ShowS
Show)

selectNowQuery :: PG.TxE QErr UTCTime
selectNowQuery :: TxE QErr UTCTime
selectNowQuery =
  Identity UTCTime -> UTCTime
forall a. Identity a -> a
runIdentity
    (Identity UTCTime -> UTCTime)
-> (SingleRow (Identity UTCTime) -> Identity UTCTime)
-> SingleRow (Identity UTCTime)
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (Identity UTCTime) -> Identity UTCTime
forall a. SingleRow a -> a
PG.getRow
    (SingleRow (Identity UTCTime) -> UTCTime)
-> TxET QErr IO (SingleRow (Identity UTCTime)) -> TxE QErr UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PGTxErr -> QErr)
-> Query
-> ()
-> Bool
-> TxET QErr IO (SingleRow (Identity UTCTime))
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
PG.withQE PGTxErr -> QErr
SQLTypes.defaultTxErrorHandler (Text -> Query
PG.fromText Text
"SELECT now();") () Bool
False

calculateSchemaSDLHash :: T.Text -> RoleName -> SchemaHash
calculateSchemaSDLHash :: Text -> RoleName -> SchemaHash
calculateSchemaSDLHash Text
sdl RoleName
role = Text -> SchemaHash
SchemaHash (Text -> SchemaHash) -> Text -> SchemaHash
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
bsToTxt ByteString
hash
  where
    hash :: ByteString
hash =
      Value -> ByteString
forall a. ToJSON a => a -> ByteString
cryptoHash
        (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
J.object
          [ Key
"schema_sdl" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text
sdl,
            Key
"role" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= RoleName -> Text
roleNameToTxt RoleName
role
          ]