experiment with jsonrpc on server

server/index.js

@@ -31,7 +31,6 @@ class ClientConnection {
     constructor(ws){
         console.log("Socket opened.")
         this.ws = ws
-        this.ws.send("ok");
 
         this.ws.on("message", (msg) => {
             this.send(JSON.parse(msg.toString("utf8")));

server/leanserver/GameServer/Communication.lean

@@ -0,0 +1,98 @@
+/- Inspired by `Lean/Data/Lsp/Communication.lean` -/
+import Lean.Data.JsonRpc
+
+/-! Reading/writing Game Server Protocol messages from/to IO handles. -/
+
+namespace IO.FS.Stream
+
+open Lean
+open Lean.JsonRpc
+
+section
+
+def readJsonLine (h : FS.Stream) : IO Json := do
+  let s ← h.getLine
+  ofExcept (Json.parse s)
+
+def readGspMessage (h : FS.Stream) : IO Message := do
+  let j ← h.readJsonLine
+  match fromJson? j with
+  | Except.ok m => pure m
+  | Except.error inner =>
+    throw $
+      userError s!"JSON '{j.compress}' did not have the format of a JSON-RPC message.\n{inner}"
+
+def readGspRequestAs (h : FS.Stream) (expectedMethod : String) (α) [FromJson α]
+    : IO (Request α) := do
+  let m ← h.readGspMessage
+  match m with
+  | Message.request id method params? =>
+    if method = expectedMethod then
+      let j := toJson params?
+      match fromJson? j with
+      | Except.ok v => pure ⟨id, expectedMethod, v⟩
+      | Except.error inner =>
+        throw $
+          userError s!"Unexpected param '{j.compress}' for method '{expectedMethod}'\n{inner}"
+    else
+      throw $ userError s!"Expected method '{expectedMethod}', got method '{method}'"
+  | _ => throw $ userError s!"Expected JSON-RPC request, got: '{(toJson m).compress}'"
+
+def readGspNotificationAs
+    (h : FS.Stream) (nBytes : Nat) (expectedMethod : String) (α) [FromJson α]
+    : IO (Notification α) := do
+  let m ← h.readMessage nBytes
+  match m with
+  | Message.notification method params? =>
+    if method = expectedMethod then
+      let j := toJson params?
+      match fromJson? j with
+      | Except.ok v => pure ⟨expectedMethod, v⟩
+      | Except.error inner =>
+        throw $
+          userError s!"Unexpected param '{j.compress}' for method '{expectedMethod}'\n{inner}"
+    else
+      throw $ userError s!"Expected method '{expectedMethod}', got method '{method}'"
+  | _ => throw $ userError s!"Expected JSON-RPC notification, got: '{(toJson m).compress}'"
+
+def readGspResponseAs
+    (h : FS.Stream) (nBytes : Nat) (expectedID : RequestID) (α) [FromJson α]
+    : IO (Response α) := do
+  let m ← h.readMessage nBytes
+  match m with
+  | Message.response id result =>
+    if id == expectedID then
+      match fromJson? result with
+      | Except.ok v => pure ⟨expectedID, v⟩
+      | Except.error inner => throw $ userError s!"Unexpected result '{result.compress}'\n{inner}"
+    else
+      throw $ userError s!"Expected id {expectedID}, got id {id}"
+  | Message.notification .. => readResponseAs h nBytes expectedID α
+  | _ => throw $ userError s!"Expected JSON-RPC response, got: '{(toJson m).compress}'"
+
+end
+
+section
+  variable [ToJson α]
+
+  def writeGspMessage (h : FS.Stream) (m : Message) : IO Unit := do
+    h.writeMessage m
+    h.putStr "\n"
+
+  def writeGspRequest (h : FS.Stream) (r : Request α) : IO Unit :=
+    h.writeGspMessage r
+
+  def writeGspNotification (h : FS.Stream) (n : Notification α) : IO Unit :=
+    h.writeGspMessage n
+
+  def writeGspResponse (h : FS.Stream) (r : Response α) : IO Unit :=
+    h.writeGspMessage r
+
+  def writeGspResponseError (h : FS.Stream) (e : ResponseError Unit) : IO Unit :=
+    h.writeGspMessage (Message.responseError e.id e.code e.message none)
+
+  def writeGspResponseErrorWithData (h : FS.Stream) (e : ResponseError α) : IO Unit :=
+    h.writeGspMessage e
+end
+
+end IO.FS.Stream

server/leanserver/GameServer/Server.lean

@@ -8,6 +8,7 @@ import Lean.Data.Json.Basic
 
 import GameServer.Utils
 import GameServer.EnvExtensions
+import GameServer.Communication
 
 open Lean Meta Elab Tactic Std
 
@@ -227,25 +228,30 @@ where
     | Action.invalid s => output s!"{← { ← mkResponse with errors := #[s!"Invalid action: {s}"] : Response}.toJson}"
     mainLoop
 
+#check (toJson "").compress
 
 open System Lean Std in
-partial def runGame (GameName : Name) (paths : List FilePath): IO Unit := do
+partial def runGame (GameName : Name) : IO Unit := do
-  searchPathRef.set paths
+  let hIn ← IO.getStdin
-  let env ← importModules [{ module := `Init : Import }, { module := GameName : Import }] {} 0    
+  let hOut ← IO.getStdout
-  let termElabM : TermElabM Unit := do
+  let hLog ← IO.getStderr
-    let levels := levelsExt.getState env
+  hLog.putStr s!"{toJson $ ← hIn.readGspMessage}"
-    let game := {← gameExt.get with nb_levels := levels.size }
+  hOut.writeGspNotification ⟨"Hello!", "s"⟩
-    mainLoop env game levels
+--   let env ← importModules [{ module := `Init : Import }, { module := GameName : Import }] {} 0
-  let metaM : MetaM Unit := termElabM.run' (ctx := {})
+--   let termElabM : TermElabM Unit := do
-  discard <| metaM.run'.toIO coreCtx { env := env }
+--     let levels := levelsExt.getState env
-where
+--     let game := {← gameExt.get with nb_levels := levels.size }
-  mainLoop (env : Environment) (game : Game) (levels : HashMap Nat GameLevel): IO Unit := do
+--     mainLoop env game levels
-    match ← Action.get with
+--   let metaM : MetaM Unit := termElabM.run' (ctx := {})
-    | Action.info => output (toJson game)
+--   discard <| metaM.run'.toIO coreCtx { env := env }
-    | Action.loadLevel n => runLevel env GameName levels n
+-- where
-    | Action.quit => IO.Process.exit 0
+--   mainLoop (env : Environment) (game : Game) (levels : HashMap Nat GameLevel): IO Unit := do
-    | Action.invalid s => output s!"Invalid action: {s}"
+--     match ← Action.get with
-    | _ => output "Invalid action"
+--     | Action.info => output (toJson game)
-    mainLoop env game levels
+--     | Action.loadLevel n => runLevel env GameName levels n
+--     | Action.quit => IO.Process.exit 0
+--     | Action.invalid s => output s!"Invalid action: {s}"
+--     | _ => output "Invalid action"
+--     mainLoop env game levels
 
 end Server

server/leanserver/GameServer/Worker.lean

@@ -0,0 +1,15 @@
+import Lean.Data.JsonRpc
+
+-- The worker implementation roughly follows `Lean/Server/FileWorker.lean`.
+
+
+#check IO.bindTask
+
+#check Task
+#check Task.CancelToken
+
+#check EIO.mapTask
+
+#check maybeTee
+
+#check IO.FS.Stream.writeMessage

server/leanserver/Main.lean

@@ -1,16 +1,30 @@
 import GameServer.Server
 
+-- TODO: Potentially it could be useful to pass in the `gameName` via the websocket connection
+
 unsafe def main (args : List String) : IO Unit := do
 
+  -- Check if required arguments are given by the user
   if args.length != 2 then
-    throw (IO.userError "Expected two arguments: The name of the game module and the path to the game project.")
+    throw (IO.userError $ "Expected two arguments:" ++
-
+      "The name of the game module and the path to the game project.")
-  let out ← IO.Process.output { cwd := args[1]!, cmd := "lake", args := #["env","printenv","LEAN_PATH"] }
+  let gameName := args[0]!
+  let gameDir := args[1]!
 
+  -- Determine search paths of the game project by running `lake env printenv LEAN_PATH`.
+  let out ← IO.Process.output
+    { cwd := gameDir, cmd := "lake", args := #["env","printenv","LEAN_PATH"] }
   if out.exitCode != 0 then
     IO.eprintln out.stderr
-  else
+    return
+
+  -- Make the paths relative to the current directory
   let paths : List System.FilePath := System.SearchPath.parse out.stdout.trim
   let currentDir ← IO.currentDir
-    let paths := paths.map fun p => currentDir / (args[1]! : System.FilePath) / p
+  let paths := paths.map fun p => currentDir / (gameDir : System.FilePath) / p
-    Server.runGame (Lean.Name.mkSimple args[0]!) paths
+
+  -- Set the search path
+  Lean.searchPathRef.set paths
+
+  -- Run the game
+  Server.runGame gameName