{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | In order to avoid circular dependencies while splitting
-- 'Hasura.RQL.Types.Metadata' into multiple modules, some definitions must be
-- moved out of that module. This module is the bucket for definitions that have
-- not been specifically moved elsewhere.
module Hasura.RQL.Types.Metadata.Common
  ( Actions,
    BackendConfigWrapper (..),
    BackendSourceMetadata (..),
    CatalogState (..),
    CatalogStateType (..),
    ComputedFieldMetadata (..),
    CronTriggers,
    LogicalModels,
    Endpoints,
    NativeQueries,
    StoredProcedures,
    EventTriggers,
    Functions,
    GetCatalogState (..),
    InheritedRoles,
    QueryCollections,
    RemoteSchemaMetadata,
    RemoteSchemas,
    SetCatalogState (..),
    SourceMetadata (..),
    Sources,
    Tables,
    backendSourceMetadataCodec,
    getSourceName,
    mkSourceMetadata,
    parseNonSourcesMetadata,
    smConfiguration,
    smFunctions,
    smKind,
    smName,
    smQueryTags,
    smTables,
    smCustomization,
    smNativeQueries,
    smStoredProcedures,
    smLogicalModels,
    smHealthCheckConfig,
    sourcesCodec,
    toSourceMetadata,
  )
where

import Autodocodec hiding (object, (.=))
import Autodocodec qualified as AC
import Control.Lens hiding (set, (.=))
import Data.Aeson.Casing
import Data.Aeson.Extended (FromJSONWithContext (..))
import Data.Aeson.Types
import Data.HashMap.Strict.InsOrd.Autodocodec (sortedElemsCodec, sortedElemsCodecWith)
import Data.List.Extended qualified as L
import Data.Maybe (fromJust)
import Data.Text qualified as T
import Data.Text.Extended qualified as T
import Hasura.Function.Metadata (FunctionMetadata (..))
import Hasura.LogicalModel.Metadata (LogicalModelMetadata (..), LogicalModelName)
import Hasura.NativeQuery.Metadata (NativeQueryMetadata (..), NativeQueryName)
import Hasura.Prelude
import Hasura.QueryTags.Types
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Allowlist
import Hasura.RQL.Types.ApiLimit
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendTag (BackendTag, HasTag (backendTag), backendPrefix)
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.CustomTypes
import Hasura.RQL.Types.Endpoint
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.GraphqlSchemaIntrospection
import Hasura.RQL.Types.HealthCheck
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.Relationships.Remote
import Hasura.RQL.Types.Roles
import Hasura.RQL.Types.ScheduledTrigger
import Hasura.RQL.Types.SourceCustomization
import Hasura.RemoteSchema.Metadata
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.StoredProcedure.Metadata (StoredProcedureMetadata (..))
import Hasura.Table.Metadata

-- | Parse a list of objects into a map from a derived key,
-- failing if the list has duplicates.
parseListAsMap ::
  (Hashable k, T.ToTxt k) =>
  Text ->
  (a -> k) ->
  Parser [a] ->
  Parser (InsOrdHashMap k a)
parseListAsMap :: forall k a.
(Hashable k, ToTxt k) =>
Text -> (a -> k) -> Parser [a] -> Parser (InsOrdHashMap k a)
parseListAsMap Text
things a -> k
mapFn Parser [a]
listP = do
  [a]
list <- Parser [a]
listP
  let duplicates :: [k]
duplicates = HashSet k -> [k]
forall a. HashSet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (HashSet k -> [k]) -> HashSet k -> [k]
forall a b. (a -> b) -> a -> b
$ [k] -> HashSet k
forall a. Hashable a => [a] -> HashSet a
L.duplicates ([k] -> HashSet k) -> [k] -> HashSet k
forall a b. (a -> b) -> a -> b
$ (a -> k) -> [a] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map a -> k
mapFn [a]
list
  Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [k]
duplicates)
    (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
    (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack
    (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"multiple declarations exist for the following "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
things
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [k] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
T.commaSeparated [k]
duplicates
  InsOrdHashMap k a -> Parser (InsOrdHashMap k a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InsOrdHashMap k a -> Parser (InsOrdHashMap k a))
-> InsOrdHashMap k a -> Parser (InsOrdHashMap k a)
forall a b. (a -> b) -> a -> b
$ (a -> k) -> [a] -> InsOrdHashMap k a
forall k a. Hashable k => (a -> k) -> [a] -> InsOrdHashMap k a
oMapFromL a -> k
mapFn [a]
list

type EventTriggers b = InsOrdHashMap TriggerName (EventTriggerConf b)

type RemoteSchemaMetadata = RemoteSchemaMetadataG RemoteRelationshipDefinition

type RemoteSchemas = InsOrdHashMap RemoteSchemaName RemoteSchemaMetadata

type Tables b = InsOrdHashMap (TableName b) (TableMetadata b)

type Functions b = InsOrdHashMap (FunctionName b) (FunctionMetadata b)

type NativeQueries b = InsOrdHashMap NativeQueryName (NativeQueryMetadata b)

type StoredProcedures b = InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)

type LogicalModels b = InsOrdHashMap LogicalModelName (LogicalModelMetadata b)

type Endpoints = InsOrdHashMap EndpointName CreateEndpoint

type Actions = InsOrdHashMap ActionName ActionMetadata

type CronTriggers = InsOrdHashMap TriggerName CronTriggerMetadata

type InheritedRoles = InsOrdHashMap RoleName InheritedRole

-- | Source configuration for a source of backend type @b@ as stored in the Metadata DB.
data SourceMetadata b = SourceMetadata
  { forall (b :: BackendType). SourceMetadata b -> SourceName
_smName :: SourceName,
    forall (b :: BackendType). SourceMetadata b -> BackendSourceKind b
_smKind :: BackendSourceKind b,
    forall (b :: BackendType). SourceMetadata b -> Tables b
_smTables :: Tables b,
    forall (b :: BackendType). SourceMetadata b -> Functions b
_smFunctions :: Functions b,
    forall (b :: BackendType). SourceMetadata b -> NativeQueries b
_smNativeQueries :: NativeQueries b,
    forall (b :: BackendType). SourceMetadata b -> StoredProcedures b
_smStoredProcedures :: StoredProcedures b,
    forall (b :: BackendType). SourceMetadata b -> LogicalModels b
_smLogicalModels :: LogicalModels b,
    forall (b :: BackendType).
SourceMetadata b -> SourceConnConfiguration b
_smConfiguration :: SourceConnConfiguration b,
    forall (b :: BackendType).
SourceMetadata b -> Maybe QueryTagsConfig
_smQueryTags :: Maybe QueryTagsConfig,
    forall (b :: BackendType). SourceMetadata b -> SourceCustomization
_smCustomization :: SourceCustomization,
    -- | https://hasura.io/docs/latest/deployment/health-checks/source-health-check/
    forall (b :: BackendType).
SourceMetadata b -> Maybe (HealthCheckConfig b)
_smHealthCheckConfig :: Maybe (HealthCheckConfig b)
  }
  deriving ((forall x. SourceMetadata b -> Rep (SourceMetadata b) x)
-> (forall x. Rep (SourceMetadata b) x -> SourceMetadata b)
-> Generic (SourceMetadata b)
forall x. Rep (SourceMetadata b) x -> SourceMetadata b
forall x. SourceMetadata b -> Rep (SourceMetadata b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (SourceMetadata b) x -> SourceMetadata b
forall (b :: BackendType) x.
SourceMetadata b -> Rep (SourceMetadata b) x
$cfrom :: forall (b :: BackendType) x.
SourceMetadata b -> Rep (SourceMetadata b) x
from :: forall x. SourceMetadata b -> Rep (SourceMetadata b) x
$cto :: forall (b :: BackendType) x.
Rep (SourceMetadata b) x -> SourceMetadata b
to :: forall x. Rep (SourceMetadata b) x -> SourceMetadata b
Generic)

$(makeLenses ''SourceMetadata)

deriving instance (Backend b) => Show (SourceMetadata b)

deriving instance (Backend b) => Eq (SourceMetadata b)

instance (Backend b) => FromJSONWithContext (BackendSourceKind b) (SourceMetadata b) where
  parseJSONWithContext :: BackendSourceKind b -> Value -> Parser (SourceMetadata b)
parseJSONWithContext BackendSourceKind b
_smKind = String
-> (Object -> Parser (SourceMetadata b))
-> Value
-> Parser (SourceMetadata b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Object" ((Object -> Parser (SourceMetadata b))
 -> Value -> Parser (SourceMetadata b))
-> (Object -> Parser (SourceMetadata b))
-> Value
-> Parser (SourceMetadata b)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    SourceName
_smName <- Object
o Object -> Key -> Parser SourceName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    InsOrdHashMap (TableName b) (TableMetadata b)
_smTables <- (TableMetadata b -> TableName b)
-> [TableMetadata b]
-> InsOrdHashMap (TableName b) (TableMetadata b)
forall k a. Hashable k => (a -> k) -> [a] -> InsOrdHashMap k a
oMapFromL TableMetadata b -> TableName b
forall (b :: BackendType). TableMetadata b -> TableName b
_tmTable ([TableMetadata b]
 -> InsOrdHashMap (TableName b) (TableMetadata b))
-> Parser [TableMetadata b]
-> Parser (InsOrdHashMap (TableName b) (TableMetadata b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [TableMetadata b]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tables"
    InsOrdHashMap (FunctionName b) (FunctionMetadata b)
_smFunctions <- (FunctionMetadata b -> FunctionName b)
-> [FunctionMetadata b]
-> InsOrdHashMap (FunctionName b) (FunctionMetadata b)
forall k a. Hashable k => (a -> k) -> [a] -> InsOrdHashMap k a
oMapFromL FunctionMetadata b -> FunctionName b
forall (b :: BackendType). FunctionMetadata b -> FunctionName b
_fmFunction ([FunctionMetadata b]
 -> InsOrdHashMap (FunctionName b) (FunctionMetadata b))
-> Parser [FunctionMetadata b]
-> Parser (InsOrdHashMap (FunctionName b) (FunctionMetadata b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [FunctionMetadata b])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"functions" Parser (Maybe [FunctionMetadata b])
-> [FunctionMetadata b] -> Parser [FunctionMetadata b]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
_smNativeQueries <- (NativeQueryMetadata b -> NativeQueryName)
-> [NativeQueryMetadata b]
-> InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
forall k a. Hashable k => (a -> k) -> [a] -> InsOrdHashMap k a
oMapFromL NativeQueryMetadata b -> NativeQueryName
forall (b :: BackendType). NativeQueryMetadata b -> NativeQueryName
_nqmRootFieldName ([NativeQueryMetadata b]
 -> InsOrdHashMap NativeQueryName (NativeQueryMetadata b))
-> Parser [NativeQueryMetadata b]
-> Parser (InsOrdHashMap NativeQueryName (NativeQueryMetadata b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [NativeQueryMetadata b])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"native_queries" Parser (Maybe [NativeQueryMetadata b])
-> [NativeQueryMetadata b] -> Parser [NativeQueryMetadata b]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
_smStoredProcedures <- (StoredProcedureMetadata b -> FunctionName b)
-> [StoredProcedureMetadata b]
-> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
forall k a. Hashable k => (a -> k) -> [a] -> InsOrdHashMap k a
oMapFromL StoredProcedureMetadata b -> FunctionName b
forall (b :: BackendType).
StoredProcedureMetadata b -> FunctionName b
_spmStoredProcedure ([StoredProcedureMetadata b]
 -> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b))
-> Parser [StoredProcedureMetadata b]
-> Parser
     (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [StoredProcedureMetadata b])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"stored_procedures" Parser (Maybe [StoredProcedureMetadata b])
-> [StoredProcedureMetadata b]
-> Parser [StoredProcedureMetadata b]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    InsOrdHashMap LogicalModelName (LogicalModelMetadata b)
_smLogicalModels <- (LogicalModelMetadata b -> LogicalModelName)
-> [LogicalModelMetadata b]
-> InsOrdHashMap LogicalModelName (LogicalModelMetadata b)
forall k a. Hashable k => (a -> k) -> [a] -> InsOrdHashMap k a
oMapFromL LogicalModelMetadata b -> LogicalModelName
forall (b :: BackendType).
LogicalModelMetadata b -> LogicalModelName
_lmmName ([LogicalModelMetadata b]
 -> InsOrdHashMap LogicalModelName (LogicalModelMetadata b))
-> Parser [LogicalModelMetadata b]
-> Parser (InsOrdHashMap LogicalModelName (LogicalModelMetadata b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [LogicalModelMetadata b])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"logical_models" Parser (Maybe [LogicalModelMetadata b])
-> [LogicalModelMetadata b] -> Parser [LogicalModelMetadata b]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    SourceConnConfiguration b
_smConfiguration <- Object
o Object -> Key -> Parser (SourceConnConfiguration b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"configuration"
    Maybe QueryTagsConfig
_smQueryTags <- Object
o Object -> Key -> Parser (Maybe QueryTagsConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"query_tags"
    SourceCustomization
_smCustomization <- Object
o Object -> Key -> Parser (Maybe SourceCustomization)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"customization" Parser (Maybe SourceCustomization)
-> SourceCustomization -> Parser SourceCustomization
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceCustomization
emptySourceCustomization
    Maybe (HealthCheckConfig b)
_smHealthCheckConfig <- Object
o Object -> Key -> Parser (Maybe (HealthCheckConfig b))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"health_check"
    SourceMetadata b -> Parser (SourceMetadata b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceMetadata {Maybe QueryTagsConfig
Maybe (HealthCheckConfig b)
InsOrdHashMap (TableName b) (TableMetadata b)
InsOrdHashMap (FunctionName b) (FunctionMetadata b)
InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
InsOrdHashMap LogicalModelName (LogicalModelMetadata b)
InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
BackendSourceKind b
SourceName
SourceConnConfiguration b
SourceCustomization
_smName :: SourceName
_smKind :: BackendSourceKind b
_smTables :: InsOrdHashMap (TableName b) (TableMetadata b)
_smFunctions :: InsOrdHashMap (FunctionName b) (FunctionMetadata b)
_smNativeQueries :: InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
_smStoredProcedures :: InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
_smLogicalModels :: InsOrdHashMap LogicalModelName (LogicalModelMetadata b)
_smConfiguration :: SourceConnConfiguration b
_smQueryTags :: Maybe QueryTagsConfig
_smCustomization :: SourceCustomization
_smHealthCheckConfig :: Maybe (HealthCheckConfig b)
_smKind :: BackendSourceKind b
_smName :: SourceName
_smTables :: InsOrdHashMap (TableName b) (TableMetadata b)
_smFunctions :: InsOrdHashMap (FunctionName b) (FunctionMetadata b)
_smNativeQueries :: InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
_smStoredProcedures :: InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
_smLogicalModels :: InsOrdHashMap LogicalModelName (LogicalModelMetadata b)
_smConfiguration :: SourceConnConfiguration b
_smQueryTags :: Maybe QueryTagsConfig
_smCustomization :: SourceCustomization
_smHealthCheckConfig :: Maybe (HealthCheckConfig b)
..}

backendSourceMetadataCodec :: JSONCodec BackendSourceMetadata
backendSourceMetadataCodec :: JSONCodec BackendSourceMetadata
backendSourceMetadataCodec =
  Text
-> JSONCodec BackendSourceMetadata
-> JSONCodec BackendSourceMetadata
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"SourceMetadata"
    (JSONCodec BackendSourceMetadata
 -> JSONCodec BackendSourceMetadata)
-> JSONCodec BackendSourceMetadata
-> JSONCodec BackendSourceMetadata
forall a b. (a -> b) -> a -> b
$
    -- Attempt to match against @SourceMetadata@ codecs for each native backend
    -- type. If none match then apply the @SourceMetadata DataConnector@ codec.
    -- DataConnector is the fallback case because the possible values for its
    -- @_smKind@ property are not statically-known so it is difficult to
    -- unambiguously distinguish a native source value from a dataconnector
    -- source.
    [(BackendSourceMetadata -> Maybe BackendSourceMetadata,
  JSONCodec BackendSourceMetadata)]
-> JSONCodec BackendSourceMetadata
-> JSONCodec BackendSourceMetadata
forall input context output.
[(input -> Maybe input, Codec context input output)]
-> Codec context input output -> Codec context input output
disjointMatchChoicesCodec
      (BackendType
-> (BackendSourceMetadata -> Maybe BackendSourceMetadata,
    JSONCodec BackendSourceMetadata)
matcherWithBackendCodec (BackendType
 -> (BackendSourceMetadata -> Maybe BackendSourceMetadata,
     JSONCodec BackendSourceMetadata))
-> [BackendType]
-> [(BackendSourceMetadata -> Maybe BackendSourceMetadata,
     JSONCodec BackendSourceMetadata)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BackendType -> Bool) -> [BackendType] -> [BackendType]
forall a. (a -> Bool) -> [a] -> [a]
filter (BackendType -> BackendType -> Bool
forall a. Eq a => a -> a -> Bool
/= BackendType
DataConnector) [BackendType]
supportedBackends) -- list of codecs to try
      (BackendTag 'DataConnector -> JSONCodec BackendSourceMetadata
forall (b :: BackendType).
Backend b =>
BackendTag b -> JSONCodec BackendSourceMetadata
mkCodec (forall (b :: BackendType). HasTag b => BackendTag b
backendTag @('DataConnector))) -- codec for fallback case
  where
    matcherWithBackendCodec :: BackendType -> (BackendSourceMetadata -> Maybe BackendSourceMetadata, JSONCodec BackendSourceMetadata)
    matcherWithBackendCodec :: BackendType
-> (BackendSourceMetadata -> Maybe BackendSourceMetadata,
    JSONCodec BackendSourceMetadata)
matcherWithBackendCodec BackendType
backendType =
      (BackendType -> BackendSourceMetadata -> Maybe BackendSourceMetadata
matches BackendType
backendType, forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend (BackendType -> AnyBackend BackendTag
AB.liftTag BackendType
backendType) BackendTag b -> JSONCodec BackendSourceMetadata
forall (b :: BackendType).
Backend b =>
BackendTag b -> JSONCodec BackendSourceMetadata
mkCodec)

    mkCodec :: forall b. (Backend b) => (BackendTag b) -> JSONCodec BackendSourceMetadata
    mkCodec :: forall (b :: BackendType).
Backend b =>
BackendTag b -> JSONCodec BackendSourceMetadata
mkCodec BackendTag b
_ = JSONCodec (SourceMetadata b) -> JSONCodec BackendSourceMetadata
forall (b :: BackendType).
HasTag b =>
JSONCodec (SourceMetadata b) -> JSONCodec BackendSourceMetadata
anySourceMetadataCodec (JSONCodec (SourceMetadata b) -> JSONCodec BackendSourceMetadata)
-> JSONCodec (SourceMetadata b) -> JSONCodec BackendSourceMetadata
forall a b. (a -> b) -> a -> b
$ forall value. HasCodec value => JSONCodec value
codec @(SourceMetadata b)

    matches :: BackendType -> BackendSourceMetadata -> Maybe BackendSourceMetadata
    matches :: BackendType -> BackendSourceMetadata -> Maybe BackendSourceMetadata
matches BackendType
backendType BackendSourceMetadata
input =
      if BackendSourceMetadata -> BackendType
runBackendType BackendSourceMetadata
input BackendType -> BackendType -> Bool
forall a. Eq a => a -> a -> Bool
== BackendType
backendType
        then BackendSourceMetadata -> Maybe BackendSourceMetadata
forall a. a -> Maybe a
Just BackendSourceMetadata
input
        else Maybe BackendSourceMetadata
forall a. Maybe a
Nothing

    runBackendType :: BackendSourceMetadata -> BackendType
    runBackendType :: BackendSourceMetadata -> BackendType
runBackendType (BackendSourceMetadata AnyBackend SourceMetadata
input) = AnyBackend SourceMetadata
-> (forall (b :: BackendType). SourceMetadata b -> BackendType)
-> BackendType
forall (i :: BackendType -> *) r.
AnyBackend i -> (forall (b :: BackendType). i b -> r) -> r
AB.runBackend AnyBackend SourceMetadata
input \SourceMetadata b
sourceMeta ->
      BackendSourceKind b -> BackendType
forall (b :: BackendType). BackendSourceKind b -> BackendType
backendTypeFromBackendSourceKind (BackendSourceKind b -> BackendType)
-> BackendSourceKind b -> BackendType
forall a b. (a -> b) -> a -> b
$ SourceMetadata b -> BackendSourceKind b
forall (b :: BackendType). SourceMetadata b -> BackendSourceKind b
_smKind SourceMetadata b
sourceMeta

anySourceMetadataCodec :: (HasTag b) => JSONCodec (SourceMetadata b) -> JSONCodec BackendSourceMetadata
anySourceMetadataCodec :: forall (b :: BackendType).
HasTag b =>
JSONCodec (SourceMetadata b) -> JSONCodec BackendSourceMetadata
anySourceMetadataCodec = (SourceMetadata b -> BackendSourceMetadata)
-> (BackendSourceMetadata -> SourceMetadata b)
-> Codec Value (SourceMetadata b) (SourceMetadata b)
-> JSONCodec BackendSourceMetadata
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec SourceMetadata b -> BackendSourceMetadata
forall (b :: BackendType).
HasTag b =>
SourceMetadata b -> BackendSourceMetadata
dec BackendSourceMetadata -> SourceMetadata b
forall (b :: BackendType).
HasTag b =>
BackendSourceMetadata -> SourceMetadata b
enc
  where
    dec :: (HasTag b) => SourceMetadata b -> BackendSourceMetadata
    dec :: forall (b :: BackendType).
HasTag b =>
SourceMetadata b -> BackendSourceMetadata
dec = AnyBackend SourceMetadata -> BackendSourceMetadata
BackendSourceMetadata (AnyBackend SourceMetadata -> BackendSourceMetadata)
-> (SourceMetadata b -> AnyBackend SourceMetadata)
-> SourceMetadata b
-> BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceMetadata b -> AnyBackend SourceMetadata
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend

    -- This encoding function is partial, but that should be ok.
    enc :: (HasTag b) => BackendSourceMetadata -> SourceMetadata b
    enc :: forall (b :: BackendType).
HasTag b =>
BackendSourceMetadata -> SourceMetadata b
enc BackendSourceMetadata
input = Maybe (SourceMetadata b) -> SourceMetadata b
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (SourceMetadata b) -> SourceMetadata b)
-> Maybe (SourceMetadata b) -> SourceMetadata b
forall a b. (a -> b) -> a -> b
$ AnyBackend SourceMetadata -> Maybe (SourceMetadata b)
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
AB.unpackAnyBackend (AnyBackend SourceMetadata -> Maybe (SourceMetadata b))
-> AnyBackend SourceMetadata -> Maybe (SourceMetadata b)
forall a b. (a -> b) -> a -> b
$ BackendSourceMetadata -> AnyBackend SourceMetadata
unBackendSourceMetadata BackendSourceMetadata
input

instance (Backend b) => HasCodec (SourceMetadata b) where
  codec :: JSONCodec (SourceMetadata b)
codec =
    Text
-> ObjectCodec (SourceMetadata b) (SourceMetadata b)
-> JSONCodec (SourceMetadata b)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (forall (b :: BackendType). HasTag b => Text
backendPrefix @b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"SourceMetadata")
      (ObjectCodec (SourceMetadata b) (SourceMetadata b)
 -> JSONCodec (SourceMetadata b))
-> ObjectCodec (SourceMetadata b) (SourceMetadata b)
-> JSONCodec (SourceMetadata b)
forall a b. (a -> b) -> a -> b
$ SourceName
-> BackendSourceKind b
-> Tables b
-> InsOrdHashMap (FunctionName b) (FunctionMetadata b)
-> NativeQueries b
-> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
-> LogicalModels b
-> SourceConnConfiguration b
-> Maybe QueryTagsConfig
-> SourceCustomization
-> Maybe (HealthCheckConfig b)
-> SourceMetadata b
forall (b :: BackendType).
SourceName
-> BackendSourceKind b
-> Tables b
-> Functions b
-> NativeQueries b
-> StoredProcedures b
-> LogicalModels b
-> SourceConnConfiguration b
-> Maybe QueryTagsConfig
-> SourceCustomization
-> Maybe (HealthCheckConfig b)
-> SourceMetadata b
SourceMetadata
      (SourceName
 -> BackendSourceKind b
 -> Tables b
 -> InsOrdHashMap (FunctionName b) (FunctionMetadata b)
 -> NativeQueries b
 -> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
 -> LogicalModels b
 -> SourceConnConfiguration b
 -> Maybe QueryTagsConfig
 -> SourceCustomization
 -> Maybe (HealthCheckConfig b)
 -> SourceMetadata b)
-> Codec Object (SourceMetadata b) SourceName
-> Codec
     Object
     (SourceMetadata b)
     (BackendSourceKind b
      -> Tables b
      -> InsOrdHashMap (FunctionName b) (FunctionMetadata b)
      -> NativeQueries b
      -> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
      -> LogicalModels b
      -> SourceConnConfiguration b
      -> Maybe QueryTagsConfig
      -> SourceCustomization
      -> Maybe (HealthCheckConfig b)
      -> SourceMetadata b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec SourceName SourceName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec SourceName SourceName
-> (SourceMetadata b -> SourceName)
-> Codec Object (SourceMetadata b) SourceName
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== SourceMetadata b -> SourceName
forall (b :: BackendType). SourceMetadata b -> SourceName
_smName
        Codec
  Object
  (SourceMetadata b)
  (BackendSourceKind b
   -> Tables b
   -> InsOrdHashMap (FunctionName b) (FunctionMetadata b)
   -> NativeQueries b
   -> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
   -> LogicalModels b
   -> SourceConnConfiguration b
   -> Maybe QueryTagsConfig
   -> SourceCustomization
   -> Maybe (HealthCheckConfig b)
   -> SourceMetadata b)
-> Codec Object (SourceMetadata b) (BackendSourceKind b)
-> Codec
     Object
     (SourceMetadata b)
     (Tables b
      -> InsOrdHashMap (FunctionName b) (FunctionMetadata b)
      -> NativeQueries b
      -> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
      -> LogicalModels b
      -> SourceConnConfiguration b
      -> Maybe QueryTagsConfig
      -> SourceCustomization
      -> Maybe (HealthCheckConfig b)
      -> SourceMetadata b)
forall a b.
Codec Object (SourceMetadata b) (a -> b)
-> Codec Object (SourceMetadata b) a
-> Codec Object (SourceMetadata b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (BackendSourceKind b) (BackendSourceKind b)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"kind"
      ObjectCodec (BackendSourceKind b) (BackendSourceKind b)
-> (SourceMetadata b -> BackendSourceKind b)
-> Codec Object (SourceMetadata b) (BackendSourceKind b)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== SourceMetadata b -> BackendSourceKind b
forall (b :: BackendType). SourceMetadata b -> BackendSourceKind b
_smKind
        Codec
  Object
  (SourceMetadata b)
  (Tables b
   -> InsOrdHashMap (FunctionName b) (FunctionMetadata b)
   -> NativeQueries b
   -> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
   -> LogicalModels b
   -> SourceConnConfiguration b
   -> Maybe QueryTagsConfig
   -> SourceCustomization
   -> Maybe (HealthCheckConfig b)
   -> SourceMetadata b)
-> Codec Object (SourceMetadata b) (Tables b)
-> Codec
     Object
     (SourceMetadata b)
     (InsOrdHashMap (FunctionName b) (FunctionMetadata b)
      -> NativeQueries b
      -> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
      -> LogicalModels b
      -> SourceConnConfiguration b
      -> Maybe QueryTagsConfig
      -> SourceCustomization
      -> Maybe (HealthCheckConfig b)
      -> SourceMetadata b)
forall a b.
Codec Object (SourceMetadata b) (a -> b)
-> Codec Object (SourceMetadata b) a
-> Codec Object (SourceMetadata b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec (Tables b) (Tables b)
-> ObjectCodec (Tables b) (Tables b)
forall input output.
Text -> ValueCodec input output -> ObjectCodec input output
requiredFieldWith' Text
"tables" ((TableMetadata b -> TableName b)
-> ValueCodec (Tables b) (Tables b)
forall a k.
(HasCodec a, Hashable k, Ord k, ToTxt k) =>
(a -> k) -> JSONCodec (InsOrdHashMap k a)
sortedElemsCodec TableMetadata b -> TableName b
forall (b :: BackendType). TableMetadata b -> TableName b
_tmTable)
      ObjectCodec (Tables b) (Tables b)
-> (SourceMetadata b -> Tables b)
-> Codec Object (SourceMetadata b) (Tables b)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== SourceMetadata b -> Tables b
forall (b :: BackendType). SourceMetadata b -> Tables b
_smTables
        Codec
  Object
  (SourceMetadata b)
  (InsOrdHashMap (FunctionName b) (FunctionMetadata b)
   -> NativeQueries b
   -> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
   -> LogicalModels b
   -> SourceConnConfiguration b
   -> Maybe QueryTagsConfig
   -> SourceCustomization
   -> Maybe (HealthCheckConfig b)
   -> SourceMetadata b)
-> Codec
     Object
     (SourceMetadata b)
     (InsOrdHashMap (FunctionName b) (FunctionMetadata b))
-> Codec
     Object
     (SourceMetadata b)
     (NativeQueries b
      -> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
      -> LogicalModels b
      -> SourceConnConfiguration b
      -> Maybe QueryTagsConfig
      -> SourceCustomization
      -> Maybe (HealthCheckConfig b)
      -> SourceMetadata b)
forall a b.
Codec Object (SourceMetadata b) (a -> b)
-> Codec Object (SourceMetadata b) a
-> Codec Object (SourceMetadata b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec (InsOrdHashMap (FunctionName b) (FunctionMetadata b))
-> InsOrdHashMap (FunctionName b) (FunctionMetadata b)
-> ObjectCodec
     (InsOrdHashMap (FunctionName b) (FunctionMetadata b))
     (InsOrdHashMap (FunctionName b) (FunctionMetadata b))
forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldOrNullWithOmittedDefaultWith' Text
"functions" ((FunctionMetadata b -> FunctionName b)
-> JSONCodec (InsOrdHashMap (FunctionName b) (FunctionMetadata b))
forall a k.
(HasCodec a, Hashable k, Ord k, ToTxt k) =>
(a -> k) -> JSONCodec (InsOrdHashMap k a)
sortedElemsCodec FunctionMetadata b -> FunctionName b
forall (b :: BackendType). FunctionMetadata b -> FunctionName b
_fmFunction) InsOrdHashMap (FunctionName b) (FunctionMetadata b)
forall a. Monoid a => a
mempty
      ObjectCodec
  (InsOrdHashMap (FunctionName b) (FunctionMetadata b))
  (InsOrdHashMap (FunctionName b) (FunctionMetadata b))
-> (SourceMetadata b
    -> InsOrdHashMap (FunctionName b) (FunctionMetadata b))
-> Codec
     Object
     (SourceMetadata b)
     (InsOrdHashMap (FunctionName b) (FunctionMetadata b))
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== SourceMetadata b
-> InsOrdHashMap (FunctionName b) (FunctionMetadata b)
forall (b :: BackendType). SourceMetadata b -> Functions b
_smFunctions
        Codec
  Object
  (SourceMetadata b)
  (NativeQueries b
   -> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
   -> LogicalModels b
   -> SourceConnConfiguration b
   -> Maybe QueryTagsConfig
   -> SourceCustomization
   -> Maybe (HealthCheckConfig b)
   -> SourceMetadata b)
-> Codec Object (SourceMetadata b) (NativeQueries b)
-> Codec
     Object
     (SourceMetadata b)
     (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
      -> LogicalModels b
      -> SourceConnConfiguration b
      -> Maybe QueryTagsConfig
      -> SourceCustomization
      -> Maybe (HealthCheckConfig b)
      -> SourceMetadata b)
forall a b.
Codec Object (SourceMetadata b) (a -> b)
-> Codec Object (SourceMetadata b) a
-> Codec Object (SourceMetadata b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec (NativeQueries b)
-> NativeQueries b
-> ObjectCodec (NativeQueries b) (NativeQueries b)
forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldOrNullWithOmittedDefaultWith' Text
"native_queries" ((NativeQueryMetadata b -> NativeQueryName)
-> JSONCodec (NativeQueries b)
forall a k.
(HasCodec a, Hashable k, Ord k, ToTxt k) =>
(a -> k) -> JSONCodec (InsOrdHashMap k a)
sortedElemsCodec NativeQueryMetadata b -> NativeQueryName
forall (b :: BackendType). NativeQueryMetadata b -> NativeQueryName
_nqmRootFieldName) NativeQueries b
forall a. Monoid a => a
mempty
      ObjectCodec (NativeQueries b) (NativeQueries b)
-> (SourceMetadata b -> NativeQueries b)
-> Codec Object (SourceMetadata b) (NativeQueries b)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== SourceMetadata b -> NativeQueries b
forall (b :: BackendType). SourceMetadata b -> NativeQueries b
_smNativeQueries
        Codec
  Object
  (SourceMetadata b)
  (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
   -> LogicalModels b
   -> SourceConnConfiguration b
   -> Maybe QueryTagsConfig
   -> SourceCustomization
   -> Maybe (HealthCheckConfig b)
   -> SourceMetadata b)
-> Codec
     Object
     (SourceMetadata b)
     (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b))
-> Codec
     Object
     (SourceMetadata b)
     (LogicalModels b
      -> SourceConnConfiguration b
      -> Maybe QueryTagsConfig
      -> SourceCustomization
      -> Maybe (HealthCheckConfig b)
      -> SourceMetadata b)
forall a b.
Codec Object (SourceMetadata b) (a -> b)
-> Codec Object (SourceMetadata b) a
-> Codec Object (SourceMetadata b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec
     (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b))
-> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
-> ObjectCodec
     (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b))
     (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b))
forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldOrNullWithOmittedDefaultWith' Text
"stored_procedures" ((StoredProcedureMetadata b -> FunctionName b)
-> JSONCodec
     (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b))
forall a k.
(HasCodec a, Hashable k, Ord k, ToTxt k) =>
(a -> k) -> JSONCodec (InsOrdHashMap k a)
sortedElemsCodec StoredProcedureMetadata b -> FunctionName b
forall (b :: BackendType).
StoredProcedureMetadata b -> FunctionName b
_spmStoredProcedure) InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
forall a. Monoid a => a
mempty
      ObjectCodec
  (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b))
  (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b))
-> (SourceMetadata b
    -> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b))
-> Codec
     Object
     (SourceMetadata b)
     (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b))
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== SourceMetadata b
-> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
forall (b :: BackendType). SourceMetadata b -> StoredProcedures b
_smStoredProcedures
        Codec
  Object
  (SourceMetadata b)
  (LogicalModels b
   -> SourceConnConfiguration b
   -> Maybe QueryTagsConfig
   -> SourceCustomization
   -> Maybe (HealthCheckConfig b)
   -> SourceMetadata b)
-> Codec Object (SourceMetadata b) (LogicalModels b)
-> Codec
     Object
     (SourceMetadata b)
     (SourceConnConfiguration b
      -> Maybe QueryTagsConfig
      -> SourceCustomization
      -> Maybe (HealthCheckConfig b)
      -> SourceMetadata b)
forall a b.
Codec Object (SourceMetadata b) (a -> b)
-> Codec Object (SourceMetadata b) a
-> Codec Object (SourceMetadata b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec (LogicalModels b)
-> LogicalModels b
-> ObjectCodec (LogicalModels b) (LogicalModels b)
forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldOrNullWithOmittedDefaultWith' Text
"logical_models" ((LogicalModelMetadata b -> LogicalModelName)
-> JSONCodec (LogicalModels b)
forall a k.
(HasCodec a, Hashable k, Ord k, ToTxt k) =>
(a -> k) -> JSONCodec (InsOrdHashMap k a)
sortedElemsCodec LogicalModelMetadata b -> LogicalModelName
forall (b :: BackendType).
LogicalModelMetadata b -> LogicalModelName
_lmmName) LogicalModels b
forall a. Monoid a => a
mempty
      ObjectCodec (LogicalModels b) (LogicalModels b)
-> (SourceMetadata b -> LogicalModels b)
-> Codec Object (SourceMetadata b) (LogicalModels b)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== SourceMetadata b -> LogicalModels b
forall (b :: BackendType). SourceMetadata b -> LogicalModels b
_smLogicalModels
        Codec
  Object
  (SourceMetadata b)
  (SourceConnConfiguration b
   -> Maybe QueryTagsConfig
   -> SourceCustomization
   -> Maybe (HealthCheckConfig b)
   -> SourceMetadata b)
-> Codec Object (SourceMetadata b) (SourceConnConfiguration b)
-> Codec
     Object
     (SourceMetadata b)
     (Maybe QueryTagsConfig
      -> SourceCustomization
      -> Maybe (HealthCheckConfig b)
      -> SourceMetadata b)
forall a b.
Codec Object (SourceMetadata b) (a -> b)
-> Codec Object (SourceMetadata b) a
-> Codec Object (SourceMetadata b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (SourceConnConfiguration b) (SourceConnConfiguration b)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"configuration"
      ObjectCodec (SourceConnConfiguration b) (SourceConnConfiguration b)
-> (SourceMetadata b -> SourceConnConfiguration b)
-> Codec Object (SourceMetadata b) (SourceConnConfiguration b)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== SourceMetadata b -> SourceConnConfiguration b
forall (b :: BackendType).
SourceMetadata b -> SourceConnConfiguration b
_smConfiguration
        Codec
  Object
  (SourceMetadata b)
  (Maybe QueryTagsConfig
   -> SourceCustomization
   -> Maybe (HealthCheckConfig b)
   -> SourceMetadata b)
-> Codec Object (SourceMetadata b) (Maybe QueryTagsConfig)
-> Codec
     Object
     (SourceMetadata b)
     (SourceCustomization
      -> Maybe (HealthCheckConfig b) -> SourceMetadata b)
forall a b.
Codec Object (SourceMetadata b) (a -> b)
-> Codec Object (SourceMetadata b) a
-> Codec Object (SourceMetadata b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe QueryTagsConfig) (Maybe QueryTagsConfig)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull' Text
"query_tags"
      ObjectCodec (Maybe QueryTagsConfig) (Maybe QueryTagsConfig)
-> (SourceMetadata b -> Maybe QueryTagsConfig)
-> Codec Object (SourceMetadata b) (Maybe QueryTagsConfig)
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== SourceMetadata b -> Maybe QueryTagsConfig
forall (b :: BackendType).
SourceMetadata b -> Maybe QueryTagsConfig
_smQueryTags
        Codec
  Object
  (SourceMetadata b)
  (SourceCustomization
   -> Maybe (HealthCheckConfig b) -> SourceMetadata b)
-> Codec Object (SourceMetadata b) SourceCustomization
-> Codec
     Object
     (SourceMetadata b)
     (Maybe (HealthCheckConfig b) -> SourceMetadata b)
forall a b.
Codec Object (SourceMetadata b) (a -> b)
-> Codec Object (SourceMetadata b) a
-> Codec Object (SourceMetadata b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> SourceCustomization
-> ObjectCodec SourceCustomization SourceCustomization
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"customization" SourceCustomization
emptySourceCustomization
      ObjectCodec SourceCustomization SourceCustomization
-> (SourceMetadata b -> SourceCustomization)
-> Codec Object (SourceMetadata b) SourceCustomization
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== SourceMetadata b -> SourceCustomization
forall (b :: BackendType). SourceMetadata b -> SourceCustomization
_smCustomization
        Codec
  Object
  (SourceMetadata b)
  (Maybe (HealthCheckConfig b) -> SourceMetadata b)
-> Codec Object (SourceMetadata b) (Maybe (HealthCheckConfig b))
-> ObjectCodec (SourceMetadata b) (SourceMetadata b)
forall a b.
Codec Object (SourceMetadata b) (a -> b)
-> Codec Object (SourceMetadata b) a
-> Codec Object (SourceMetadata b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec Object (SourceMetadata b) (Maybe (HealthCheckConfig b))
healthCheckField
    where
      healthCheckField :: Codec Object (SourceMetadata b) (Maybe (HealthCheckConfig b))
healthCheckField = case forall (b :: BackendType).
Backend b =>
Maybe (HealthCheckImplementation (HealthCheckTest b))
healthCheckImplementation @b of
        Just HealthCheckImplementation (HealthCheckTest b)
hci -> Text
-> ValueCodec (HealthCheckConfig b) (HealthCheckConfig b)
-> ObjectCodec
     (Maybe (HealthCheckConfig b)) (Maybe (HealthCheckConfig b))
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldOrNullWith' Text
"health_check" (HealthCheckImplementation (HealthCheckTest b)
-> ValueCodec (HealthCheckConfig b) (HealthCheckConfig b)
forall (b :: BackendType).
Backend b =>
HealthCheckImplementation (HealthCheckTest b)
-> JSONCodec (HealthCheckConfig b)
healthCheckConfigCodec HealthCheckImplementation (HealthCheckTest b)
hci) ObjectCodec
  (Maybe (HealthCheckConfig b)) (Maybe (HealthCheckConfig b))
-> (SourceMetadata b -> Maybe (HealthCheckConfig b))
-> Codec Object (SourceMetadata b) (Maybe (HealthCheckConfig b))
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.== SourceMetadata b -> Maybe (HealthCheckConfig b)
forall (b :: BackendType).
SourceMetadata b -> Maybe (HealthCheckConfig b)
_smHealthCheckConfig
        Maybe (HealthCheckImplementation (HealthCheckTest b))
Nothing ->
          -- If this backend does not support health check tests then this field
          -- should be excluded from the serialization format.
          Maybe (HealthCheckConfig b)
-> Codec Object (SourceMetadata b) (Maybe (HealthCheckConfig b))
forall a. a -> Codec Object (SourceMetadata b) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HealthCheckConfig b)
forall a. Maybe a
Nothing

      .== :: ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
(.==) = ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
forall {oldInput} {output} {newInput}.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
(AC..=)

mkSourceMetadata ::
  forall (b :: BackendType).
  (Backend b) =>
  SourceName ->
  BackendSourceKind b ->
  SourceConnConfiguration b ->
  SourceCustomization ->
  Maybe (HealthCheckConfig b) ->
  BackendSourceMetadata
mkSourceMetadata :: forall (b :: BackendType).
Backend b =>
SourceName
-> BackendSourceKind b
-> SourceConnConfiguration b
-> SourceCustomization
-> Maybe (HealthCheckConfig b)
-> BackendSourceMetadata
mkSourceMetadata SourceName
name BackendSourceKind b
backendSourceKind SourceConnConfiguration b
config SourceCustomization
customization Maybe (HealthCheckConfig b)
healthCheckConfig =
  AnyBackend SourceMetadata -> BackendSourceMetadata
BackendSourceMetadata
    (AnyBackend SourceMetadata -> BackendSourceMetadata)
-> AnyBackend SourceMetadata -> BackendSourceMetadata
forall a b. (a -> b) -> a -> b
$ SourceMetadata b -> AnyBackend SourceMetadata
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
    (SourceMetadata b -> AnyBackend SourceMetadata)
-> SourceMetadata b -> AnyBackend SourceMetadata
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
SourceName
-> BackendSourceKind b
-> Tables b
-> Functions b
-> NativeQueries b
-> StoredProcedures b
-> LogicalModels b
-> SourceConnConfiguration b
-> Maybe QueryTagsConfig
-> SourceCustomization
-> Maybe (HealthCheckConfig b)
-> SourceMetadata b
SourceMetadata
      @b
      SourceName
name
      BackendSourceKind b
backendSourceKind
      InsOrdHashMap (TableName b) (TableMetadata b)
forall a. Monoid a => a
mempty
      InsOrdHashMap (FunctionName b) (FunctionMetadata b)
forall a. Monoid a => a
mempty
      NativeQueries b
forall a. Monoid a => a
mempty
      InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
forall a. Monoid a => a
mempty
      LogicalModels b
forall a. Monoid a => a
mempty
      SourceConnConfiguration b
config
      Maybe QueryTagsConfig
forall a. Maybe a
Nothing
      SourceCustomization
customization
      Maybe (HealthCheckConfig b)
healthCheckConfig

-- | Source configuration as stored in the Metadata DB for some existentialized backend.
newtype BackendSourceMetadata = BackendSourceMetadata {BackendSourceMetadata -> AnyBackend SourceMetadata
unBackendSourceMetadata :: AB.AnyBackend SourceMetadata}
  deriving newtype (BackendSourceMetadata -> BackendSourceMetadata -> Bool
(BackendSourceMetadata -> BackendSourceMetadata -> Bool)
-> (BackendSourceMetadata -> BackendSourceMetadata -> Bool)
-> Eq BackendSourceMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BackendSourceMetadata -> BackendSourceMetadata -> Bool
== :: BackendSourceMetadata -> BackendSourceMetadata -> Bool
$c/= :: BackendSourceMetadata -> BackendSourceMetadata -> Bool
/= :: BackendSourceMetadata -> BackendSourceMetadata -> Bool
Eq, Int -> BackendSourceMetadata -> ShowS
[BackendSourceMetadata] -> ShowS
BackendSourceMetadata -> String
(Int -> BackendSourceMetadata -> ShowS)
-> (BackendSourceMetadata -> String)
-> ([BackendSourceMetadata] -> ShowS)
-> Show BackendSourceMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BackendSourceMetadata -> ShowS
showsPrec :: Int -> BackendSourceMetadata -> ShowS
$cshow :: BackendSourceMetadata -> String
show :: BackendSourceMetadata -> String
$cshowList :: [BackendSourceMetadata] -> ShowS
showList :: [BackendSourceMetadata] -> ShowS
Show)

toSourceMetadata :: forall b. (Backend b) => Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata :: forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata = (SourceMetadata b -> BackendSourceMetadata)
-> (BackendSourceMetadata -> Maybe (SourceMetadata b))
-> Prism
     BackendSourceMetadata
     BackendSourceMetadata
     (SourceMetadata b)
     (SourceMetadata b)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (AnyBackend SourceMetadata -> BackendSourceMetadata
BackendSourceMetadata (AnyBackend SourceMetadata -> BackendSourceMetadata)
-> (SourceMetadata b -> AnyBackend SourceMetadata)
-> SourceMetadata b
-> BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceMetadata b -> AnyBackend SourceMetadata
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend) (AnyBackend SourceMetadata -> Maybe (SourceMetadata b)
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
AB.unpackAnyBackend (AnyBackend SourceMetadata -> Maybe (SourceMetadata b))
-> (BackendSourceMetadata -> AnyBackend SourceMetadata)
-> BackendSourceMetadata
-> Maybe (SourceMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BackendSourceMetadata -> AnyBackend SourceMetadata
unBackendSourceMetadata)

getSourceName :: BackendSourceMetadata -> SourceName
getSourceName :: BackendSourceMetadata -> SourceName
getSourceName BackendSourceMetadata
e = forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend (BackendSourceMetadata -> AnyBackend SourceMetadata
unBackendSourceMetadata BackendSourceMetadata
e) SourceMetadata b -> SourceName
forall (b :: BackendType).
Backend b =>
SourceMetadata b -> SourceName
forall (b :: BackendType). SourceMetadata b -> SourceName
_smName

type Sources = InsOrdHashMap SourceName BackendSourceMetadata

sourcesCodec :: AC.JSONCodec Sources
sourcesCodec :: JSONCodec Sources
sourcesCodec = JSONCodec BackendSourceMetadata
-> (BackendSourceMetadata -> SourceName) -> JSONCodec Sources
forall k a.
(Hashable k, Ord k, ToTxt k) =>
JSONCodec a -> (a -> k) -> JSONCodec (InsOrdHashMap k a)
sortedElemsCodecWith JSONCodec BackendSourceMetadata
backendSourceMetadataCodec BackendSourceMetadata -> SourceName
getSourceName

parseNonSourcesMetadata ::
  Object ->
  Parser
    ( RemoteSchemas,
      QueryCollections,
      MetadataAllowlist,
      CustomTypes,
      Actions,
      CronTriggers,
      ApiLimit,
      MetricsConfig,
      InheritedRoles,
      SetGraphqlIntrospectionOptions
    )
parseNonSourcesMetadata :: Object
-> Parser
     (RemoteSchemas, QueryCollections, MetadataAllowlist, CustomTypes,
      Actions, CronTriggers, ApiLimit, MetricsConfig, InheritedRoles,
      SetGraphqlIntrospectionOptions)
parseNonSourcesMetadata Object
o = do
  RemoteSchemas
remoteSchemas <-
    Text
-> (RemoteSchemaMetadataG RemoteRelationshipDefinition
    -> RemoteSchemaName)
-> Parser [RemoteSchemaMetadataG RemoteRelationshipDefinition]
-> Parser RemoteSchemas
forall k a.
(Hashable k, ToTxt k) =>
Text -> (a -> k) -> Parser [a] -> Parser (InsOrdHashMap k a)
parseListAsMap Text
"remote schemas" RemoteSchemaMetadataG RemoteRelationshipDefinition
-> RemoteSchemaName
forall r. RemoteSchemaMetadataG r -> RemoteSchemaName
_rsmName
      (Parser [RemoteSchemaMetadataG RemoteRelationshipDefinition]
 -> Parser RemoteSchemas)
-> Parser [RemoteSchemaMetadataG RemoteRelationshipDefinition]
-> Parser RemoteSchemas
forall a b. (a -> b) -> a -> b
$ Object
o
      Object
-> Key
-> Parser
     (Maybe [RemoteSchemaMetadataG RemoteRelationshipDefinition])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"remote_schemas"
      Parser (Maybe [RemoteSchemaMetadataG RemoteRelationshipDefinition])
-> [RemoteSchemaMetadataG RemoteRelationshipDefinition]
-> Parser [RemoteSchemaMetadataG RemoteRelationshipDefinition]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
  QueryCollections
queryCollections <-
    Text
-> (CreateCollection -> CollectionName)
-> Parser [CreateCollection]
-> Parser QueryCollections
forall k a.
(Hashable k, ToTxt k) =>
Text -> (a -> k) -> Parser [a] -> Parser (InsOrdHashMap k a)
parseListAsMap Text
"query collections" CreateCollection -> CollectionName
_ccName
      (Parser [CreateCollection] -> Parser QueryCollections)
-> Parser [CreateCollection] -> Parser QueryCollections
forall a b. (a -> b) -> a -> b
$ Object
o
      Object -> Key -> Parser (Maybe [CreateCollection])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"query_collections"
      Parser (Maybe [CreateCollection])
-> [CreateCollection] -> Parser [CreateCollection]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
  MetadataAllowlist
allowlist <- Text
-> (AllowlistEntry -> CollectionName)
-> Parser [AllowlistEntry]
-> Parser MetadataAllowlist
forall k a.
(Hashable k, ToTxt k) =>
Text -> (a -> k) -> Parser [a] -> Parser (InsOrdHashMap k a)
parseListAsMap Text
"allowlist entries" AllowlistEntry -> CollectionName
aeCollection (Parser [AllowlistEntry] -> Parser MetadataAllowlist)
-> Parser [AllowlistEntry] -> Parser MetadataAllowlist
forall a b. (a -> b) -> a -> b
$ Object
o Object -> Key -> Parser (Maybe [AllowlistEntry])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allowlist" Parser (Maybe [AllowlistEntry])
-> [AllowlistEntry] -> Parser [AllowlistEntry]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
  CustomTypes
customTypes <- Object
o Object -> Key -> Parser (Maybe CustomTypes)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_types" Parser (Maybe CustomTypes) -> CustomTypes -> Parser CustomTypes
forall a. Parser (Maybe a) -> a -> Parser a
.!= CustomTypes
emptyCustomTypes
  Actions
actions <- Text
-> (ActionMetadata -> ActionName)
-> Parser [ActionMetadata]
-> Parser Actions
forall k a.
(Hashable k, ToTxt k) =>
Text -> (a -> k) -> Parser [a] -> Parser (InsOrdHashMap k a)
parseListAsMap Text
"actions" ActionMetadata -> ActionName
_amName (Parser [ActionMetadata] -> Parser Actions)
-> Parser [ActionMetadata] -> Parser Actions
forall a b. (a -> b) -> a -> b
$ Object
o Object -> Key -> Parser (Maybe [ActionMetadata])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"actions" Parser (Maybe [ActionMetadata])
-> [ActionMetadata] -> Parser [ActionMetadata]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
  CronTriggers
cronTriggers <-
    Text
-> (CronTriggerMetadata -> TriggerName)
-> Parser [CronTriggerMetadata]
-> Parser CronTriggers
forall k a.
(Hashable k, ToTxt k) =>
Text -> (a -> k) -> Parser [a] -> Parser (InsOrdHashMap k a)
parseListAsMap Text
"cron triggers" CronTriggerMetadata -> TriggerName
ctName
      (Parser [CronTriggerMetadata] -> Parser CronTriggers)
-> Parser [CronTriggerMetadata] -> Parser CronTriggers
forall a b. (a -> b) -> a -> b
$ Object
o
      Object -> Key -> Parser (Maybe [CronTriggerMetadata])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cron_triggers"
      Parser (Maybe [CronTriggerMetadata])
-> [CronTriggerMetadata] -> Parser [CronTriggerMetadata]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

  ApiLimit
apiLimits <- Object
o Object -> Key -> Parser (Maybe ApiLimit)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"api_limits" Parser (Maybe ApiLimit) -> ApiLimit -> Parser ApiLimit
forall a. Parser (Maybe a) -> a -> Parser a
.!= ApiLimit
emptyApiLimit
  MetricsConfig
metricsConfig <- Object
o Object -> Key -> Parser (Maybe MetricsConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metrics_config" Parser (Maybe MetricsConfig)
-> MetricsConfig -> Parser MetricsConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= MetricsConfig
emptyMetricsConfig
  InheritedRoles
inheritedRoles <-
    Text
-> (Role -> RoleName) -> Parser [Role] -> Parser InheritedRoles
forall k a.
(Hashable k, ToTxt k) =>
Text -> (a -> k) -> Parser [a] -> Parser (InsOrdHashMap k a)
parseListAsMap Text
"inherited roles" Role -> RoleName
_rRoleName
      (Parser [Role] -> Parser InheritedRoles)
-> Parser [Role] -> Parser InheritedRoles
forall a b. (a -> b) -> a -> b
$ Object
o
      Object -> Key -> Parser (Maybe [Role])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"inherited_roles"
      Parser (Maybe [Role]) -> [Role] -> Parser [Role]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
  SetGraphqlIntrospectionOptions
introspectionDisabledForRoles <- Object
o Object -> Key -> Parser (Maybe SetGraphqlIntrospectionOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"graphql_schema_introspection" Parser (Maybe SetGraphqlIntrospectionOptions)
-> SetGraphqlIntrospectionOptions
-> Parser SetGraphqlIntrospectionOptions
forall a. Parser (Maybe a) -> a -> Parser a
.!= SetGraphqlIntrospectionOptions
forall a. Monoid a => a
mempty
  (RemoteSchemas, QueryCollections, MetadataAllowlist, CustomTypes,
 Actions, CronTriggers, ApiLimit, MetricsConfig, InheritedRoles,
 SetGraphqlIntrospectionOptions)
-> Parser
     (RemoteSchemas, QueryCollections, MetadataAllowlist, CustomTypes,
      Actions, CronTriggers, ApiLimit, MetricsConfig, InheritedRoles,
      SetGraphqlIntrospectionOptions)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( RemoteSchemas
remoteSchemas,
      QueryCollections
queryCollections,
      MetadataAllowlist
allowlist,
      CustomTypes
customTypes,
      Actions
actions,
      CronTriggers
cronTriggers,
      ApiLimit
apiLimits,
      MetricsConfig
metricsConfig,
      InheritedRoles
inheritedRoles,
      SetGraphqlIntrospectionOptions
introspectionDisabledForRoles
    )

-- | This newtype simply wraps the BackendConfig type family so that it can be used
-- with BackendMap in the Metadata type. GHC will not allow the type family to be
-- used directly. :(
newtype BackendConfigWrapper b = BackendConfigWrapper {forall (b :: BackendType).
BackendConfigWrapper b -> BackendConfig b
unBackendConfigWrapper :: BackendConfig b}

deriving newtype instance (Backend b) => Show (BackendConfigWrapper b)

deriving newtype instance (Backend b) => Eq (BackendConfigWrapper b)

deriving newtype instance (Backend b) => ToJSON (BackendConfigWrapper b)

deriving newtype instance (Backend b) => FromJSON (BackendConfigWrapper b)

deriving newtype instance (Semigroup (BackendConfig b)) => Semigroup (BackendConfigWrapper b)

deriving newtype instance (Monoid (BackendConfig b)) => Monoid (BackendConfigWrapper b)

instance (Backend b) => HasCodec (BackendConfigWrapper b) where
  codec :: JSONCodec (BackendConfigWrapper b)
codec = (BackendConfig b -> BackendConfigWrapper b)
-> (BackendConfigWrapper b -> BackendConfig b)
-> Codec Value (BackendConfig b) (BackendConfig b)
-> JSONCodec (BackendConfigWrapper b)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec BackendConfig b -> BackendConfigWrapper b
forall (b :: BackendType).
BackendConfig b -> BackendConfigWrapper b
BackendConfigWrapper BackendConfigWrapper b -> BackendConfig b
forall (b :: BackendType).
BackendConfigWrapper b -> BackendConfig b
unBackendConfigWrapper Codec Value (BackendConfig b) (BackendConfig b)
forall value. HasCodec value => JSONCodec value
codec

data CatalogStateType
  = CSTCli
  | CSTConsole
  deriving stock (Int -> CatalogStateType -> ShowS
[CatalogStateType] -> ShowS
CatalogStateType -> String
(Int -> CatalogStateType -> ShowS)
-> (CatalogStateType -> String)
-> ([CatalogStateType] -> ShowS)
-> Show CatalogStateType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CatalogStateType -> ShowS
showsPrec :: Int -> CatalogStateType -> ShowS
$cshow :: CatalogStateType -> String
show :: CatalogStateType -> String
$cshowList :: [CatalogStateType] -> ShowS
showList :: [CatalogStateType] -> ShowS
Show, CatalogStateType -> CatalogStateType -> Bool
(CatalogStateType -> CatalogStateType -> Bool)
-> (CatalogStateType -> CatalogStateType -> Bool)
-> Eq CatalogStateType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CatalogStateType -> CatalogStateType -> Bool
== :: CatalogStateType -> CatalogStateType -> Bool
$c/= :: CatalogStateType -> CatalogStateType -> Bool
/= :: CatalogStateType -> CatalogStateType -> Bool
Eq, (forall x. CatalogStateType -> Rep CatalogStateType x)
-> (forall x. Rep CatalogStateType x -> CatalogStateType)
-> Generic CatalogStateType
forall x. Rep CatalogStateType x -> CatalogStateType
forall x. CatalogStateType -> Rep CatalogStateType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CatalogStateType -> Rep CatalogStateType x
from :: forall x. CatalogStateType -> Rep CatalogStateType x
$cto :: forall x. Rep CatalogStateType x -> CatalogStateType
to :: forall x. Rep CatalogStateType x -> CatalogStateType
Generic)

instance FromJSON CatalogStateType where
  parseJSON :: Value -> Parser CatalogStateType
parseJSON = Options -> Value -> Parser CatalogStateType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {constructorTagModifier :: ShowS
constructorTagModifier = ShowS
snakeCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3}

instance ToJSON CatalogStateType where
  toJSON :: CatalogStateType -> Value
toJSON = Options -> CatalogStateType -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {constructorTagModifier :: ShowS
constructorTagModifier = ShowS
snakeCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3}
  toEncoding :: CatalogStateType -> Encoding
toEncoding = Options -> CatalogStateType -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {constructorTagModifier :: ShowS
constructorTagModifier = ShowS
snakeCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3}

data SetCatalogState = SetCatalogState
  { SetCatalogState -> CatalogStateType
_scsType :: CatalogStateType,
    SetCatalogState -> Value
_scsState :: Value
  }
  deriving stock (Int -> SetCatalogState -> ShowS
[SetCatalogState] -> ShowS
SetCatalogState -> String
(Int -> SetCatalogState -> ShowS)
-> (SetCatalogState -> String)
-> ([SetCatalogState] -> ShowS)
-> Show SetCatalogState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetCatalogState -> ShowS
showsPrec :: Int -> SetCatalogState -> ShowS
$cshow :: SetCatalogState -> String
show :: SetCatalogState -> String
$cshowList :: [SetCatalogState] -> ShowS
showList :: [SetCatalogState] -> ShowS
Show, SetCatalogState -> SetCatalogState -> Bool
(SetCatalogState -> SetCatalogState -> Bool)
-> (SetCatalogState -> SetCatalogState -> Bool)
-> Eq SetCatalogState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetCatalogState -> SetCatalogState -> Bool
== :: SetCatalogState -> SetCatalogState -> Bool
$c/= :: SetCatalogState -> SetCatalogState -> Bool
/= :: SetCatalogState -> SetCatalogState -> Bool
Eq, (forall x. SetCatalogState -> Rep SetCatalogState x)
-> (forall x. Rep SetCatalogState x -> SetCatalogState)
-> Generic SetCatalogState
forall x. Rep SetCatalogState x -> SetCatalogState
forall x. SetCatalogState -> Rep SetCatalogState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SetCatalogState -> Rep SetCatalogState x
from :: forall x. SetCatalogState -> Rep SetCatalogState x
$cto :: forall x. Rep SetCatalogState x -> SetCatalogState
to :: forall x. Rep SetCatalogState x -> SetCatalogState
Generic)

instance FromJSON SetCatalogState where
  parseJSON :: Value -> Parser SetCatalogState
parseJSON = Options -> Value -> Parser SetCatalogState
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

instance ToJSON SetCatalogState where
  toJSON :: SetCatalogState -> Value
toJSON = Options -> SetCatalogState -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: SetCatalogState -> Encoding
toEncoding = Options -> SetCatalogState -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

data CatalogState = CatalogState
  { CatalogState -> Text
_csId :: Text,
    CatalogState -> Value
_csCliState :: Value,
    CatalogState -> Value
_csConsoleState :: Value
  }
  deriving stock (Int -> CatalogState -> ShowS
[CatalogState] -> ShowS
CatalogState -> String
(Int -> CatalogState -> ShowS)
-> (CatalogState -> String)
-> ([CatalogState] -> ShowS)
-> Show CatalogState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CatalogState -> ShowS
showsPrec :: Int -> CatalogState -> ShowS
$cshow :: CatalogState -> String
show :: CatalogState -> String
$cshowList :: [CatalogState] -> ShowS
showList :: [CatalogState] -> ShowS
Show, CatalogState -> CatalogState -> Bool
(CatalogState -> CatalogState -> Bool)
-> (CatalogState -> CatalogState -> Bool) -> Eq CatalogState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CatalogState -> CatalogState -> Bool
== :: CatalogState -> CatalogState -> Bool
$c/= :: CatalogState -> CatalogState -> Bool
/= :: CatalogState -> CatalogState -> Bool
Eq, (forall x. CatalogState -> Rep CatalogState x)
-> (forall x. Rep CatalogState x -> CatalogState)
-> Generic CatalogState
forall x. Rep CatalogState x -> CatalogState
forall x. CatalogState -> Rep CatalogState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CatalogState -> Rep CatalogState x
from :: forall x. CatalogState -> Rep CatalogState x
$cto :: forall x. Rep CatalogState x -> CatalogState
to :: forall x. Rep CatalogState x -> CatalogState
Generic)

instance ToJSON CatalogState where
  toJSON :: CatalogState -> Value
toJSON = Options -> CatalogState -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: CatalogState -> Encoding
toEncoding = Options -> CatalogState -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

data GetCatalogState
  = GetCatalogState
  deriving stock (Int -> GetCatalogState -> ShowS
[GetCatalogState] -> ShowS
GetCatalogState -> String
(Int -> GetCatalogState -> ShowS)
-> (GetCatalogState -> String)
-> ([GetCatalogState] -> ShowS)
-> Show GetCatalogState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetCatalogState -> ShowS
showsPrec :: Int -> GetCatalogState -> ShowS
$cshow :: GetCatalogState -> String
show :: GetCatalogState -> String
$cshowList :: [GetCatalogState] -> ShowS
showList :: [GetCatalogState] -> ShowS
Show, GetCatalogState -> GetCatalogState -> Bool
(GetCatalogState -> GetCatalogState -> Bool)
-> (GetCatalogState -> GetCatalogState -> Bool)
-> Eq GetCatalogState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetCatalogState -> GetCatalogState -> Bool
== :: GetCatalogState -> GetCatalogState -> Bool
$c/= :: GetCatalogState -> GetCatalogState -> Bool
/= :: GetCatalogState -> GetCatalogState -> Bool
Eq, (forall x. GetCatalogState -> Rep GetCatalogState x)
-> (forall x. Rep GetCatalogState x -> GetCatalogState)
-> Generic GetCatalogState
forall x. Rep GetCatalogState x -> GetCatalogState
forall x. GetCatalogState -> Rep GetCatalogState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetCatalogState -> Rep GetCatalogState x
from :: forall x. GetCatalogState -> Rep GetCatalogState x
$cto :: forall x. Rep GetCatalogState x -> GetCatalogState
to :: forall x. Rep GetCatalogState x -> GetCatalogState
Generic)

instance ToJSON GetCatalogState where
  toJSON :: GetCatalogState -> Value
toJSON = Options -> GetCatalogState -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions
  toEncoding :: GetCatalogState -> Encoding
toEncoding = Options -> GetCatalogState -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

instance FromJSON GetCatalogState where
  parseJSON :: Value -> Parser GetCatalogState
parseJSON Value
_ = GetCatalogState -> Parser GetCatalogState
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GetCatalogState
GetCatalogState