Add insertonly endpoint to airgql server

I removed the `readonlyGqlPostHandler` thingy from airgql,
as it seemed to be a slightly worse version of the existing more
general gql post handler. The one difference is that it was trying
to use the readonly db directory, although the token already protected
the queries to reading only, so this didn't matter. Moreover, the
writeonly endpoint was also using the readonly directory, which seemed
like a mistake (I removed that handler as well in favour of passing the
`writeonly` access mode to the existing handler).

I also fixed a TODO, making it so the readonly airsequel-cli handler
takes the edition into account.

source/AirGQL/Lib.hs

@@ -10,6 +10,7 @@ module AirGQL.Lib (
   mkAccessMode,
   readOnly,
   writeOnly,
+  insertOnly,
   readAndWrite,
   ColumnEntry (..),
   GqlTypeName (..),
@@ -144,6 +145,10 @@ writeOnly :: AccessMode
 writeOnly = mkAccessMode False True True
 
 
+insertOnly :: AccessMode
+insertOnly = mkAccessMode False True False
+
+
 readAndWrite :: AccessMode
 readAndWrite = mkAccessMode True True True
 

source/AirGQL/Servant/GraphQL.hs

@@ -2,8 +2,6 @@ module AirGQL.Servant.GraphQL (
   gqlQueryGetHandler,
   gqlQueryPostHandler,
   playgroundDefaultQueryHandler,
-  readOnlyGqlPostHandler,
-  writeOnlyGqlPostHandler,
 ) where
 
 import Protolude (
@@ -29,16 +27,13 @@ import AirGQL.Lib (
   column_name,
   getColumns,
   getTableNames,
-  readOnly,
-  writeOnly,
  )
 import AirGQL.ServerUtils (executeQuery)
-import AirGQL.Types.SchemaConf (SchemaConf (accessMode), defaultSchemaConf)
+import AirGQL.Types.SchemaConf (SchemaConf)
 import AirGQL.Types.Types (GQLPost (operationName, query, variables))
 import AirGQL.Utils (
   getDbDir,
   getMainDbPath,
-  getReadOnlyFilePath,
   throwErr400WithMsg,
   throwErr404WithMsg,
   withRetryConn,
@@ -93,34 +88,6 @@ gqlQueryPostHandler schemaConf dbIdOrPath gqlPost = do
     handleNoDbError
 
 
-readOnlyGqlPostHandler :: Text -> GQLPost -> Servant.Handler Object
-readOnlyGqlPostHandler dbIdOrPath gqlPost =
-  liftIO $ do
-    reqDir <- makeAbsolute $ getReadOnlyFilePath dbIdOrPath
-
-    executeQuery
-      defaultSchemaConf{accessMode = readOnly}
-      dbIdOrPath
-      reqDir
-      gqlPost.query
-      (gqlPost.variables & P.fromMaybe mempty)
-      gqlPost.operationName
-
-
-writeOnlyGqlPostHandler :: Text -> GQLPost -> Servant.Handler Object
-writeOnlyGqlPostHandler dbPath gqlPost =
-  liftIO $ do
-    reqDir <- makeAbsolute $ getReadOnlyFilePath dbPath
-
-    executeQuery
-      defaultSchemaConf{accessMode = writeOnly}
-      dbPath
-      reqDir
-      gqlPost.query
-      (gqlPost.variables & P.fromMaybe mempty)
-      gqlPost.operationName
-
-
 playgroundDefaultQueryHandler
   :: Text
   -> Servant.Handler Text

source/Server/Server.hs

@@ -56,7 +56,7 @@ import Text.Blaze.Internal (MarkupM)
 
 import AirGQL.Config (Config (maxDbSize), defaultConfig)
 import AirGQL.ExternalAppContext (ExternalAppContext)
-import AirGQL.Lib (SQLPost)
+import AirGQL.Lib (SQLPost, insertOnly, readOnly, writeOnly)
 import AirGQL.Servant.Database (
   apiDatabaseSchemaGetHandler,
   apiDatabaseVacuumPostHandler,
@@ -65,11 +65,9 @@ import AirGQL.Servant.GraphQL (
   gqlQueryGetHandler,
   gqlQueryPostHandler,
   playgroundDefaultQueryHandler,
-  readOnlyGqlPostHandler,
-  writeOnlyGqlPostHandler,
  )
 import AirGQL.Servant.SqlQuery (sqlQueryPostHandler)
-import AirGQL.Types.SchemaConf (SchemaConf (pragmaConf), defaultSchemaConf)
+import AirGQL.Types.SchemaConf (SchemaConf (accessMode, pragmaConf), defaultSchemaConf)
 import AirGQL.Types.SqlQueryPostResult (SqlQueryPostResult)
 import AirGQL.Types.Types (GQLPost)
 
@@ -86,16 +84,18 @@ type PlatformAPI =
       :> ReqBody '[JSON] GQLPost
       :> Post '[JSON] Object
 
-  -- writeOnlyGqlPostHandler
   :<|> "readonly" :> "graphql"
           :> ReqBody '[JSON] GQLPost
           :> Post '[JSON] Object
 
-  -- writeOnlyGqlPostHandler
   :<|> "writeonly" :> "graphql"
           :> ReqBody '[JSON] GQLPost
           :> Post '[JSON] Object
   
+  :<|> "insertonly" :> "graphql"
+          :> ReqBody '[JSON] GQLPost
+          :> Post '[JSON] Object
+
   -- playgroundDefaultQueryHandler
   :<|> "playground" :> "default-query"
           :> Get '[PlainText] Text
@@ -164,8 +164,9 @@ platformServer ctx filePath = do
   let dbPath = T.pack filePath
   gqlQueryGetHandler dbPath
     :<|> gqlQueryPostHandler defaultSchemaConf dbPath
-    :<|> readOnlyGqlPostHandler dbPath
+    :<|> gqlQueryPostHandler defaultSchemaConf{accessMode = readOnly} dbPath
-    :<|> writeOnlyGqlPostHandler dbPath
+    :<|> gqlQueryPostHandler defaultSchemaConf{accessMode = writeOnly} dbPath
+    :<|> gqlQueryPostHandler defaultSchemaConf{accessMode = insertOnly} dbPath
     :<|> playgroundDefaultQueryHandler dbPath
     :<|> apiDatabaseSchemaGetHandler ctx dbPath
     :<|> apiDatabaseVacuumPostHandler dbPath