{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Hasura.Backends.Postgres.DDL.RunSQL
( runRunSQL,
RunSQL (..),
isSchemaCacheBuildRequiredRunSQL,
)
where
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson
import Data.HashMap.Strict qualified as M
import Data.HashSet qualified as HS
import Data.Text.Extended
import Database.PG.Query qualified as Q
import Hasura.Backends.Postgres.Connection.MonadTx
import Hasura.Backends.Postgres.DDL.EventTrigger
import Hasura.Backends.Postgres.DDL.Source
( FetchFunctionMetadata,
FetchTableMetadata,
ToMetadataFetchQuery,
fetchFunctionMetadata,
fetchTableMetadata,
)
import Hasura.Backends.Postgres.Execute.Types
import Hasura.Backends.Postgres.SQL.Types hiding (FunctionName, TableName)
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.DDL.Schema
import Hasura.RQL.DDL.Schema.Diff
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Function
import Hasura.RQL.Types.Metadata hiding
( fmFunction,
tmComputedFields,
tmTable,
)
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.Table
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Backend
import Hasura.Server.Types
import Hasura.Server.Utils (quoteRegex)
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Text.Regex.TDFA qualified as TDFA
data RunSQL = RunSQL
{ RunSQL -> Text
rSql :: Text,
RunSQL -> SourceName
rSource :: SourceName,
RunSQL -> Bool
rCascade :: Bool,
RunSQL -> Maybe Bool
rCheckMetadataConsistency :: Maybe Bool,
RunSQL -> TxAccess
rTxAccessMode :: Q.TxAccess
}
deriving (Int -> RunSQL -> ShowS
[RunSQL] -> ShowS
RunSQL -> String
(Int -> RunSQL -> ShowS)
-> (RunSQL -> String) -> ([RunSQL] -> ShowS) -> Show RunSQL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunSQL] -> ShowS
$cshowList :: [RunSQL] -> ShowS
show :: RunSQL -> String
$cshow :: RunSQL -> String
showsPrec :: Int -> RunSQL -> ShowS
$cshowsPrec :: Int -> RunSQL -> ShowS
Show, RunSQL -> RunSQL -> Bool
(RunSQL -> RunSQL -> Bool)
-> (RunSQL -> RunSQL -> Bool) -> Eq RunSQL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunSQL -> RunSQL -> Bool
$c/= :: RunSQL -> RunSQL -> Bool
== :: RunSQL -> RunSQL -> Bool
$c== :: RunSQL -> RunSQL -> Bool
Eq)
instance FromJSON RunSQL where
parseJSON :: Value -> Parser RunSQL
parseJSON = String -> (Object -> Parser RunSQL) -> Value -> Parser RunSQL
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RunSQL" ((Object -> Parser RunSQL) -> Value -> Parser RunSQL)
-> (Object -> Parser RunSQL) -> Value -> Parser RunSQL
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Text
rSql <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sql"
SourceName
rSource <- Object
o Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source" Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
Bool
rCascade <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cascade" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
Maybe Bool
rCheckMetadataConsistency <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"check_metadata_consistency"
Bool
isReadOnly <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"read_only" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
let rTxAccessMode :: TxAccess
rTxAccessMode = if Bool
isReadOnly then TxAccess
Q.ReadOnly else TxAccess
Q.ReadWrite
RunSQL -> Parser RunSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunSQL :: Text -> SourceName -> Bool -> Maybe Bool -> TxAccess -> RunSQL
RunSQL {Bool
Maybe Bool
Text
TxAccess
SourceName
rTxAccessMode :: TxAccess
rCheckMetadataConsistency :: Maybe Bool
rCascade :: Bool
rSource :: SourceName
rSql :: Text
rTxAccessMode :: TxAccess
rCheckMetadataConsistency :: Maybe Bool
rCascade :: Bool
rSource :: SourceName
rSql :: Text
..}
instance ToJSON RunSQL where
toJSON :: RunSQL -> Value
toJSON RunSQL {Bool
Maybe Bool
Text
TxAccess
SourceName
rTxAccessMode :: TxAccess
rCheckMetadataConsistency :: Maybe Bool
rCascade :: Bool
rSource :: SourceName
rSql :: Text
rTxAccessMode :: RunSQL -> TxAccess
rCheckMetadataConsistency :: RunSQL -> Maybe Bool
rCascade :: RunSQL -> Bool
rSource :: RunSQL -> SourceName
rSql :: RunSQL -> Text
..} =
[Pair] -> Value
object
[ Key
"sql" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
rSql,
Key
"source" Key -> SourceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SourceName
rSource,
Key
"cascade" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
rCascade,
Key
"check_metadata_consistency" Key -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
rCheckMetadataConsistency,
Key
"read_only"
Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= case TxAccess
rTxAccessMode of
TxAccess
Q.ReadOnly -> Bool
True
TxAccess
Q.ReadWrite -> Bool
False
]
isSchemaCacheBuildRequiredRunSQL :: RunSQL -> Bool
isSchemaCacheBuildRequiredRunSQL :: RunSQL -> Bool
isSchemaCacheBuildRequiredRunSQL RunSQL {Bool
Maybe Bool
Text
TxAccess
SourceName
rTxAccessMode :: TxAccess
rCheckMetadataConsistency :: Maybe Bool
rCascade :: Bool
rSource :: SourceName
rSql :: Text
rTxAccessMode :: RunSQL -> TxAccess
rCheckMetadataConsistency :: RunSQL -> Maybe Bool
rCascade :: RunSQL -> Bool
rSource :: RunSQL -> SourceName
rSql :: RunSQL -> Text
..} =
case TxAccess
rTxAccessMode of
TxAccess
Q.ReadOnly -> Bool
False
TxAccess
Q.ReadWrite -> Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Text -> Bool
containsDDLKeyword Text
rSql) Maybe Bool
rCheckMetadataConsistency
where
containsDDLKeyword :: Text -> Bool
containsDDLKeyword =
Regex -> Text -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
TDFA.match
$$( quoteRegex
TDFA.defaultCompOpt
{ TDFA.caseSensitive = False,
TDFA.multiline = True,
TDFA.lastStarGreedy = True
}
TDFA.defaultExecOpt
{ TDFA.captureGroups = False
}
"\\balter\\b|\\bdrop\\b|\\breplace\\b|\\bcreate function\\b|\\bcomment on\\b"
)
fetchTablesFunctionsMetadata ::
forall pgKind m.
( ToMetadataFetchQuery pgKind,
FetchTableMetadata pgKind,
FetchFunctionMetadata pgKind,
BackendMetadata ('Postgres pgKind),
MonadTx m
) =>
TableCache ('Postgres pgKind) ->
[TableName ('Postgres pgKind)] ->
[FunctionName ('Postgres pgKind)] ->
m ([TableMeta ('Postgres pgKind)], [FunctionMeta ('Postgres pgKind)])
fetchTablesFunctionsMetadata :: TableCache ('Postgres pgKind)
-> [TableName ('Postgres pgKind)]
-> [FunctionName ('Postgres pgKind)]
-> m ([TableMeta ('Postgres pgKind)],
[FunctionMeta ('Postgres pgKind)])
fetchTablesFunctionsMetadata TableCache ('Postgres pgKind)
tableCache [TableName ('Postgres pgKind)]
tables [FunctionName ('Postgres pgKind)]
functions = do
HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
tableMetaInfos <- [QualifiedTable] -> m (DBTablesMetadata ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *).
(FetchTableMetadata pgKind, Backend ('Postgres pgKind),
ToMetadataFetchQuery pgKind, MonadTx m) =>
[QualifiedTable] -> m (DBTablesMetadata ('Postgres pgKind))
fetchTableMetadata [TableName ('Postgres pgKind)]
[QualifiedTable]
tables
HashMap QualifiedFunction [PGRawFunctionInfo]
functionMetaInfos <- [QualifiedFunction] -> m (DBFunctionsMetadata ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *).
(FetchFunctionMetadata pgKind, MonadTx m) =>
[QualifiedFunction] -> m (DBFunctionsMetadata ('Postgres pgKind))
fetchFunctionMetadata @pgKind [FunctionName ('Postgres pgKind)]
[QualifiedFunction]
functions
([TableMeta ('Postgres pgKind)], [FunctionMeta ('Postgres pgKind)])
-> m ([TableMeta ('Postgres pgKind)],
[FunctionMeta ('Postgres pgKind)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
-> HashMap QualifiedFunction [PGRawFunctionInfo]
-> [TableMeta ('Postgres pgKind)]
buildTableMeta HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
tableMetaInfos HashMap QualifiedFunction [PGRawFunctionInfo]
functionMetaInfos, HashMap QualifiedFunction [PGRawFunctionInfo]
-> [FunctionMeta ('Postgres pgKind)]
buildFunctionMeta HashMap QualifiedFunction [PGRawFunctionInfo]
functionMetaInfos)
where
buildTableMeta :: HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
-> HashMap QualifiedFunction [PGRawFunctionInfo]
-> [TableMeta ('Postgres pgKind)]
buildTableMeta HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
tableMetaInfos HashMap QualifiedFunction [PGRawFunctionInfo]
functionMetaInfos =
(((QualifiedTable, DBTableMetadata ('Postgres pgKind))
-> TableMeta ('Postgres pgKind))
-> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
-> [TableMeta ('Postgres pgKind)])
-> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
-> ((QualifiedTable, DBTableMetadata ('Postgres pgKind))
-> TableMeta ('Postgres pgKind))
-> [TableMeta ('Postgres pgKind)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((QualifiedTable, DBTableMetadata ('Postgres pgKind))
-> TableMeta ('Postgres pgKind))
-> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
-> [TableMeta ('Postgres pgKind)]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
-> [(QualifiedTable, DBTableMetadata ('Postgres pgKind))]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
tableMetaInfos) (((QualifiedTable, DBTableMetadata ('Postgres pgKind))
-> TableMeta ('Postgres pgKind))
-> [TableMeta ('Postgres pgKind)])
-> ((QualifiedTable, DBTableMetadata ('Postgres pgKind))
-> TableMeta ('Postgres pgKind))
-> [TableMeta ('Postgres pgKind)]
forall a b. (a -> b) -> a -> b
$ \(QualifiedTable
table, DBTableMetadata ('Postgres pgKind)
tableMetaInfo) ->
TableName ('Postgres pgKind)
-> DBTableMetadata ('Postgres pgKind)
-> [ComputedFieldMeta ('Postgres pgKind)]
-> TableMeta ('Postgres pgKind)
forall (b :: BackendType).
TableName b
-> DBTableMetadata b -> [ComputedFieldMeta b] -> TableMeta b
TableMeta TableName ('Postgres pgKind)
QualifiedTable
table DBTableMetadata ('Postgres pgKind)
tableMetaInfo ([ComputedFieldMeta ('Postgres pgKind)]
-> TableMeta ('Postgres pgKind))
-> [ComputedFieldMeta ('Postgres pgKind)]
-> TableMeta ('Postgres pgKind)
forall a b. (a -> b) -> a -> b
$
(TableInfo ('Postgres pgKind)
-> [ComputedFieldMeta ('Postgres pgKind)])
-> Maybe (TableInfo ('Postgres pgKind))
-> [ComputedFieldMeta ('Postgres pgKind)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap @Maybe ((ComputedFieldInfo ('Postgres pgKind)
-> [ComputedFieldMeta ('Postgres pgKind)])
-> [ComputedFieldInfo ('Postgres pgKind)]
-> [ComputedFieldMeta ('Postgres pgKind)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HashMap (FunctionName ('Postgres pgKind)) [PGRawFunctionInfo]
-> ComputedFieldInfo ('Postgres pgKind)
-> [ComputedFieldMeta ('Postgres pgKind)]
forall (b :: BackendType) (b :: BackendType).
(Eq (FunctionName b), Hashable (FunctionName b),
FunctionName b ~ FunctionName b) =>
HashMap (FunctionName b) [PGRawFunctionInfo]
-> ComputedFieldInfo b -> [ComputedFieldMeta b]
mkComputedFieldMeta HashMap (FunctionName ('Postgres pgKind)) [PGRawFunctionInfo]
HashMap QualifiedFunction [PGRawFunctionInfo]
functionMetaInfos) ([ComputedFieldInfo ('Postgres pgKind)]
-> [ComputedFieldMeta ('Postgres pgKind)])
-> (TableInfo ('Postgres pgKind)
-> [ComputedFieldInfo ('Postgres pgKind)])
-> TableInfo ('Postgres pgKind)
-> [ComputedFieldMeta ('Postgres pgKind)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo ('Postgres pgKind)
-> [ComputedFieldInfo ('Postgres pgKind)]
forall (pgKind :: PostgresKind).
TableInfo ('Postgres pgKind)
-> [ComputedFieldInfo ('Postgres pgKind)]
getComputedFields) (QualifiedTable
-> HashMap QualifiedTable (TableInfo ('Postgres pgKind))
-> Maybe (TableInfo ('Postgres pgKind))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup QualifiedTable
table TableCache ('Postgres pgKind)
HashMap QualifiedTable (TableInfo ('Postgres pgKind))
tableCache)
buildFunctionMeta :: HashMap QualifiedFunction [PGRawFunctionInfo]
-> [FunctionMeta ('Postgres pgKind)]
buildFunctionMeta HashMap QualifiedFunction [PGRawFunctionInfo]
functionMetaInfos =
(QualifiedFunction -> [FunctionMeta ('Postgres pgKind)])
-> [QualifiedFunction] -> [FunctionMeta ('Postgres pgKind)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HashMap (FunctionName ('Postgres pgKind)) [PGRawFunctionInfo]
-> FunctionName ('Postgres pgKind)
-> [FunctionMeta ('Postgres pgKind)]
forall (b :: BackendType).
(Eq (FunctionName b), Hashable (FunctionName b)) =>
HashMap (FunctionName b) [PGRawFunctionInfo]
-> FunctionName b -> [FunctionMeta b]
getFunctionMetas HashMap (FunctionName ('Postgres pgKind)) [PGRawFunctionInfo]
HashMap QualifiedFunction [PGRawFunctionInfo]
functionMetaInfos) [FunctionName ('Postgres pgKind)]
[QualifiedFunction]
functions
mkComputedFieldMeta :: HashMap (FunctionName b) [PGRawFunctionInfo]
-> ComputedFieldInfo b -> [ComputedFieldMeta b]
mkComputedFieldMeta HashMap (FunctionName b) [PGRawFunctionInfo]
functionMetaInfos ComputedFieldInfo b
computedField =
let function :: FunctionName b
function = ComputedFieldFunction b -> FunctionName b
forall (b :: BackendType).
ComputedFieldFunction b -> FunctionName b
_cffName (ComputedFieldFunction b -> FunctionName b)
-> ComputedFieldFunction b -> FunctionName b
forall a b. (a -> b) -> a -> b
$ ComputedFieldInfo b -> ComputedFieldFunction b
forall (b :: BackendType).
ComputedFieldInfo b -> ComputedFieldFunction b
_cfiFunction ComputedFieldInfo b
computedField
in (FunctionMeta b -> ComputedFieldMeta b)
-> [FunctionMeta b] -> [ComputedFieldMeta b]
forall a b. (a -> b) -> [a] -> [b]
map (ComputedFieldName -> FunctionMeta b -> ComputedFieldMeta b
forall (b :: BackendType).
ComputedFieldName -> FunctionMeta b -> ComputedFieldMeta b
ComputedFieldMeta (ComputedFieldInfo b -> ComputedFieldName
forall (b :: BackendType). ComputedFieldInfo b -> ComputedFieldName
_cfiName ComputedFieldInfo b
computedField)) ([FunctionMeta b] -> [ComputedFieldMeta b])
-> [FunctionMeta b] -> [ComputedFieldMeta b]
forall a b. (a -> b) -> a -> b
$ HashMap (FunctionName b) [PGRawFunctionInfo]
-> FunctionName b -> [FunctionMeta b]
forall (b :: BackendType).
(Eq (FunctionName b), Hashable (FunctionName b)) =>
HashMap (FunctionName b) [PGRawFunctionInfo]
-> FunctionName b -> [FunctionMeta b]
getFunctionMetas HashMap (FunctionName b) [PGRawFunctionInfo]
functionMetaInfos FunctionName b
FunctionName b
function
getFunctionMetas :: HashMap (FunctionName b) [PGRawFunctionInfo]
-> FunctionName b -> [FunctionMeta b]
getFunctionMetas HashMap (FunctionName b) [PGRawFunctionInfo]
functionMetaInfos FunctionName b
function =
let mkFunctionMeta :: PGRawFunctionInfo -> FunctionMeta b
mkFunctionMeta PGRawFunctionInfo
rawInfo =
OID -> FunctionName b -> FunctionVolatility -> FunctionMeta b
forall (b :: BackendType).
OID -> FunctionName b -> FunctionVolatility -> FunctionMeta b
FunctionMeta (PGRawFunctionInfo -> OID
rfiOid PGRawFunctionInfo
rawInfo) FunctionName b
function (PGRawFunctionInfo -> FunctionVolatility
rfiFunctionType PGRawFunctionInfo
rawInfo)
in ([PGRawFunctionInfo] -> [FunctionMeta b])
-> Maybe [PGRawFunctionInfo] -> [FunctionMeta b]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap @Maybe ((PGRawFunctionInfo -> FunctionMeta b)
-> [PGRawFunctionInfo] -> [FunctionMeta b]
forall a b. (a -> b) -> [a] -> [b]
map PGRawFunctionInfo -> FunctionMeta b
mkFunctionMeta) (Maybe [PGRawFunctionInfo] -> [FunctionMeta b])
-> Maybe [PGRawFunctionInfo] -> [FunctionMeta b]
forall a b. (a -> b) -> a -> b
$ FunctionName b
-> HashMap (FunctionName b) [PGRawFunctionInfo]
-> Maybe [PGRawFunctionInfo]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup FunctionName b
function HashMap (FunctionName b) [PGRawFunctionInfo]
functionMetaInfos
runRunSQL ::
forall (pgKind :: PostgresKind) m.
( BackendMetadata ('Postgres pgKind),
ToMetadataFetchQuery pgKind,
FetchTableMetadata pgKind,
FetchFunctionMetadata pgKind,
CacheRWM m,
HasServerConfigCtx m,
MetadataM m,
MonadBaseControl IO m,
MonadError QErr m,
MonadIO m,
Tracing.MonadTrace m,
UserInfoM m
) =>
RunSQL ->
m EncJSON
runRunSQL :: RunSQL -> m EncJSON
runRunSQL q :: RunSQL
q@RunSQL {Bool
Maybe Bool
Text
TxAccess
SourceName
rTxAccessMode :: TxAccess
rCheckMetadataConsistency :: Maybe Bool
rCascade :: Bool
rSource :: SourceName
rSql :: Text
rTxAccessMode :: RunSQL -> TxAccess
rCheckMetadataConsistency :: RunSQL -> Maybe Bool
rCascade :: RunSQL -> Bool
rSource :: RunSQL -> SourceName
rSql :: RunSQL -> Text
..} = do
PGSourceConfig
sourceConfig <- SourceName -> m (SourceConfig ('Postgres pgKind))
forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
SourceName -> m (SourceConfig b)
askSourceConfig @('Postgres pgKind) SourceName
rSource
TraceContext
traceCtx <- m TraceContext
forall (m :: * -> *). MonadTrace m => m TraceContext
Tracing.currentContext
UserInfo
userInfo <- m UserInfo
forall (m :: * -> *). UserInfoM m => m UserInfo
askUserInfo
let pgExecCtx :: PGExecCtx
pgExecCtx = PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
sourceConfig
if (RunSQL -> Bool
isSchemaCacheBuildRequiredRunSQL RunSQL
q)
then do
SourceName -> Bool -> TxAccess -> TxET QErr m EncJSON -> m EncJSON
forall (pgKind :: PostgresKind) a (m :: * -> *).
(BackendMetadata ('Postgres pgKind), ToMetadataFetchQuery pgKind,
FetchTableMetadata pgKind, FetchFunctionMetadata pgKind,
CacheRWM m, HasServerConfigCtx m, MetadataM m,
MonadBaseControl IO m, MonadError QErr m, MonadIO m) =>
SourceName -> Bool -> TxAccess -> TxET QErr m a -> m a
withMetadataCheck @pgKind SourceName
rSource Bool
rCascade TxAccess
rTxAccessMode (TxET QErr m EncJSON -> m EncJSON)
-> TxET QErr m EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$
TraceContext -> TxET QErr m EncJSON -> TxET QErr m EncJSON
forall (m :: * -> *) a.
MonadIO m =>
TraceContext -> TxET QErr m a -> TxET QErr m a
withTraceContext TraceContext
traceCtx (TxET QErr m EncJSON -> TxET QErr m EncJSON)
-> TxET QErr m EncJSON -> TxET QErr m EncJSON
forall a b. (a -> b) -> a -> b
$
UserInfo -> TxET QErr m EncJSON -> TxET QErr m EncJSON
forall (m :: * -> *) a.
MonadIO m =>
UserInfo -> TxET QErr m a -> TxET QErr m a
withUserInfo UserInfo
userInfo (TxET QErr m EncJSON -> TxET QErr m EncJSON)
-> TxET QErr m EncJSON -> TxET QErr m EncJSON
forall a b. (a -> b) -> a -> b
$
Text -> TxET QErr m EncJSON
forall (n :: * -> *). MonadTx n => Text -> n EncJSON
execRawSQL Text
rSql
else do
PGExecCtx -> TxAccess -> TxET QErr m EncJSON -> m EncJSON
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m, MonadError QErr m, MonadTrace m,
UserInfoM m) =>
PGExecCtx -> TxAccess -> TxET QErr m a -> m a
runTxWithCtx PGExecCtx
pgExecCtx TxAccess
rTxAccessMode (TxET QErr m EncJSON -> m EncJSON)
-> TxET QErr m EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Text -> TxET QErr m EncJSON
forall (n :: * -> *). MonadTx n => Text -> n EncJSON
execRawSQL Text
rSql
where
execRawSQL :: (MonadTx n) => Text -> n EncJSON
execRawSQL :: Text -> n EncJSON
execRawSQL =
(RunSQLRes -> EncJSON) -> n RunSQLRes -> n EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ToJSON RunSQLRes => RunSQLRes -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue @RunSQLRes) (n RunSQLRes -> n EncJSON)
-> (Text -> n RunSQLRes) -> Text -> n EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxE QErr RunSQLRes -> n RunSQLRes
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr RunSQLRes -> n RunSQLRes)
-> (Text -> TxE QErr RunSQLRes) -> Text -> n RunSQLRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGTxErr -> QErr) -> Query -> TxE QErr RunSQLRes
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> TxET e m a
Q.multiQE PGTxErr -> QErr
forall a. ToJSON a => a -> QErr
rawSqlErrHandler (Query -> TxE QErr RunSQLRes)
-> (Text -> Query) -> Text -> TxE QErr RunSQLRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Query
Q.fromText
where
rawSqlErrHandler :: a -> QErr
rawSqlErrHandler a
txe =
(Code -> Text -> QErr
err400 Code
PostgresError Text
"query execution failed") {qeInternal :: Maybe QErrExtra
qeInternal = QErrExtra -> Maybe QErrExtra
forall a. a -> Maybe a
Just (QErrExtra -> Maybe QErrExtra) -> QErrExtra -> Maybe QErrExtra
forall a b. (a -> b) -> a -> b
$ Value -> QErrExtra
ExtraInternal (Value -> QErrExtra) -> Value -> QErrExtra
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJSON a => a -> Value
toJSON a
txe}
withMetadataCheck ::
forall (pgKind :: PostgresKind) a m.
( BackendMetadata ('Postgres pgKind),
ToMetadataFetchQuery pgKind,
FetchTableMetadata pgKind,
FetchFunctionMetadata pgKind,
CacheRWM m,
HasServerConfigCtx m,
MetadataM m,
MonadBaseControl IO m,
MonadError QErr m,
MonadIO m
) =>
SourceName ->
Bool ->
Q.TxAccess ->
Q.TxET QErr m a ->
m a
withMetadataCheck :: SourceName -> Bool -> TxAccess -> TxET QErr m a -> m a
withMetadataCheck SourceName
source Bool
cascade TxAccess
txAccess TxET QErr m a
runSQLQuery = do
SourceInfo SourceName
_ TableCache ('Postgres pgKind)
tableCache FunctionCache ('Postgres pgKind)
functionCache SourceConfig ('Postgres pgKind)
sourceConfig Maybe QueryTagsConfig
_ SourceCustomization
_ <- SourceName -> m (SourceInfo ('Postgres pgKind))
forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MetadataM m, MonadError QErr m, Backend b) =>
SourceName -> m (SourceInfo b)
askSourceInfo @('Postgres pgKind) SourceName
source
(a
queryResult, MetadataModifier
metadataUpdater) <- SourceName
-> SourceConfig ('Postgres pgKind)
-> TxAccess
-> TableCache ('Postgres pgKind)
-> FunctionCache ('Postgres pgKind)
-> Bool
-> TxET QErr m a
-> m (a, MetadataModifier)
forall (m :: * -> *) a (pgKind :: PostgresKind).
(BackendMetadata ('Postgres pgKind), ToMetadataFetchQuery pgKind,
FetchTableMetadata pgKind, FetchFunctionMetadata pgKind,
CacheRWM m, MonadIO m, MonadBaseControl IO m, MonadError QErr m) =>
SourceName
-> SourceConfig ('Postgres pgKind)
-> TxAccess
-> TableCache ('Postgres pgKind)
-> FunctionCache ('Postgres pgKind)
-> Bool
-> TxET QErr m a
-> m (a, MetadataModifier)
runTxWithMetadataCheck SourceName
source SourceConfig ('Postgres pgKind)
sourceConfig TxAccess
txAccess TableCache ('Postgres pgKind)
tableCache FunctionCache ('Postgres pgKind)
functionCache Bool
cascade TxET QErr m a
runSQLQuery
m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
CacheInvalidations -> MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
CacheInvalidations -> MetadataModifier -> m ()
buildSchemaCacheWithInvalidations CacheInvalidations
forall a. Monoid a => a
mempty {ciSources :: HashSet SourceName
ciSources = SourceName -> HashSet SourceName
forall a. Hashable a => a -> HashSet a
HS.singleton SourceName
source} MetadataModifier
metadataUpdater
SchemaCache
postRunSQLSchemaCache <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
PGSourceConfig -> SchemaCache -> m ()
recreateEventTriggers PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig SchemaCache
postRunSQLSchemaCache
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
queryResult
where
recreateEventTriggers :: PGSourceConfig -> SchemaCache -> m ()
recreateEventTriggers :: PGSourceConfig -> SchemaCache -> m ()
recreateEventTriggers PGSourceConfig
sourceConfig SchemaCache
schemaCache = do
let tables :: HashMap QualifiedTable (TableInfo ('Postgres pgKind))
tables = HashMap QualifiedTable (TableInfo ('Postgres pgKind))
-> Maybe (HashMap QualifiedTable (TableInfo ('Postgres pgKind)))
-> HashMap QualifiedTable (TableInfo ('Postgres pgKind))
forall a. a -> Maybe a -> a
fromMaybe HashMap QualifiedTable (TableInfo ('Postgres pgKind))
forall a. Monoid a => a
mempty (Maybe (HashMap QualifiedTable (TableInfo ('Postgres pgKind)))
-> HashMap QualifiedTable (TableInfo ('Postgres pgKind)))
-> Maybe (HashMap QualifiedTable (TableInfo ('Postgres pgKind)))
-> HashMap QualifiedTable (TableInfo ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$ SourceName -> SourceCache -> Maybe (TableCache ('Postgres pgKind))
forall (b :: BackendType).
Backend b =>
SourceName -> SourceCache -> Maybe (TableCache b)
unsafeTableCache @('Postgres pgKind) SourceName
source (SourceCache -> Maybe (TableCache ('Postgres pgKind)))
-> SourceCache -> Maybe (TableCache ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$ SchemaCache -> SourceCache
scSources SchemaCache
schemaCache
ServerConfigCtx
serverConfigCtx <- m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx
m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ()) -> m (Either QErr ()) -> m ()
forall a b. (a -> b) -> a -> b
$
PGSourceConfig -> TxET QErr m () -> m (Either QErr ())
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
PGSourceConfig -> TxET QErr m a -> m (Either QErr a)
runPgSourceWriteTx PGSourceConfig
sourceConfig (TxET QErr m () -> m (Either QErr ()))
-> TxET QErr m () -> m (Either QErr ())
forall a b. (a -> b) -> a -> b
$
[TableInfo ('Postgres pgKind)]
-> (TableInfo ('Postgres pgKind) -> TxET QErr m ())
-> TxET QErr m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HashMap QualifiedTable (TableInfo ('Postgres pgKind))
-> [TableInfo ('Postgres pgKind)]
forall k v. HashMap k v -> [v]
M.elems HashMap QualifiedTable (TableInfo ('Postgres pgKind))
tables) ((TableInfo ('Postgres pgKind) -> TxET QErr m ())
-> TxET QErr m ())
-> (TableInfo ('Postgres pgKind) -> TxET QErr m ())
-> TxET QErr m ()
forall a b. (a -> b) -> a -> b
$ \(TableInfo TableCoreInfo ('Postgres pgKind)
coreInfo RolePermInfoMap ('Postgres pgKind)
_ EventTriggerInfoMap ('Postgres pgKind)
eventTriggers RolePermInfo ('Postgres pgKind)
_) -> do
let table :: TableName ('Postgres pgKind)
table = TableCoreInfo ('Postgres pgKind) -> TableName ('Postgres pgKind)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableName b
_tciName TableCoreInfo ('Postgres pgKind)
coreInfo
columns :: [ColumnInfo ('Postgres pgKind)]
columns = FieldInfoMap (FieldInfo ('Postgres pgKind))
-> [ColumnInfo ('Postgres pgKind)]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [ColumnInfo backend]
getCols (FieldInfoMap (FieldInfo ('Postgres pgKind))
-> [ColumnInfo ('Postgres pgKind)])
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
-> [ColumnInfo ('Postgres pgKind)]
forall a b. (a -> b) -> a -> b
$ TableCoreInfo ('Postgres pgKind)
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfo ('Postgres pgKind)
coreInfo
[(TriggerName, EventTriggerInfo ('Postgres pgKind))]
-> ((TriggerName, EventTriggerInfo ('Postgres pgKind))
-> TxET QErr m ())
-> TxET QErr m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (EventTriggerInfoMap ('Postgres pgKind)
-> [(TriggerName, EventTriggerInfo ('Postgres pgKind))]
forall k v. HashMap k v -> [(k, v)]
M.toList EventTriggerInfoMap ('Postgres pgKind)
eventTriggers) (((TriggerName, EventTriggerInfo ('Postgres pgKind))
-> TxET QErr m ())
-> TxET QErr m ())
-> ((TriggerName, EventTriggerInfo ('Postgres pgKind))
-> TxET QErr m ())
-> TxET QErr m ()
forall a b. (a -> b) -> a -> b
$ \(TriggerName
triggerName, EventTriggerInfo ('Postgres pgKind)
eti) -> do
let opsDefinition :: TriggerOpsDef ('Postgres pgKind)
opsDefinition = EventTriggerInfo ('Postgres pgKind)
-> TriggerOpsDef ('Postgres pgKind)
forall (b :: BackendType). EventTriggerInfo b -> TriggerOpsDef b
etiOpsDef EventTriggerInfo ('Postgres pgKind)
eti
(ReaderT ServerConfigCtx (TxET QErr m) ()
-> ServerConfigCtx -> TxET QErr m ())
-> ServerConfigCtx
-> ReaderT ServerConfigCtx (TxET QErr m) ()
-> TxET QErr m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT ServerConfigCtx (TxET QErr m) ()
-> ServerConfigCtx -> TxET QErr m ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ServerConfigCtx
serverConfigCtx (ReaderT ServerConfigCtx (TxET QErr m) () -> TxET QErr m ())
-> ReaderT ServerConfigCtx (TxET QErr m) () -> TxET QErr m ()
forall a b. (a -> b) -> a -> b
$ TriggerName
-> QualifiedTable
-> [ColumnInfo ('Postgres pgKind)]
-> TriggerOpsDef ('Postgres pgKind)
-> ReaderT ServerConfigCtx (TxET QErr m) ()
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), MonadTx m,
MonadReader ServerConfigCtx m) =>
TriggerName
-> QualifiedTable
-> [ColumnInfo ('Postgres pgKind)]
-> TriggerOpsDef ('Postgres pgKind)
-> m ()
mkAllTriggersQ TriggerName
triggerName TableName ('Postgres pgKind)
QualifiedTable
table [ColumnInfo ('Postgres pgKind)]
columns TriggerOpsDef ('Postgres pgKind)
opsDefinition
runTxWithMetadataCheck ::
forall m a (pgKind :: PostgresKind).
( BackendMetadata ('Postgres pgKind),
ToMetadataFetchQuery pgKind,
FetchTableMetadata pgKind,
FetchFunctionMetadata pgKind,
CacheRWM m,
MonadIO m,
MonadBaseControl IO m,
MonadError QErr m
) =>
SourceName ->
SourceConfig ('Postgres pgKind) ->
Q.TxAccess ->
TableCache ('Postgres pgKind) ->
FunctionCache ('Postgres pgKind) ->
Bool ->
Q.TxET QErr m a ->
m (a, MetadataModifier)
runTxWithMetadataCheck :: SourceName
-> SourceConfig ('Postgres pgKind)
-> TxAccess
-> TableCache ('Postgres pgKind)
-> FunctionCache ('Postgres pgKind)
-> Bool
-> TxET QErr m a
-> m (a, MetadataModifier)
runTxWithMetadataCheck SourceName
source SourceConfig ('Postgres pgKind)
sourceConfig TxAccess
txAccess TableCache ('Postgres pgKind)
tableCache FunctionCache ('Postgres pgKind)
functionCache Bool
cascadeDependencies TxET QErr m a
tx =
m (Either QErr (a, MetadataModifier)) -> m (a, MetadataModifier)
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr (a, MetadataModifier)) -> m (a, MetadataModifier))
-> m (Either QErr (a, MetadataModifier)) -> m (a, MetadataModifier)
forall a b. (a -> b) -> a -> b
$
ExceptT QErr m (a, MetadataModifier)
-> m (Either QErr (a, MetadataModifier))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr m (a, MetadataModifier)
-> m (Either QErr (a, MetadataModifier)))
-> ExceptT QErr m (a, MetadataModifier)
-> m (Either QErr (a, MetadataModifier))
forall a b. (a -> b) -> a -> b
$
PGExecCtx
-> TxAccess
-> TxET QErr m (a, MetadataModifier)
-> ExceptT QErr m (a, MetadataModifier)
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
PGExecCtx -> TxAccess -> TxET QErr m a -> ExceptT QErr m a
runTx (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig) TxAccess
txAccess (TxET QErr m (a, MetadataModifier)
-> ExceptT QErr m (a, MetadataModifier))
-> TxET QErr m (a, MetadataModifier)
-> ExceptT QErr m (a, MetadataModifier)
forall a b. (a -> b) -> a -> b
$ do
let tableNames :: [QualifiedTable]
tableNames = HashMap QualifiedTable (TableInfo ('Postgres pgKind))
-> [QualifiedTable]
forall k v. HashMap k v -> [k]
M.keys TableCache ('Postgres pgKind)
HashMap QualifiedTable (TableInfo ('Postgres pgKind))
tableCache
computedFieldFunctions :: [QualifiedFunction]
computedFieldFunctions = (TableInfo ('Postgres pgKind) -> [QualifiedFunction])
-> [TableInfo ('Postgres pgKind)] -> [QualifiedFunction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TableInfo ('Postgres pgKind) -> [QualifiedFunction]
forall (pgKind :: PostgresKind).
TableInfo ('Postgres pgKind) -> [FunctionName ('Postgres pgKind)]
getComputedFieldFunctions (HashMap QualifiedTable (TableInfo ('Postgres pgKind))
-> [TableInfo ('Postgres pgKind)]
forall k v. HashMap k v -> [v]
M.elems TableCache ('Postgres pgKind)
HashMap QualifiedTable (TableInfo ('Postgres pgKind))
tableCache)
functionNames :: [QualifiedFunction]
functionNames = HashMap QualifiedFunction (FunctionInfo ('Postgres pgKind))
-> [QualifiedFunction]
forall k v. HashMap k v -> [k]
M.keys FunctionCache ('Postgres pgKind)
HashMap QualifiedFunction (FunctionInfo ('Postgres pgKind))
functionCache [QualifiedFunction] -> [QualifiedFunction] -> [QualifiedFunction]
forall a. Semigroup a => a -> a -> a
<> [QualifiedFunction]
computedFieldFunctions
([TableMeta ('Postgres pgKind)]
preTxTablesMeta, [FunctionMeta ('Postgres pgKind)]
preTxFunctionsMeta) <- TableCache ('Postgres pgKind)
-> [TableName ('Postgres pgKind)]
-> [FunctionName ('Postgres pgKind)]
-> TxET
QErr
m
([TableMeta ('Postgres pgKind)], [FunctionMeta ('Postgres pgKind)])
forall (pgKind :: PostgresKind) (m :: * -> *).
(ToMetadataFetchQuery pgKind, FetchTableMetadata pgKind,
FetchFunctionMetadata pgKind, BackendMetadata ('Postgres pgKind),
MonadTx m) =>
TableCache ('Postgres pgKind)
-> [TableName ('Postgres pgKind)]
-> [FunctionName ('Postgres pgKind)]
-> m ([TableMeta ('Postgres pgKind)],
[FunctionMeta ('Postgres pgKind)])
fetchTablesFunctionsMetadata TableCache ('Postgres pgKind)
tableCache [TableName ('Postgres pgKind)]
[QualifiedTable]
tableNames [FunctionName ('Postgres pgKind)]
[QualifiedFunction]
functionNames
let tableOids :: [OID]
tableOids = (TableMeta ('Postgres pgKind) -> OID)
-> [TableMeta ('Postgres pgKind)] -> [OID]
forall a b. (a -> b) -> [a] -> [b]
map (DBTableMetadata ('Postgres pgKind) -> OID
forall (b :: BackendType). DBTableMetadata b -> OID
_ptmiOid (DBTableMetadata ('Postgres pgKind) -> OID)
-> (TableMeta ('Postgres pgKind)
-> DBTableMetadata ('Postgres pgKind))
-> TableMeta ('Postgres pgKind)
-> OID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableMeta ('Postgres pgKind) -> DBTableMetadata ('Postgres pgKind)
forall (b :: BackendType). TableMeta b -> DBTableMetadata b
tmInfo) [TableMeta ('Postgres pgKind)]
preTxTablesMeta
functionOids :: [OID]
functionOids = (FunctionMeta ('Postgres pgKind) -> OID)
-> [FunctionMeta ('Postgres pgKind)] -> [OID]
forall a b. (a -> b) -> [a] -> [b]
map FunctionMeta ('Postgres pgKind) -> OID
forall (b :: BackendType). FunctionMeta b -> OID
fmOid [FunctionMeta ('Postgres pgKind)]
preTxFunctionsMeta
a
txResult <- TxET QErr m a
tx
([TableMeta ('Postgres pgKind)]
postTxTablesMeta, [FunctionMeta ('Postgres pgKind)]
postTxFunctionMeta) <-
([QualifiedTable]
-> [QualifiedFunction]
-> TxET
QErr
m
([TableMeta ('Postgres pgKind)],
[FunctionMeta ('Postgres pgKind)]))
-> ([QualifiedTable], [QualifiedFunction])
-> TxET
QErr
m
([TableMeta ('Postgres pgKind)], [FunctionMeta ('Postgres pgKind)])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (TableCache ('Postgres pgKind)
-> [TableName ('Postgres pgKind)]
-> [FunctionName ('Postgres pgKind)]
-> TxET
QErr
m
([TableMeta ('Postgres pgKind)], [FunctionMeta ('Postgres pgKind)])
forall (pgKind :: PostgresKind) (m :: * -> *).
(ToMetadataFetchQuery pgKind, FetchTableMetadata pgKind,
FetchFunctionMetadata pgKind, BackendMetadata ('Postgres pgKind),
MonadTx m) =>
TableCache ('Postgres pgKind)
-> [TableName ('Postgres pgKind)]
-> [FunctionName ('Postgres pgKind)]
-> m ([TableMeta ('Postgres pgKind)],
[FunctionMeta ('Postgres pgKind)])
fetchTablesFunctionsMetadata TableCache ('Postgres pgKind)
tableCache)
(([QualifiedTable], [QualifiedFunction])
-> TxET
QErr
m
([TableMeta ('Postgres pgKind)],
[FunctionMeta ('Postgres pgKind)]))
-> TxET QErr m ([QualifiedTable], [QualifiedFunction])
-> TxET
QErr
m
([TableMeta ('Postgres pgKind)], [FunctionMeta ('Postgres pgKind)])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [OID]
-> [OID]
-> TxET
QErr
m
([TableName ('Postgres Any)], [FunctionName ('Postgres Any)])
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadIO m =>
[OID]
-> [OID]
-> TxET
QErr
m
([TableName ('Postgres pgKind)], [FunctionName ('Postgres pgKind)])
fetchTablesFunctionsFromOids [OID]
tableOids [OID]
functionOids
let tablesDiff :: TablesDiff ('Postgres pgKind)
tablesDiff = [TableMeta ('Postgres pgKind)]
-> [TableMeta ('Postgres pgKind)] -> TablesDiff ('Postgres pgKind)
forall (b :: BackendType).
Backend b =>
[TableMeta b] -> [TableMeta b] -> TablesDiff b
getTablesDiff [TableMeta ('Postgres pgKind)]
preTxTablesMeta [TableMeta ('Postgres pgKind)]
postTxTablesMeta
excludeComputedFieldFunctions :: [FunctionMeta ('Postgres pgKind)]
-> [FunctionMeta ('Postgres pgKind)]
excludeComputedFieldFunctions = (FunctionMeta ('Postgres pgKind) -> Bool)
-> [FunctionMeta ('Postgres pgKind)]
-> [FunctionMeta ('Postgres pgKind)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((QualifiedFunction
-> HashMap QualifiedFunction (FunctionInfo ('Postgres pgKind))
-> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`M.member` FunctionCache ('Postgres pgKind)
HashMap QualifiedFunction (FunctionInfo ('Postgres pgKind))
functionCache) (QualifiedFunction -> Bool)
-> (FunctionMeta ('Postgres pgKind) -> QualifiedFunction)
-> FunctionMeta ('Postgres pgKind)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionMeta ('Postgres pgKind) -> QualifiedFunction
forall (b :: BackendType). FunctionMeta b -> FunctionName b
fmFunction)
functionsDiff :: FunctionsDiff ('Postgres pgKind)
functionsDiff =
[FunctionMeta ('Postgres pgKind)]
-> [FunctionMeta ('Postgres pgKind)]
-> FunctionsDiff ('Postgres pgKind)
forall (b :: BackendType).
[FunctionMeta b] -> [FunctionMeta b] -> FunctionsDiff b
getFunctionsDiff
([FunctionMeta ('Postgres pgKind)]
-> [FunctionMeta ('Postgres pgKind)]
excludeComputedFieldFunctions [FunctionMeta ('Postgres pgKind)]
preTxFunctionsMeta)
([FunctionMeta ('Postgres pgKind)]
-> [FunctionMeta ('Postgres pgKind)]
excludeComputedFieldFunctions [FunctionMeta ('Postgres pgKind)]
postTxFunctionMeta)
[FunctionName ('Postgres pgKind)] -> TxET QErr m ()
forall (n :: * -> *).
MonadError QErr n =>
[FunctionName ('Postgres pgKind)] -> n ()
dontAllowFunctionOverloading ([FunctionName ('Postgres pgKind)] -> TxET QErr m ())
-> [FunctionName ('Postgres pgKind)] -> TxET QErr m ()
forall a b. (a -> b) -> a -> b
$
[FunctionName ('Postgres pgKind)]
-> [FunctionMeta ('Postgres pgKind)]
-> [FunctionName ('Postgres pgKind)]
forall (b :: BackendType).
Backend b =>
[FunctionName b] -> [FunctionMeta b] -> [FunctionName b]
getOverloadedFunctions
(HashMap QualifiedFunction (FunctionInfo ('Postgres pgKind))
-> [QualifiedFunction]
forall k v. HashMap k v -> [k]
M.keys FunctionCache ('Postgres pgKind)
HashMap QualifiedFunction (FunctionInfo ('Postgres pgKind))
functionCache)
([FunctionMeta ('Postgres pgKind)]
-> [FunctionMeta ('Postgres pgKind)]
excludeComputedFieldFunctions [FunctionMeta ('Postgres pgKind)]
postTxFunctionMeta)
MetadataModifier
metadataUpdater <- WriterT MetadataModifier (TxET QErr m) ()
-> TxET QErr m MetadataModifier
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT do
[SchemaObjId]
tableIndirectDeps <- SourceName
-> TablesDiff ('Postgres pgKind)
-> WriterT MetadataModifier (TxET QErr m) [SchemaObjId]
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TablesDiff b -> m [SchemaObjId]
getIndirectDependenciesFromTableDiff SourceName
source TablesDiff ('Postgres pgKind)
tablesDiff
Bool
-> WriterT MetadataModifier (TxET QErr m) ()
-> WriterT MetadataModifier (TxET QErr m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SchemaObjId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SchemaObjId]
tableIndirectDeps Bool -> Bool -> Bool
|| Bool
cascadeDependencies) (WriterT MetadataModifier (TxET QErr m) ()
-> WriterT MetadataModifier (TxET QErr m) ())
-> WriterT MetadataModifier (TxET QErr m) ()
-> WriterT MetadataModifier (TxET QErr m) ()
forall a b. (a -> b) -> a -> b
$ [SchemaObjId] -> WriterT MetadataModifier (TxET QErr m) ()
forall (m :: * -> *). MonadError QErr m => [SchemaObjId] -> m ()
reportDependentObjectsExist [SchemaObjId]
tableIndirectDeps
(SchemaObjId -> WriterT MetadataModifier (TxET QErr m) ())
-> [SchemaObjId] -> WriterT MetadataModifier (TxET QErr m) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ SchemaObjId -> WriterT MetadataModifier (TxET QErr m) ()
forall (m :: * -> *).
MonadError QErr m =>
SchemaObjId -> WriterT MetadataModifier m ()
purgeSourceAndSchemaDependencies [SchemaObjId]
tableIndirectDeps
let purgedFunctions :: [FunctionName ('Postgres pgKind)]
purgedFunctions = [SchemaObjId] -> [FunctionName ('Postgres pgKind)]
collectFunctionsInDeps [SchemaObjId]
tableIndirectDeps
FunctionsDiff [FunctionName ('Postgres pgKind)]
droppedFunctions [(FunctionName ('Postgres pgKind), FunctionVolatility)]
alteredFunctions = FunctionsDiff ('Postgres pgKind)
functionsDiff
[FunctionName ('Postgres pgKind)]
-> WriterT MetadataModifier (TxET QErr m) ()
forall (n :: * -> *).
Monad n =>
[FunctionName ('Postgres pgKind)] -> WriterT MetadataModifier n ()
purgeFunctionsFromMetadata ([FunctionName ('Postgres pgKind)]
-> WriterT MetadataModifier (TxET QErr m) ())
-> [FunctionName ('Postgres pgKind)]
-> WriterT MetadataModifier (TxET QErr m) ()
forall a b. (a -> b) -> a -> b
$ [FunctionName ('Postgres pgKind)]
[QualifiedFunction]
droppedFunctions [QualifiedFunction] -> [QualifiedFunction] -> [QualifiedFunction]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FunctionName ('Postgres pgKind)]
[QualifiedFunction]
purgedFunctions
[(FunctionName ('Postgres pgKind), FunctionVolatility)]
-> WriterT MetadataModifier (TxET QErr m) ()
forall (n :: * -> *).
MonadError QErr n =>
[(FunctionName ('Postgres pgKind), FunctionVolatility)] -> n ()
dontAllowFunctionAlteredVolatile [(FunctionName ('Postgres pgKind), FunctionVolatility)]
alteredFunctions
SourceName
-> TableCache ('Postgres pgKind)
-> TablesDiff ('Postgres pgKind)
-> WriterT MetadataModifier (TxET QErr m) ()
forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRM m, MonadWriter MetadataModifier m,
BackendMetadata b) =>
SourceName -> TableCache b -> TablesDiff b -> m ()
processTablesDiff SourceName
source TableCache ('Postgres pgKind)
tableCache TablesDiff ('Postgres pgKind)
tablesDiff
(a, MetadataModifier) -> TxET QErr m (a, MetadataModifier)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
txResult, MetadataModifier
metadataUpdater)
where
dontAllowFunctionOverloading ::
MonadError QErr n =>
[FunctionName ('Postgres pgKind)] ->
n ()
dontAllowFunctionOverloading :: [FunctionName ('Postgres pgKind)] -> n ()
dontAllowFunctionOverloading [FunctionName ('Postgres pgKind)]
overloadedFunctions =
Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([QualifiedFunction] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FunctionName ('Postgres pgKind)]
[QualifiedFunction]
overloadedFunctions) (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$
Code -> Text -> n ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text -> n ()) -> Text -> n ()
forall a b. (a -> b) -> a -> b
$
Text
"the following tracked function(s) cannot be overloaded: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [QualifiedFunction] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated [FunctionName ('Postgres pgKind)]
[QualifiedFunction]
overloadedFunctions
dontAllowFunctionAlteredVolatile ::
MonadError QErr n =>
[(FunctionName ('Postgres pgKind), FunctionVolatility)] ->
n ()
dontAllowFunctionAlteredVolatile :: [(FunctionName ('Postgres pgKind), FunctionVolatility)] -> n ()
dontAllowFunctionAlteredVolatile [(FunctionName ('Postgres pgKind), FunctionVolatility)]
alteredFunctions =
[(QualifiedFunction, FunctionVolatility)]
-> ((QualifiedFunction, FunctionVolatility) -> n ()) -> n ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(FunctionName ('Postgres pgKind), FunctionVolatility)]
[(QualifiedFunction, FunctionVolatility)]
alteredFunctions (((QualifiedFunction, FunctionVolatility) -> n ()) -> n ())
-> ((QualifiedFunction, FunctionVolatility) -> n ()) -> n ()
forall a b. (a -> b) -> a -> b
$ \(QualifiedFunction
qf, FunctionVolatility
newTy) -> do
Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FunctionVolatility
newTy FunctionVolatility -> FunctionVolatility -> Bool
forall a. Eq a => a -> a -> Bool
== FunctionVolatility
FTVOLATILE) (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$
Code -> Text -> n ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text -> n ()) -> Text -> n ()
forall a b. (a -> b) -> a -> b
$
Text
"type of function " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedFunction
qf QualifiedFunction -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is altered to \"VOLATILE\" which is not supported now"
purgeFunctionsFromMetadata ::
Monad n =>
[FunctionName ('Postgres pgKind)] ->
WriterT MetadataModifier n ()
purgeFunctionsFromMetadata :: [FunctionName ('Postgres pgKind)] -> WriterT MetadataModifier n ()
purgeFunctionsFromMetadata [FunctionName ('Postgres pgKind)]
functions =
[QualifiedFunction]
-> (QualifiedFunction -> WriterT MetadataModifier n ())
-> WriterT MetadataModifier n ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [FunctionName ('Postgres pgKind)]
[QualifiedFunction]
functions ((QualifiedFunction -> WriterT MetadataModifier n ())
-> WriterT MetadataModifier n ())
-> (QualifiedFunction -> WriterT MetadataModifier n ())
-> WriterT MetadataModifier n ()
forall a b. (a -> b) -> a -> b
$ MetadataModifier -> WriterT MetadataModifier n ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (MetadataModifier -> WriterT MetadataModifier n ())
-> (QualifiedFunction -> MetadataModifier)
-> QualifiedFunction
-> WriterT MetadataModifier n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName -> FunctionName ('Postgres pgKind) -> MetadataModifier
forall (b :: BackendType).
Backend b =>
SourceName -> FunctionName b -> MetadataModifier
dropFunctionInMetadata @('Postgres pgKind) SourceName
source
collectFunctionsInDeps :: [SchemaObjId] -> [FunctionName ('Postgres pgKind)]
collectFunctionsInDeps :: [SchemaObjId] -> [FunctionName ('Postgres pgKind)]
collectFunctionsInDeps [SchemaObjId]
deps =
((SchemaObjId -> Maybe QualifiedFunction)
-> [SchemaObjId] -> [QualifiedFunction])
-> [SchemaObjId]
-> (SchemaObjId -> Maybe QualifiedFunction)
-> [QualifiedFunction]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SchemaObjId -> Maybe QualifiedFunction)
-> [SchemaObjId] -> [QualifiedFunction]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe [SchemaObjId]
deps \case
SOSourceObj SourceName
_ AnyBackend SourceObjId
objectID
| Just (SOIFunction FunctionName ('Postgres pgKind)
qf) <- AnyBackend SourceObjId -> Maybe (SourceObjId ('Postgres pgKind))
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
AB.unpackAnyBackend @('Postgres pgKind) AnyBackend SourceObjId
objectID ->
QualifiedFunction -> Maybe QualifiedFunction
forall a. a -> Maybe a
Just FunctionName ('Postgres pgKind)
QualifiedFunction
qf
SchemaObjId
_ -> Maybe QualifiedFunction
forall a. Maybe a
Nothing
fetchTablesFunctionsFromOids ::
(MonadIO m) =>
[OID] ->
[OID] ->
Q.TxET QErr m ([TableName ('Postgres pgKind)], [FunctionName ('Postgres pgKind)])
fetchTablesFunctionsFromOids :: [OID]
-> [OID]
-> TxET
QErr
m
([TableName ('Postgres pgKind)], [FunctionName ('Postgres pgKind)])
fetchTablesFunctionsFromOids [OID]
tableOids [OID]
functionOids =
((AltJ [QualifiedTable] -> [QualifiedTable]
forall a. AltJ a -> a
Q.getAltJ (AltJ [QualifiedTable] -> [QualifiedTable])
-> (AltJ [QualifiedFunction] -> [QualifiedFunction])
-> (AltJ [QualifiedTable], AltJ [QualifiedFunction])
-> ([QualifiedTable], [QualifiedFunction])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** AltJ [QualifiedFunction] -> [QualifiedFunction]
forall a. AltJ a -> a
Q.getAltJ) ((AltJ [QualifiedTable], AltJ [QualifiedFunction])
-> ([QualifiedTable], [QualifiedFunction]))
-> (SingleRow (AltJ [QualifiedTable], AltJ [QualifiedFunction])
-> (AltJ [QualifiedTable], AltJ [QualifiedFunction]))
-> SingleRow (AltJ [QualifiedTable], AltJ [QualifiedFunction])
-> ([QualifiedTable], [QualifiedFunction])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (AltJ [QualifiedTable], AltJ [QualifiedFunction])
-> (AltJ [QualifiedTable], AltJ [QualifiedFunction])
forall a. SingleRow a -> a
Q.getRow)
(SingleRow (AltJ [QualifiedTable], AltJ [QualifiedFunction])
-> ([QualifiedTable], [QualifiedFunction]))
-> TxET
QErr
m
(SingleRow (AltJ [QualifiedTable], AltJ [QualifiedFunction]))
-> TxET QErr m ([QualifiedTable], [QualifiedFunction])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PGTxErr -> QErr)
-> Query
-> (AltJ [Value], AltJ [Value])
-> Bool
-> TxET
QErr
m
(SingleRow (AltJ [QualifiedTable], AltJ [QualifiedFunction]))
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
Q.withQE
PGTxErr -> QErr
defaultTxErrorHandler
[Q.sql|
SELECT
COALESCE(
( SELECT
json_agg(
row_to_json(
(
SELECT e
FROM ( SELECT "table".relname AS "name",
"schema".nspname AS "schema"
) AS e
)
)
) AS "item"
FROM jsonb_to_recordset($1::jsonb) AS oid_table("oid" int)
JOIN pg_catalog.pg_class "table" ON ("table".oid = "oid_table".oid)
JOIN pg_catalog.pg_namespace "schema" ON ("schema".oid = "table".relnamespace)
),
'[]'
) AS "tables",
COALESCE(
( SELECT
json_agg(
row_to_json(
(
SELECT e
FROM ( SELECT "function".proname AS "name",
"schema".nspname AS "schema"
) AS e
)
)
) AS "item"
FROM jsonb_to_recordset($2::jsonb) AS oid_table("oid" int)
JOIN pg_catalog.pg_proc "function" ON ("function".oid = "oid_table".oid)
JOIN pg_catalog.pg_namespace "schema" ON ("schema".oid = "function".pronamespace)
),
'[]'
) AS "functions"
|]
([Value] -> AltJ [Value]
forall a. a -> AltJ a
Q.AltJ ([Value] -> AltJ [Value]) -> [Value] -> AltJ [Value]
forall a b. (a -> b) -> a -> b
$ (OID -> Value) -> [OID] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map OID -> Value
forall a. ToJSON a => a -> Value
mkOidObject [OID]
tableOids, [Value] -> AltJ [Value]
forall a. a -> AltJ a
Q.AltJ ([Value] -> AltJ [Value]) -> [Value] -> AltJ [Value]
forall a b. (a -> b) -> a -> b
$ (OID -> Value) -> [OID] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map OID -> Value
forall a. ToJSON a => a -> Value
mkOidObject [OID]
functionOids)
Bool
True
where
mkOidObject :: v -> Value
mkOidObject v
oid = [Pair] -> Value
object [Key
"oid" Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
oid]
getComputedFields :: TableInfo ('Postgres pgKind) -> [ComputedFieldInfo ('Postgres pgKind)]
getComputedFields :: TableInfo ('Postgres pgKind)
-> [ComputedFieldInfo ('Postgres pgKind)]
getComputedFields = FieldInfoMap (FieldInfo ('Postgres pgKind))
-> [ComputedFieldInfo ('Postgres pgKind)]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [ComputedFieldInfo backend]
getComputedFieldInfos (FieldInfoMap (FieldInfo ('Postgres pgKind))
-> [ComputedFieldInfo ('Postgres pgKind)])
-> (TableInfo ('Postgres pgKind)
-> FieldInfoMap (FieldInfo ('Postgres pgKind)))
-> TableInfo ('Postgres pgKind)
-> [ComputedFieldInfo ('Postgres pgKind)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCoreInfoG
('Postgres pgKind)
(FieldInfo ('Postgres pgKind))
(ColumnInfo ('Postgres pgKind))
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap (TableCoreInfoG
('Postgres pgKind)
(FieldInfo ('Postgres pgKind))
(ColumnInfo ('Postgres pgKind))
-> FieldInfoMap (FieldInfo ('Postgres pgKind)))
-> (TableInfo ('Postgres pgKind)
-> TableCoreInfoG
('Postgres pgKind)
(FieldInfo ('Postgres pgKind))
(ColumnInfo ('Postgres pgKind)))
-> TableInfo ('Postgres pgKind)
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo ('Postgres pgKind)
-> TableCoreInfoG
('Postgres pgKind)
(FieldInfo ('Postgres pgKind))
(ColumnInfo ('Postgres pgKind))
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo
getComputedFieldFunctions :: TableInfo ('Postgres pgKind) -> [FunctionName ('Postgres pgKind)]
getComputedFieldFunctions :: TableInfo ('Postgres pgKind) -> [FunctionName ('Postgres pgKind)]
getComputedFieldFunctions = (ComputedFieldInfo ('Postgres pgKind) -> QualifiedFunction)
-> [ComputedFieldInfo ('Postgres pgKind)] -> [QualifiedFunction]
forall a b. (a -> b) -> [a] -> [b]
map (ComputedFieldFunction ('Postgres pgKind) -> QualifiedFunction
forall (b :: BackendType).
ComputedFieldFunction b -> FunctionName b
_cffName (ComputedFieldFunction ('Postgres pgKind) -> QualifiedFunction)
-> (ComputedFieldInfo ('Postgres pgKind)
-> ComputedFieldFunction ('Postgres pgKind))
-> ComputedFieldInfo ('Postgres pgKind)
-> QualifiedFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComputedFieldInfo ('Postgres pgKind)
-> ComputedFieldFunction ('Postgres pgKind)
forall (b :: BackendType).
ComputedFieldInfo b -> ComputedFieldFunction b
_cfiFunction) ([ComputedFieldInfo ('Postgres pgKind)] -> [QualifiedFunction])
-> (TableInfo ('Postgres pgKind)
-> [ComputedFieldInfo ('Postgres pgKind)])
-> TableInfo ('Postgres pgKind)
-> [QualifiedFunction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo ('Postgres pgKind)
-> [ComputedFieldInfo ('Postgres pgKind)]
forall (pgKind :: PostgresKind).
TableInfo ('Postgres pgKind)
-> [ComputedFieldInfo ('Postgres pgKind)]
getComputedFields