1
Fork 0
mirror of https://github.com/Airsequel/AirGQL.git synced 2025-07-29 14:23:18 +03:00

Implement insert-only tokens

This commit is contained in:
prescientmoon 2024-12-07 16:30:24 +01:00
commit 997455c3d8
6 changed files with 125 additions and 69 deletions

View file

@ -86,7 +86,7 @@ import AirGQL.Introspection.NamingConflict (encodeOutsidePKNames)
import AirGQL.Introspection.Resolver qualified as Introspection
import AirGQL.Introspection.Types qualified as Introspection
import AirGQL.Lib (
AccessMode,
AccessMode (canInsert),
ColumnEntry (column_name, datatype),
ObjectType (Table),
TableEntry (columns, name, object_type),
@ -597,6 +597,18 @@ makeResolver field resolve = do
)
-- | Maps the inner computation held by a resolver
wrapResolver
:: (Out.Resolve IO -> Out.Resolve IO)
-> Out.Resolver IO
-> Out.Resolver IO
wrapResolver f = \case
ValueResolver field resolve ->
ValueResolver field (f resolve)
EventStreamResolver field resolve subscribe ->
EventStreamResolver field (f resolve) subscribe
queryType
:: Connection
-> AccessMode
@ -782,20 +794,14 @@ queryType connection accessMode dbId tables = do
schemaResolver <- Introspection.getSchemaResolver accessMode tables
let
-- Resolve = ReaderT Context m Value
wrapResolve resolve = do
requireRead :: Out.Resolve IO -> Out.Resolve IO
requireRead resolve = do
when (P.not $ canRead accessMode) $ do
throw $
ResolverException $
userError "Cannot read field using writeonly access code"
userError "Cannot read field using the provided token"
resolve
protectResolver = \case
ValueResolver field resolve ->
ValueResolver field (wrapResolve resolve)
EventStreamResolver field resolve subscribe ->
EventStreamResolver field (wrapResolve resolve) subscribe
pure $
outObjectTypeToObjectType $
OutObjectType
@ -808,7 +814,7 @@ queryType connection accessMode dbId tables = do
, Introspection.typeNameResolver
, resolvers
]
<&> protectResolver
<&> wrapResolver requireRead
}
@ -1099,25 +1105,53 @@ mutationType connection maxRowsPerTable accessMode dbId tables = do
P.for (Introspection.tableDeleteFieldByPK accessMode tables table) $
\field -> makeResolver field (executeDbDeletionsByPK table)
getTableTuples :: IO [(Text, Resolver IO)]
getTableTuples =
let
tablesWithoutViews =
List.filter
(\table -> table.object_type == Table)
tables
in
P.fold
[ P.for tablesWithoutViews getInsertTableTuple
, P.for tablesWithoutViews getUpdateTableTuple
, P.for tablesWithoutViews getDeleteTableTuple
, P.for tablesWithoutViews getUpdateByPKTableTuple
<&> P.catMaybes
, P.for tablesWithoutViews getDeleteByPKTableTuple
<&> P.catMaybes
]
tablesWithoutViews :: [TableEntry]
tablesWithoutViews =
List.filter
(\table -> table.object_type == Table)
tables
getTableTuples <&> HashMap.fromList
insertTuples <-
P.fold
[ P.for tablesWithoutViews getInsertTableTuple
]
writeTuples <-
P.fold
[ P.for tablesWithoutViews getUpdateTableTuple
, P.for tablesWithoutViews getDeleteTableTuple
, P.for tablesWithoutViews getUpdateByPKTableTuple
<&> P.catMaybes
, P.for tablesWithoutViews getDeleteByPKTableTuple
<&> P.catMaybes
]
let
requireWrite :: Out.Resolve IO -> Out.Resolve IO
requireWrite resolve = do
when (P.not $ canWrite accessMode) $ do
throw $
ResolverException $
userError "Cannot write field using the provided token"
resolve
requireInsert :: Out.Resolve IO -> Out.Resolve IO
requireInsert resolve = do
when (P.not $ canInsert accessMode) $ do
throw $
ResolverException $
userError "Cannot insert entries using the provided token"
resolve
insertResolvers =
HashMap.fromList insertTuples
<&> wrapResolver requireInsert
writeResolvers =
HashMap.fromList writeTuples
<&> wrapResolver requireWrite
pure $ insertResolvers <> writeResolvers
if canWrite accessMode
then

View file

@ -46,6 +46,7 @@ import AirGQL.Lib (
GqlTypeName (full, root),
ObjectType (Table),
TableEntry (columns, name, object_type),
canInsert,
canRead,
canWrite,
column_name_gql,
@ -464,33 +465,36 @@ getSchema
-> Type.Schema
getSchema accessMode tables = do
let
queryType =
if canRead accessMode
then
P.fold
[ tables <&> tableQueryField
, tables & P.mapMaybe (tableQueryByPKField tables)
]
else []
queryType = do
P.guard $ canRead accessMode
P.fold
[ tables <&> tableQueryField
, tables & P.mapMaybe (tableQueryByPKField tables)
]
tablesWithoutViews =
List.filter
(\table -> table.object_type == Table)
tables
mutationType =
if canWrite accessMode
then
P.fold
[ tablesWithoutViews <&> tableInsertField accessMode
, tablesWithoutViews <&> tableUpdateField accessMode
, tablesWithoutViews <&> tableDeleteField accessMode
, tablesWithoutViews
& P.mapMaybe (tableUpdateFieldByPk accessMode tables)
, tablesWithoutViews
& P.mapMaybe (tableDeleteFieldByPK accessMode tables)
]
else []
insertMutations = do
P.guard $ canInsert accessMode
P.fold
[ tablesWithoutViews <&> tableInsertField accessMode
]
writeMutations = do
P.guard $ canWrite accessMode
P.fold
[ tablesWithoutViews <&> tableUpdateField accessMode
, tablesWithoutViews <&> tableDeleteField accessMode
, tablesWithoutViews
& P.mapMaybe (tableUpdateFieldByPk accessMode tables)
, tablesWithoutViews
& P.mapMaybe (tableDeleteFieldByPK accessMode tables)
]
mutationType = insertMutations <> writeMutations
Type.collectSchemaTypes $
Type.Schema

View file

@ -6,9 +6,11 @@
{-# HLINT ignore "Use tuple-section" #-}
module AirGQL.Lib (
AccessMode (..),
canRead,
canWrite,
AccessMode (canRead, canWrite, canInsert),
mkAccessMode,
readOnly,
writeOnly,
readAndWrite,
ColumnEntry (..),
GqlTypeName (..),
getEnrichedTable,
@ -117,18 +119,33 @@ import Language.SQL.SimpleSQL.Syntax qualified as SQL
import Servant.Docs (ToSample (toSamples), singleSample)
data AccessMode = ReadOnly | WriteOnly | ReadAndWrite
data AccessMode = AccessMode
{ canRead :: Bool
, canInsert :: Bool
, canWrite :: Bool
}
deriving (Eq, Show)
canRead :: AccessMode -> Bool
canRead WriteOnly = False
canRead _ = True
mkAccessMode :: Bool -> Bool -> Bool -> AccessMode
mkAccessMode read insert write =
AccessMode
{ canRead = read
, canInsert = insert || write
, canWrite = write
}
canWrite :: AccessMode -> Bool
canWrite ReadOnly = False
canWrite _ = True
readOnly :: AccessMode
readOnly = mkAccessMode True False False
writeOnly :: AccessMode
writeOnly = mkAccessMode False True True
readAndWrite :: AccessMode
readAndWrite = mkAccessMode True True True
data ObjectType = Table | Index | View | Trigger

View file

@ -26,10 +26,11 @@ import Servant.Server qualified as Servant
import System.Directory (makeAbsolute)
import AirGQL.Lib (
AccessMode (ReadOnly, WriteOnly),
column_name,
getColumns,
getTableNames,
readOnly,
writeOnly,
)
import AirGQL.ServerUtils (executeQuery)
import AirGQL.Types.SchemaConf (SchemaConf (accessMode), defaultSchemaConf)
@ -98,7 +99,7 @@ readOnlyGqlPostHandler dbIdOrPath gqlPost =
reqDir <- makeAbsolute $ getReadOnlyFilePath dbIdOrPath
executeQuery
defaultSchemaConf{accessMode = ReadOnly}
defaultSchemaConf{accessMode = readOnly}
dbIdOrPath
reqDir
gqlPost.query
@ -112,7 +113,7 @@ writeOnlyGqlPostHandler dbPath gqlPost =
reqDir <- makeAbsolute $ getReadOnlyFilePath dbPath
executeQuery
defaultSchemaConf{accessMode = WriteOnly}
defaultSchemaConf{accessMode = writeOnly}
dbPath
reqDir
gqlPost.query

View file

@ -3,9 +3,9 @@ module AirGQL.Types.SchemaConf (
defaultSchemaConf,
) where
import Protolude (Integer)
import Protolude (Bool (True), Integer)
import AirGQL.Lib (AccessMode (ReadAndWrite))
import AirGQL.Lib (AccessMode, mkAccessMode)
import AirGQL.Types.PragmaConf (PragmaConf, defaultConf)
@ -20,7 +20,7 @@ data SchemaConf = SchemaConf
defaultSchemaConf :: SchemaConf
defaultSchemaConf =
SchemaConf
{ accessMode = ReadAndWrite
{ accessMode = mkAccessMode True True True
, pragmaConf = AirGQL.Types.PragmaConf.defaultConf
, maxRowsPerTable = 100_000
}