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:
parent
43391ede2a
commit
997455c3d8
6 changed files with 125 additions and 69 deletions
source/AirGQL
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue