mirror of
https://github.com/Airsequel/AirGQL.git
synced 2025-08-27 15:15:38 +03:00
Implement _by_pk updates/deletes
This commit is contained in:
parent
4ce69aaefa
commit
c8a5e17f25
2 changed files with 291 additions and 290 deletions
source/AirGQL
|
@ -47,6 +47,7 @@ import Protolude qualified as P
|
||||||
import Control.Exception (throw)
|
import Control.Exception (throw)
|
||||||
import Control.Monad.Catch (catchAll)
|
import Control.Monad.Catch (catchAll)
|
||||||
import Data.Aeson (object, (.=))
|
import Data.Aeson (object, (.=))
|
||||||
|
import Data.HashMap.Strict (HashMap)
|
||||||
import Data.HashMap.Strict qualified as HashMap
|
import Data.HashMap.Strict qualified as HashMap
|
||||||
import Data.List (nub)
|
import Data.List (nub)
|
||||||
import Data.Ord (Ord (min))
|
import Data.Ord (Ord (min))
|
||||||
|
@ -91,7 +92,6 @@ import AirGQL.Lib (
|
||||||
canRead,
|
canRead,
|
||||||
canWrite,
|
canWrite,
|
||||||
column_name_gql,
|
column_name_gql,
|
||||||
getColumns,
|
|
||||||
)
|
)
|
||||||
import AirGQL.Types.OutObjectType (
|
import AirGQL.Types.OutObjectType (
|
||||||
OutObjectType (OutObjectType, descriptionMb, fields, interfaceTypes, name),
|
OutObjectType (OutObjectType, descriptionMb, fields, interfaceTypes, name),
|
||||||
|
@ -105,6 +105,7 @@ import AirGQL.Types.Utils (encodeToText)
|
||||||
import AirGQL.Utils (colToFileUrl, collectErrorList, quoteKeyword, quoteText)
|
import AirGQL.Utils (colToFileUrl, collectErrorList, quoteKeyword, quoteText)
|
||||||
import Data.Either.Extra qualified as Either
|
import Data.Either.Extra qualified as Either
|
||||||
import Data.List qualified as List
|
import Data.List qualified as List
|
||||||
|
import Language.GraphQL.Class (FromGraphQL (fromGraphQL))
|
||||||
|
|
||||||
|
|
||||||
-- | Prevent numbers of being shown with exponents (0.01 instead of 1e-2)
|
-- | Prevent numbers of being shown with exponents (0.01 instead of 1e-2)
|
||||||
|
@ -268,6 +269,25 @@ getWhereClause filterElements =
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
-- The gql lib does not offer a way to know what properties have
|
||||||
|
-- been requested at the moment, so we always return every column
|
||||||
|
getReturningClause :: TableEntry -> Text
|
||||||
|
getReturningClause table =
|
||||||
|
"RETURNING "
|
||||||
|
<> ( table.columns
|
||||||
|
<&> column_name
|
||||||
|
<&> quoteKeyword
|
||||||
|
& intercalate ", "
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
-- | Converts an argument map of (pk, value) pairs into a list of filters
|
||||||
|
getByPKFilterElements :: HashMap Text Value -> [(Text, Value)]
|
||||||
|
getByPKFilterElements args = do
|
||||||
|
(key, value) <- HashMap.toList args
|
||||||
|
pure (key, Object $ HashMap.singleton "eq" value)
|
||||||
|
|
||||||
|
|
||||||
setCaseInsensitive :: Connection -> [(Text, Value)] -> IO ()
|
setCaseInsensitive :: Connection -> [(Text, Value)] -> IO ()
|
||||||
setCaseInsensitive connection filterElements = do
|
setCaseInsensitive connection filterElements = do
|
||||||
when
|
when
|
||||||
|
@ -365,12 +385,12 @@ gqlValueToSQLData = \case
|
||||||
Object obj -> SQLText $ show obj
|
Object obj -> SQLText $ show obj
|
||||||
|
|
||||||
|
|
||||||
rowToGraphQL :: Text -> Text -> [ColumnEntry] -> [SQLData] -> Either [(Text, Text)] Value
|
rowToGraphQL :: Text -> TableEntry -> [SQLData] -> Either [(Text, Text)] Value
|
||||||
rowToGraphQL dbId tableName columnEntries row =
|
rowToGraphQL dbId table row =
|
||||||
let
|
let
|
||||||
buildMetadataJson :: Text -> Text -> Text
|
buildMetadataJson :: Text -> Text -> Text
|
||||||
buildMetadataJson colName rowid =
|
buildMetadataJson colName rowid =
|
||||||
object ["url" .= colToFileUrl dbId tableName colName rowid]
|
object ["url" .= colToFileUrl dbId table.name colName rowid]
|
||||||
& encodeToText
|
& encodeToText
|
||||||
|
|
||||||
parseSqlData :: (ColumnEntry, SQLData) -> Either (Text, Text) (Text, Value)
|
parseSqlData :: (ColumnEntry, SQLData) -> Either (Text, Text) (Text, Value)
|
||||||
|
@ -405,7 +425,7 @@ rowToGraphQL dbId tableName columnEntries row =
|
||||||
)
|
)
|
||||||
in
|
in
|
||||||
-- => [(ColumnEntry, SQLData)]
|
-- => [(ColumnEntry, SQLData)]
|
||||||
P.zip columnEntries row
|
P.zip table.columns row
|
||||||
-- => [Either (Text, Text) (Text, Value)]
|
-- => [Either (Text, Text) (Text, Value)]
|
||||||
<&> parseSqlData
|
<&> parseSqlData
|
||||||
-- => Either [(Text, Text)] (Text, Value)
|
-- => Either [(Text, Text)] (Text, Value)
|
||||||
|
@ -418,14 +438,13 @@ rowToGraphQL dbId tableName columnEntries row =
|
||||||
|
|
||||||
rowsToGraphQL
|
rowsToGraphQL
|
||||||
:: Text
|
:: Text
|
||||||
-> Text
|
-> TableEntry
|
||||||
-> [ColumnEntry]
|
|
||||||
-> [[SQLData]]
|
-> [[SQLData]]
|
||||||
-> Either [(Text, Text)] Value
|
-> Either [(Text, Text)] Value
|
||||||
rowsToGraphQL dbId tableName columnEntries updatedRows =
|
rowsToGraphQL dbId table updatedRows =
|
||||||
updatedRows
|
updatedRows
|
||||||
-- => [Either [(Text, Text)] Value]
|
-- => [Either [(Text, Text)] Value]
|
||||||
<&> rowToGraphQL dbId tableName columnEntries
|
<&> rowToGraphQL dbId table
|
||||||
-- => Either [[(Text, Text)]] [Value]
|
-- => Either [[(Text, Text)]] [Value]
|
||||||
& collectErrorList
|
& collectErrorList
|
||||||
-- => Either [(Text, Text)] [Value]
|
-- => Either [(Text, Text)] [Value]
|
||||||
|
@ -450,100 +469,106 @@ colErrorsToUserError = \case
|
||||||
"Multiple errors occurred:\n" <> P.unlines errorLines
|
"Multiple errors occurred:\n" <> P.unlines errorLines
|
||||||
|
|
||||||
|
|
||||||
executeSqlMutation
|
tryGetArg
|
||||||
|
:: forall m a
|
||||||
|
. (FromGraphQL a)
|
||||||
|
=> (MonadIO m)
|
||||||
|
=> Text
|
||||||
|
-> HashMap Text Value
|
||||||
|
-> m (Maybe a)
|
||||||
|
tryGetArg name args = do
|
||||||
|
case HashMap.lookup name args of
|
||||||
|
Nothing -> pure Nothing
|
||||||
|
Just value ->
|
||||||
|
case fromGraphQL value of
|
||||||
|
Just decoded -> pure $ Just decoded
|
||||||
|
Nothing ->
|
||||||
|
P.throwIO $
|
||||||
|
userError $
|
||||||
|
"Argument " <> T.unpack name <> " has invalid format"
|
||||||
|
|
||||||
|
|
||||||
|
getArg
|
||||||
|
:: forall m a
|
||||||
|
. (FromGraphQL a)
|
||||||
|
=> (MonadIO m)
|
||||||
|
=> Text
|
||||||
|
-> HashMap Text Value
|
||||||
|
-> m a
|
||||||
|
getArg name args = do
|
||||||
|
result <- tryGetArg name args
|
||||||
|
case result of
|
||||||
|
Just value -> pure value
|
||||||
|
Nothing ->
|
||||||
|
P.throwIO $
|
||||||
|
userError $
|
||||||
|
"Argument " <> T.unpack name <> " not found"
|
||||||
|
|
||||||
|
|
||||||
|
getArgWithDefault
|
||||||
|
:: forall m a
|
||||||
|
. (FromGraphQL a)
|
||||||
|
=> (MonadIO m)
|
||||||
|
=> Text
|
||||||
|
-> HashMap Text Value
|
||||||
|
-> a
|
||||||
|
-> m a
|
||||||
|
getArgWithDefault name args def =
|
||||||
|
tryGetArg name args <&> P.fromMaybe def
|
||||||
|
|
||||||
|
|
||||||
|
executeUpdateMutation
|
||||||
:: Connection
|
:: Connection
|
||||||
-> Text
|
-> TableEntry
|
||||||
-> HashMap.HashMap Text Value
|
-> HashMap Text Value
|
||||||
-> [ColumnEntry]
|
|
||||||
-> [(Text, Value)]
|
-> [(Text, Value)]
|
||||||
-> IO (Int, [[SQLData]])
|
-> IO (Int, [[SQLData]])
|
||||||
executeSqlMutation connection tableName args columnEntries filterElements = do
|
executeUpdateMutation connection table args filterElements = do
|
||||||
|
pairsToSet :: HashMap Text Value <- getArg "set" args
|
||||||
let
|
let
|
||||||
colNamesToUpdateRaw :: [Text]
|
columnsToSet :: [(ColumnEntry, Value)]
|
||||||
colNamesToUpdateRaw =
|
columnsToSet =
|
||||||
case HashMap.lookup "set" args of
|
table.columns
|
||||||
Just (Object dataObj) -> HashMap.keys dataObj
|
& P.mapMaybe
|
||||||
_ -> []
|
( \col -> case HashMap.lookup col.column_name_gql pairsToSet of
|
||||||
|
Just value -> Just (col, value)
|
||||||
|
_ -> Nothing
|
||||||
|
)
|
||||||
|
|
||||||
colNamesToUpdate :: [Text]
|
columnsToSetText :: Text
|
||||||
colNamesToUpdate =
|
columnsToSetText =
|
||||||
columnEntries
|
columnsToSet
|
||||||
<&> column_name
|
<&> (\(col, _) -> quoteKeyword col.column_name <> " = ?")
|
||||||
<&> ( \columnName ->
|
|
||||||
if doubleXEncodeGql columnName `P.elem` colNamesToUpdateRaw
|
|
||||||
then Just columnName
|
|
||||||
else Nothing
|
|
||||||
)
|
|
||||||
& P.catMaybes
|
|
||||||
|
|
||||||
columnNamesText :: Text
|
|
||||||
columnNamesText =
|
|
||||||
columnEntries
|
|
||||||
<&> column_name
|
|
||||||
<&> quoteKeyword
|
|
||||||
& intercalate ", "
|
& intercalate ", "
|
||||||
|
|
||||||
setText :: Text
|
|
||||||
setText =
|
|
||||||
colNamesToUpdate
|
|
||||||
<&> (\columnName -> quoteKeyword columnName <> " = ?")
|
|
||||||
& intercalate ", "
|
|
||||||
|
|
||||||
valuesToSet :: [SQLData]
|
|
||||||
valuesToSet =
|
|
||||||
case HashMap.lookup "set" args of
|
|
||||||
Just (Object dataObj) ->
|
|
||||||
columnEntries
|
|
||||||
<&> column_name
|
|
||||||
<&> ( \columnName ->
|
|
||||||
HashMap.lookup
|
|
||||||
(doubleXEncodeGql columnName)
|
|
||||||
dataObj
|
|
||||||
)
|
|
||||||
& P.catMaybes
|
|
||||||
<&> gqlValueToSQLData
|
|
||||||
_ -> []
|
|
||||||
|
|
||||||
updatedRows :: [[SQLData]] <-
|
updatedRows :: [[SQLData]] <-
|
||||||
if setText == ""
|
if P.null columnsToSet
|
||||||
then pure []
|
then pure []
|
||||||
else
|
else liftIO $ do
|
||||||
let
|
let
|
||||||
sqlQuery =
|
sqlQuery =
|
||||||
Query $
|
Query $
|
||||||
"UPDATE "
|
"UPDATE "
|
||||||
<> quoteKeyword tableName
|
<> quoteKeyword table.name
|
||||||
<> "\n"
|
<> "\n"
|
||||||
<> "SET "
|
<> "SET "
|
||||||
<> setText
|
<> columnsToSetText
|
||||||
<> "\n"
|
<> "\n"
|
||||||
<> getWhereClause filterElements
|
<> getWhereClause filterElements
|
||||||
<> "\n"
|
<> "\n"
|
||||||
<> "RETURNING "
|
<> getReturningClause table
|
||||||
<> columnNamesText
|
|
||||||
|
|
||||||
colTypesToUpdate :: [Text]
|
|
||||||
colTypesToUpdate =
|
|
||||||
columnEntries
|
|
||||||
<&> ( \colEntry ->
|
|
||||||
if doubleXEncodeGql colEntry.column_name
|
|
||||||
`P.elem` colNamesToUpdateRaw
|
|
||||||
then Just colEntry.datatype
|
|
||||||
else Nothing
|
|
||||||
)
|
|
||||||
& P.catMaybes
|
|
||||||
|
|
||||||
valuesToSetNorm =
|
valuesToSetNorm =
|
||||||
P.zip valuesToSet colTypesToUpdate
|
columnsToSet
|
||||||
<&> \(val, datatype) ->
|
<&> \(col, gqlValue) -> do
|
||||||
if (val == SQLText "{}")
|
let sqlValue = gqlValueToSQLData gqlValue
|
||||||
P.&& ("BLOB" `T.isPrefixOf` T.toUpper datatype)
|
if (sqlValue == SQLText "{}")
|
||||||
|
P.&& ("BLOB" `T.isPrefixOf` T.toUpper col.datatype)
|
||||||
then SQLBlob ""
|
then SQLBlob ""
|
||||||
else val
|
else sqlValue
|
||||||
in
|
|
||||||
liftIO $ do
|
setCaseInsensitive connection filterElements
|
||||||
setCaseInsensitive connection filterElements
|
query connection sqlQuery valuesToSetNorm
|
||||||
query connection sqlQuery valuesToSetNorm
|
|
||||||
|
|
||||||
liftIO $
|
liftIO $
|
||||||
changes connection
|
changes connection
|
||||||
|
@ -706,17 +731,12 @@ queryType connection accessMode dbId tables = do
|
||||||
orderElements
|
orderElements
|
||||||
paginationMb
|
paginationMb
|
||||||
|
|
||||||
colErrorsToUserError $ rowsToGraphQL dbId table.name table.columns rows
|
colErrorsToUserError $ rowsToGraphQL dbId table rows
|
||||||
|
|
||||||
getDbEntriesByPK :: TableEntry -> Out.Resolve IO
|
getDbEntriesByPK :: TableEntry -> Out.Resolve IO
|
||||||
getDbEntriesByPK tableEntry = do
|
getDbEntriesByPK tableEntry = do
|
||||||
context <- ask
|
context <- ask
|
||||||
|
let Arguments args = context.arguments
|
||||||
let
|
|
||||||
Arguments args = context.arguments
|
|
||||||
filterElements = do
|
|
||||||
(key, value) <- HashMap.toList args
|
|
||||||
pure (key, Object $ HashMap.singleton "eq" value)
|
|
||||||
|
|
||||||
-- This query can return at most one row, so we don't worry checking for
|
-- This query can return at most one row, so we don't worry checking for
|
||||||
-- COUNT() and asserting it's within the set limits.
|
-- COUNT() and asserting it's within the set limits.
|
||||||
|
@ -726,7 +746,7 @@ queryType connection accessMode dbId tables = do
|
||||||
connection
|
connection
|
||||||
tableEntry.name
|
tableEntry.name
|
||||||
tableEntry.columns
|
tableEntry.columns
|
||||||
filterElements
|
(getByPKFilterElements args)
|
||||||
[]
|
[]
|
||||||
Nothing
|
Nothing
|
||||||
|
|
||||||
|
@ -736,8 +756,7 @@ queryType connection accessMode dbId tables = do
|
||||||
colErrorsToUserError $
|
colErrorsToUserError $
|
||||||
rowToGraphQL
|
rowToGraphQL
|
||||||
dbId
|
dbId
|
||||||
tableEntry.name
|
tableEntry
|
||||||
tableEntry.columns
|
|
||||||
row
|
row
|
||||||
|
|
||||||
getResolvers :: IO (HashMap.HashMap Text (Resolver IO))
|
getResolvers :: IO (HashMap.HashMap Text (Resolver IO))
|
||||||
|
@ -806,105 +825,102 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
|
||||||
getColValue rowObj columnName =
|
getColValue rowObj columnName =
|
||||||
HashMap.findWithDefault Null (doubleXEncodeGql columnName) rowObj
|
HashMap.findWithDefault Null (doubleXEncodeGql columnName) rowObj
|
||||||
|
|
||||||
executeDbInserts :: Text -> ReaderT Out.Context IO Value
|
mutationResponse :: TableEntry -> Int -> [[SQLData]] -> IO Value
|
||||||
executeDbInserts tableName = do
|
mutationResponse table numChanges rows = do
|
||||||
columnEntries <- liftIO $ getColumns dbId connection tableName
|
returning <-
|
||||||
|
colErrorsToUserError $
|
||||||
|
rowsToGraphQL dbId table rows
|
||||||
|
|
||||||
|
pure $
|
||||||
|
Object $
|
||||||
|
HashMap.fromList
|
||||||
|
[ ("affected_rows", Int $ fromIntegral numChanges)
|
||||||
|
, ("returning", returning)
|
||||||
|
]
|
||||||
|
|
||||||
|
mutationByPKResponse :: TableEntry -> Int -> Maybe [SQLData] -> IO Value
|
||||||
|
mutationByPKResponse table numChanges mbRow = do
|
||||||
|
returning <- case mbRow of
|
||||||
|
Nothing -> pure Null
|
||||||
|
Just row ->
|
||||||
|
colErrorsToUserError $
|
||||||
|
rowToGraphQL dbId table row
|
||||||
|
|
||||||
|
pure $
|
||||||
|
Object $
|
||||||
|
HashMap.fromList
|
||||||
|
[ ("affected_rows", Int $ fromIntegral numChanges)
|
||||||
|
, ("returning", returning)
|
||||||
|
]
|
||||||
|
|
||||||
|
executeDbInserts :: TableEntry -> ReaderT Out.Context IO Value
|
||||||
|
executeDbInserts table = do
|
||||||
context <- ask
|
context <- ask
|
||||||
let
|
let
|
||||||
columnNames :: [Text]
|
|
||||||
columnNames =
|
|
||||||
columnEntries <&> column_name
|
|
||||||
|
|
||||||
columnNamesText :: Text
|
|
||||||
columnNamesText =
|
|
||||||
columnNames
|
|
||||||
<&> quoteKeyword
|
|
||||||
& intercalate ", "
|
|
||||||
|
|
||||||
insertInDb :: Arguments -> ReaderT Out.Context IO (Int, [[SQLData]])
|
insertInDb :: Arguments -> ReaderT Out.Context IO (Int, [[SQLData]])
|
||||||
insertInDb (Arguments argMap) = do
|
insertInDb (Arguments argMap) = do
|
||||||
|
-- Yields for example:
|
||||||
|
-- [ { name: "John", email: "john@example.com" }
|
||||||
|
-- , { name: "Eve", email: "eve@example.com" }
|
||||||
|
-- ]
|
||||||
|
values :: [HashMap Text Value] <- getArg "objects" argMap
|
||||||
let
|
let
|
||||||
-- Yields for example:
|
|
||||||
-- [ { name: "John", email: "john@example.com" }
|
|
||||||
-- , { name: "Eve", email: "eve@example.com" }
|
|
||||||
-- ]
|
|
||||||
entries =
|
|
||||||
HashMap.findWithDefault
|
|
||||||
(List [])
|
|
||||||
"objects"
|
|
||||||
argMap
|
|
||||||
|
|
||||||
-- All colums that are contained in the entries
|
-- All colums that are contained in the entries
|
||||||
containedColumns :: [Text]
|
containedColumns :: [Text]
|
||||||
containedColumns =
|
containedColumns =
|
||||||
case entries of
|
values
|
||||||
List values ->
|
<&> HashMap.keys
|
||||||
( values
|
& P.concat
|
||||||
<&> \case
|
& nub
|
||||||
Object rowObj ->
|
<&> doubleXDecode
|
||||||
HashMap.keys rowObj
|
|
||||||
_ -> []
|
|
||||||
)
|
|
||||||
& P.concat
|
|
||||||
& nub
|
|
||||||
<&> doubleXDecode
|
|
||||||
_ -> []
|
|
||||||
|
|
||||||
boundVariableNames :: [Text]
|
boundVariableNames :: [Text]
|
||||||
boundVariableNames =
|
boundVariableNames =
|
||||||
containedColumns
|
containedColumns
|
||||||
<&> (\name -> ":" <> doubleXEncodeGql name)
|
<&> (\name -> ":" <> doubleXEncodeGql name)
|
||||||
|
|
||||||
onConflictArg =
|
onConflictArg :: [HashMap Text Value] <-
|
||||||
case HashMap.lookup "on_conflict" argMap of
|
getArgWithDefault "on_conflict" argMap []
|
||||||
Just (List values) -> values
|
|
||||||
_ -> []
|
|
||||||
|
|
||||||
onConflictClauses <- P.for onConflictArg $ \case
|
onConflictClauses <- P.for onConflictArg $ \fields -> do
|
||||||
Object fields -> do
|
let
|
||||||
let
|
getColumnList fieldName =
|
||||||
getColumnList fieldName = do
|
getArgWithDefault fieldName fields []
|
||||||
case HashMap.lookup fieldName fields of
|
<&> P.mapMaybe
|
||||||
Just (List elements) -> do
|
( \case
|
||||||
element <- elements
|
Enum columnName -> Just columnName
|
||||||
case element of
|
_ -> Nothing
|
||||||
Enum columnName -> pure columnName
|
)
|
||||||
_ -> []
|
|
||||||
_ -> []
|
|
||||||
|
|
||||||
constraint = getColumnList "constraint"
|
constraint <- getColumnList "constraint"
|
||||||
update = getColumnList "update_columns"
|
update <- getColumnList "update_columns"
|
||||||
|
|
||||||
updateClauses <- P.for update $ \column -> do
|
updateClauses <- P.for update $ \column -> do
|
||||||
when (column `notElem` containedColumns) $ do
|
when (column `notElem` containedColumns) $ do
|
||||||
P.throwIO $
|
P.throwIO $
|
||||||
userError $
|
userError $
|
||||||
"Column "
|
"Column "
|
||||||
<> T.unpack column
|
<> T.unpack column
|
||||||
<> " cannot be set on conflicts without being explicitly provided"
|
<> " cannot be set on conflicts without \
|
||||||
|
\ being explicitly provided"
|
||||||
pure $
|
|
||||||
quoteKeyword column
|
|
||||||
<> " = :"
|
|
||||||
<> doubleXEncodeGql column
|
|
||||||
|
|
||||||
let
|
|
||||||
filterElements = case HashMap.lookup "where" fields of
|
|
||||||
Just (Object filterObj) -> HashMap.toList filterObj
|
|
||||||
_ -> []
|
|
||||||
|
|
||||||
pure $
|
pure $
|
||||||
"ON CONFLICT ("
|
quoteKeyword column
|
||||||
<> ( constraint
|
<> " = :"
|
||||||
<&> quoteKeyword
|
<> doubleXEncodeGql column
|
||||||
& intercalate "<>"
|
|
||||||
)
|
filterElements <- getArgWithDefault "where" fields mempty
|
||||||
<> ")\n DO UPDATE SET \n"
|
|
||||||
<> intercalate ",\n" updateClauses
|
pure $
|
||||||
<> "\n"
|
"ON CONFLICT ("
|
||||||
<> getWhereClause filterElements
|
<> ( constraint
|
||||||
_ -> pure ""
|
<&> quoteKeyword
|
||||||
|
& intercalate ", "
|
||||||
|
)
|
||||||
|
<> ")\n DO UPDATE SET \n"
|
||||||
|
<> intercalate ",\n" updateClauses
|
||||||
|
<> "\n"
|
||||||
|
<> getWhereClause (HashMap.toList filterElements)
|
||||||
|
|
||||||
let
|
let
|
||||||
columnList =
|
columnList =
|
||||||
|
@ -926,28 +942,21 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
|
||||||
<> ")"
|
<> ")"
|
||||||
sqlQuery =
|
sqlQuery =
|
||||||
Query $
|
Query $
|
||||||
"INSERT INTO "
|
P.unlines
|
||||||
<> quoteKeyword tableName
|
[ "INSERT INTO "
|
||||||
<> columnList
|
<> quoteKeyword table.name
|
||||||
<> insertedValues
|
<> columnList
|
||||||
<> "\n"
|
, insertedValues
|
||||||
<> P.unlines onConflictClauses
|
, P.unlines onConflictClauses
|
||||||
<> "RETURNING "
|
, getReturningClause table
|
||||||
<>
|
]
|
||||||
-- TODO: Only return the actually requested values
|
|
||||||
columnNamesText
|
|
||||||
|
|
||||||
sqlDataRows :: [[SQLData]]
|
sqlDataRows :: [[SQLData]]
|
||||||
sqlDataRows =
|
sqlDataRows =
|
||||||
case entries of
|
values <&> \rowObj ->
|
||||||
List values ->
|
containedColumns
|
||||||
values <&> \case
|
<&> getColValue rowObj
|
||||||
Object rowObj ->
|
<&> gqlValueToSQLData
|
||||||
containedColumns
|
|
||||||
<&> getColValue rowObj
|
|
||||||
<&> gqlValueToSQLData
|
|
||||||
_ -> []
|
|
||||||
_ -> []
|
|
||||||
|
|
||||||
returnedRows <-
|
returnedRows <-
|
||||||
liftIO $ P.forM sqlDataRows $ \sqlDataRow -> do
|
liftIO $ P.forM sqlDataRows $ \sqlDataRow -> do
|
||||||
|
@ -956,7 +965,7 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
|
||||||
connection
|
connection
|
||||||
$ Query
|
$ Query
|
||||||
$ "SELECT COUNT() FROM "
|
$ "SELECT COUNT() FROM "
|
||||||
<> quoteKeyword tableName
|
<> quoteKeyword table.name
|
||||||
|
|
||||||
case numRowsRes of
|
case numRowsRes of
|
||||||
[[numRows]] -> do
|
[[numRows]] -> do
|
||||||
|
@ -980,106 +989,82 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
|
||||||
pure (P.length sqlDataRows, returnedRows & P.concat)
|
pure (P.length sqlDataRows, returnedRows & P.concat)
|
||||||
|
|
||||||
(numOfChanges, returnedRows) <- insertInDb context.arguments
|
(numOfChanges, returnedRows) <- insertInDb context.arguments
|
||||||
returning <-
|
liftIO $ mutationResponse table numOfChanges returnedRows
|
||||||
colErrorsToUserError $
|
|
||||||
rowsToGraphQL dbId tableName columnEntries returnedRows
|
|
||||||
|
|
||||||
pure $
|
|
||||||
Object $
|
|
||||||
HashMap.fromList
|
|
||||||
[ ("affected_rows", Int $ fromIntegral numOfChanges)
|
|
||||||
, ("returning", returning)
|
|
||||||
]
|
|
||||||
|
|
||||||
-- Execute SQL query to update selected entries
|
-- Execute SQL query to update selected entries
|
||||||
executeDbUpdates :: Text -> ReaderT Out.Context IO Value
|
executeDbUpdates :: TableEntry -> ReaderT Out.Context IO Value
|
||||||
executeDbUpdates tableName = do
|
executeDbUpdates table = do
|
||||||
columnEntries <- liftIO $ getColumns dbId connection tableName
|
|
||||||
|
|
||||||
context <- ask
|
context <- ask
|
||||||
|
|
||||||
let Arguments args = context.arguments
|
let Arguments args = context.arguments
|
||||||
|
liftIO $ do
|
||||||
(numOfChanges, updatedRows) <- case HashMap.lookup "filter" args of
|
filterObj <- getArg "filter" args
|
||||||
Just (Object filterObj) -> case HashMap.toList filterObj of
|
(numOfChanges, updatedRows) <- case HashMap.toList filterObj of
|
||||||
[] -> P.throwIO $ userError "Error: Filter must not be empty"
|
[] -> P.throwIO $ userError "Error: Filter must not be empty"
|
||||||
filterElements ->
|
filterElements ->
|
||||||
liftIO $
|
executeUpdateMutation
|
||||||
executeSqlMutation
|
connection
|
||||||
connection
|
table
|
||||||
tableName
|
args
|
||||||
args
|
filterElements
|
||||||
columnEntries
|
|
||||||
filterElements
|
|
||||||
_ -> pure (0, [])
|
|
||||||
|
|
||||||
returning <-
|
mutationResponse table numOfChanges updatedRows
|
||||||
colErrorsToUserError $
|
|
||||||
rowsToGraphQL dbId tableName columnEntries updatedRows
|
|
||||||
|
|
||||||
pure $
|
executeDbUpdatesByPK :: TableEntry -> ReaderT Out.Context IO Value
|
||||||
Object $
|
executeDbUpdatesByPK table = do
|
||||||
HashMap.fromList
|
context <- ask
|
||||||
[ ("affected_rows", Int $ fromIntegral (numOfChanges :: Int))
|
let Arguments args = context.arguments
|
||||||
, ("returning", returning)
|
let filterElements =
|
||||||
]
|
args
|
||||||
|
& HashMap.delete "set"
|
||||||
|
& getByPKFilterElements
|
||||||
|
|
||||||
|
liftIO $ do
|
||||||
|
(numOfChanges, updatedRows) <-
|
||||||
|
executeUpdateMutation
|
||||||
|
connection
|
||||||
|
table
|
||||||
|
args
|
||||||
|
filterElements
|
||||||
|
|
||||||
|
mutationByPKResponse table numOfChanges $ P.head updatedRows
|
||||||
|
|
||||||
-- Execute SQL query to delete selected entries
|
-- Execute SQL query to delete selected entries
|
||||||
executeDbDeletions :: Text -> ReaderT Out.Context IO Value
|
executeDbDeletions :: TableEntry -> ReaderT Out.Context IO Value
|
||||||
executeDbDeletions tableName = do
|
executeDbDeletions table = do
|
||||||
columnEntries <- liftIO $ getColumns dbId connection tableName
|
|
||||||
context <- ask
|
context <- ask
|
||||||
|
let Arguments args = context.arguments
|
||||||
|
|
||||||
let
|
liftIO $ do
|
||||||
columnNamesText :: Text
|
filterElements <- getArg "filter" args
|
||||||
columnNamesText =
|
let sqlQuery =
|
||||||
columnEntries
|
Query $
|
||||||
<&> column_name
|
P.unlines
|
||||||
<&> quoteKeyword
|
[ "DELETE FROM " <> quoteKeyword table.name
|
||||||
& intercalate ", "
|
, getWhereClause $ HashMap.toList filterElements
|
||||||
|
, getReturningClause table
|
||||||
|
]
|
||||||
|
|
||||||
deleteEntry columnName value = do
|
deletedRows :: [[SQLData]] <- SS.query_ connection sqlQuery
|
||||||
let sqlQuery =
|
numOfChanges <- SS.changes connection
|
||||||
Query $
|
mutationResponse table numOfChanges deletedRows
|
||||||
"DELETE FROM "
|
|
||||||
<> quoteKeyword tableName
|
|
||||||
<> " \
|
|
||||||
\WHERE "
|
|
||||||
<> quoteKeyword columnName
|
|
||||||
<> " = ?\n"
|
|
||||||
<> "RETURNING "
|
|
||||||
<> columnNamesText
|
|
||||||
deletedRows :: [[SQLData]] <-
|
|
||||||
liftIO $ SS.query connection sqlQuery [value]
|
|
||||||
numChanges <- liftIO $ changes connection
|
|
||||||
|
|
||||||
pure (numChanges, deletedRows)
|
executeDbDeletionsByPK :: TableEntry -> ReaderT Out.Context IO Value
|
||||||
|
executeDbDeletionsByPK table = do
|
||||||
|
context <- ask
|
||||||
|
let Arguments args = context.arguments
|
||||||
|
|
||||||
(numOfChanges, deletedRows) <- case context.arguments of
|
liftIO $ do
|
||||||
Arguments args -> case HashMap.lookup "filter" args of
|
let sqlQuery =
|
||||||
Just colToFilter -> case colToFilter of
|
Query $
|
||||||
Object filterObj -> case HashMap.toList filterObj of
|
P.unlines
|
||||||
[(columnName, Object operatorAndValue)] -> do
|
[ "DELETE FROM " <> quoteKeyword table.name
|
||||||
case HashMap.toList operatorAndValue of
|
, getWhereClause $ getByPKFilterElements args
|
||||||
[("eq", String value)] ->
|
, getReturningClause table
|
||||||
deleteEntry columnName value
|
]
|
||||||
[("eq", Int value)] ->
|
|
||||||
deleteEntry columnName $ show value
|
|
||||||
_ -> pure (0, [])
|
|
||||||
_ -> pure (0, [])
|
|
||||||
_ -> pure (0, [])
|
|
||||||
Nothing -> pure (0, [])
|
|
||||||
|
|
||||||
returning <-
|
deletedRows :: [[SQLData]] <- SS.query_ connection sqlQuery
|
||||||
colErrorsToUserError $
|
numOfChanges <- SS.changes connection
|
||||||
rowsToGraphQL dbId tableName columnEntries deletedRows
|
mutationByPKResponse table numOfChanges $ P.head deletedRows
|
||||||
|
|
||||||
pure $
|
|
||||||
Object $
|
|
||||||
HashMap.fromList
|
|
||||||
[ ("affected_rows", Int $ fromIntegral numOfChanges)
|
|
||||||
, ("returning", returning)
|
|
||||||
]
|
|
||||||
|
|
||||||
getMutationResolvers :: IO (HashMap.HashMap Text (Resolver IO))
|
getMutationResolvers :: IO (HashMap.HashMap Text (Resolver IO))
|
||||||
getMutationResolvers = do
|
getMutationResolvers = do
|
||||||
|
@ -1088,19 +1073,29 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
|
||||||
getInsertTableTuple table =
|
getInsertTableTuple table =
|
||||||
makeResolver
|
makeResolver
|
||||||
(Introspection.tableInsertField accessMode table)
|
(Introspection.tableInsertField accessMode table)
|
||||||
(executeDbInserts table.name)
|
(executeDbInserts table)
|
||||||
|
|
||||||
getUpdateTableTuple :: TableEntry -> IO (Text, Resolver IO)
|
getUpdateTableTuple :: TableEntry -> IO (Text, Resolver IO)
|
||||||
getUpdateTableTuple table =
|
getUpdateTableTuple table =
|
||||||
makeResolver
|
makeResolver
|
||||||
(Introspection.tableUpdateField accessMode table)
|
(Introspection.tableUpdateField accessMode table)
|
||||||
(executeDbUpdates table.name)
|
(executeDbUpdates table)
|
||||||
|
|
||||||
|
getUpdateByPKTableTuple :: TableEntry -> IO (Maybe (Text, Resolver IO))
|
||||||
|
getUpdateByPKTableTuple table =
|
||||||
|
P.for (Introspection.tableUpdateFieldByPk accessMode table) $ \field ->
|
||||||
|
makeResolver field (executeDbUpdatesByPK table)
|
||||||
|
|
||||||
getDeleteTableTuple :: TableEntry -> IO (Text, Resolver IO)
|
getDeleteTableTuple :: TableEntry -> IO (Text, Resolver IO)
|
||||||
getDeleteTableTuple table =
|
getDeleteTableTuple table =
|
||||||
makeResolver
|
makeResolver
|
||||||
(Introspection.tableDeleteField accessMode table)
|
(Introspection.tableDeleteField accessMode table)
|
||||||
(executeDbDeletions table.name)
|
(executeDbDeletions table)
|
||||||
|
|
||||||
|
getDeleteByPKTableTuple :: TableEntry -> IO (Maybe (Text, Resolver IO))
|
||||||
|
getDeleteByPKTableTuple table =
|
||||||
|
P.for (Introspection.tableDeleteFieldByPK accessMode table) $ \field ->
|
||||||
|
makeResolver field (executeDbDeletionsByPK table)
|
||||||
|
|
||||||
getTableTuples :: IO [(Text, Resolver IO)]
|
getTableTuples :: IO [(Text, Resolver IO)]
|
||||||
getTableTuples =
|
getTableTuples =
|
||||||
|
@ -1110,9 +1105,15 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
|
||||||
(\table -> table.object_type == Table)
|
(\table -> table.object_type == Table)
|
||||||
tables
|
tables
|
||||||
in
|
in
|
||||||
P.for tablesWithoutViews getInsertTableTuple
|
P.fold
|
||||||
<> P.for tablesWithoutViews getUpdateTableTuple
|
[ P.for tablesWithoutViews getInsertTableTuple
|
||||||
<> P.for tablesWithoutViews getDeleteTableTuple
|
, P.for tablesWithoutViews getUpdateTableTuple
|
||||||
|
, P.for tablesWithoutViews getDeleteTableTuple
|
||||||
|
, P.for tablesWithoutViews getUpdateByPKTableTuple
|
||||||
|
<&> P.catMaybes
|
||||||
|
, P.for tablesWithoutViews getDeleteByPKTableTuple
|
||||||
|
<&> P.catMaybes
|
||||||
|
]
|
||||||
|
|
||||||
getTableTuples <&> HashMap.fromList
|
getTableTuples <&> HashMap.fromList
|
||||||
|
|
||||||
|
|
|
@ -5,7 +5,9 @@ module AirGQL.Introspection (
|
||||||
tableQueryByPKField,
|
tableQueryByPKField,
|
||||||
tableInsertField,
|
tableInsertField,
|
||||||
tableUpdateField,
|
tableUpdateField,
|
||||||
|
tableUpdateFieldByPk,
|
||||||
tableDeleteField,
|
tableDeleteField,
|
||||||
|
tableDeleteFieldByPK,
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -212,7 +214,7 @@ tableQueryByPKField table = do
|
||||||
mutationResponseType :: AccessMode -> TableEntry -> Type.IntrospectionType
|
mutationResponseType :: AccessMode -> TableEntry -> Type.IntrospectionType
|
||||||
mutationResponseType accessMode table = do
|
mutationResponseType accessMode table = do
|
||||||
let tableName = doubleXEncodeGql table.name
|
let tableName = doubleXEncodeGql table.name
|
||||||
let readFields =
|
let readonlyFields =
|
||||||
if canRead accessMode
|
if canRead accessMode
|
||||||
then
|
then
|
||||||
pure
|
pure
|
||||||
|
@ -228,7 +230,7 @@ mutationResponseType accessMode table = do
|
||||||
(tableName <> "_mutation_response")
|
(tableName <> "_mutation_response")
|
||||||
( [ Type.field "affected_rows" (Type.nonNull Type.typeInt)
|
( [ Type.field "affected_rows" (Type.nonNull Type.typeInt)
|
||||||
]
|
]
|
||||||
<> readFields
|
<> readonlyFields
|
||||||
)
|
)
|
||||||
& Type.withDescription ("Mutation response for " <> table.name)
|
& Type.withDescription ("Mutation response for " <> table.name)
|
||||||
|
|
||||||
|
@ -236,21 +238,19 @@ mutationResponseType accessMode table = do
|
||||||
mutationByPkResponseType :: AccessMode -> TableEntry -> Type.IntrospectionType
|
mutationByPkResponseType :: AccessMode -> TableEntry -> Type.IntrospectionType
|
||||||
mutationByPkResponseType accessMode table = do
|
mutationByPkResponseType accessMode table = do
|
||||||
let tableName = doubleXEncodeGql table.name
|
let tableName = doubleXEncodeGql table.name
|
||||||
let readFields =
|
let readonlyFields =
|
||||||
if canRead accessMode
|
if canRead accessMode
|
||||||
then
|
then
|
||||||
pure
|
pure $
|
||||||
$ Type.field
|
Type.field "returning" $
|
||||||
"returning"
|
tableRowType table
|
||||||
$ Type.nonNull
|
|
||||||
$ tableRowType table
|
|
||||||
else []
|
else []
|
||||||
|
|
||||||
Type.object
|
Type.object
|
||||||
(tableName <> "_mutation_by_pk_response")
|
(tableName <> "_mutation_by_pk_response")
|
||||||
( [ Type.field "affected_rows" (Type.nonNull Type.typeInt)
|
( [ Type.field "affected_rows" (Type.nonNull Type.typeInt)
|
||||||
]
|
]
|
||||||
<> readFields
|
<> readonlyFields
|
||||||
)
|
)
|
||||||
& Type.withDescription ("Mutation response for " <> table.name)
|
& Type.withDescription ("Mutation response for " <> table.name)
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue