From ea29a48da13d6e6b87a3b017bcf92689bc18ca54 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 8 Nov 2023 08:36:04 -0600 Subject: [PATCH] Jsonrpc: support some JSONesque non-JSONRPC protocols, like DAP * lisp/jsonrpc.el (jsonrpc-convert-to-endpoint) (jsonrpc-convert-from-endpoint): New generics. (jsonrpc-connection-send): Call jsonrpc-convert-to-endpoint. Rework logging. (jsonrpc-connection-receive): Call jsonrpc-convert-from-endpoint. Rework logging. jsonrpc--reply with METHOD. (jsonrpc--log-event): Take subtype. (Version): Bump to 1.0.19 * test/lisp/progmodes/eglot-tests.el (eglot--sniffing): Adapt to new protocol of jsonrpc--log-event. * doc/lispref/text.texi (JSONRPC Overview): Rework. --- doc/lispref/text.texi | 105 +++++++++++++++++++---------- lisp/jsonrpc.el | 88 ++++++++++++++++-------- test/lisp/progmodes/eglot-tests.el | 40 ++++++----- 3 files changed, 150 insertions(+), 83 deletions(-) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index b17eb087f42..e35d449ca6d 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5919,74 +5919,109 @@ Nevertheless, we can define two distinct APIs around the @cindex JSONRPC application interfaces @enumerate -@item A user interface for building JSONRPC applications +@item An API for building JSONRPC applications @findex :request-dispatcher @findex :notification-dispatcher @findex jsonrpc-notify @findex jsonrpc-request @findex jsonrpc-async-request -In this scenario, the JSONRPC application selects a concrete subclass -of @code{jsonrpc-connection}, and proceeds to create objects of that -subclass using @code{make-instance}. To initiate a contact to the -remote endpoint, the JSONRPC application passes this object to the -functions @code{jsonrpc-notify}, @code{jsonrpc-request}, and/or -@code{jsonrpc-async-request}. For handling remotely initiated -contacts, which generally come in asynchronously, the instantiation -should include @code{:request-dispatcher} and -@code{:notification-dispatcher} initargs, which are both functions of -3 arguments: the connection object; a symbol naming the JSONRPC method -invoked remotely; and a JSONRPC @code{params} object. +In this scenario, a new aspiring JSONRPC-based application selects a +concrete subclass of @code{jsonrpc-connection} that provides the +transport for the JSONRPC messages to be exchanged between endpoints. + +The application creates objects of that subclass using +@code{make-instance}. To initiate a contact to a remote endpoint, the +application passes this object to the functions such as +@code{jsonrpc-notify}, @code{jsonrpc-request}, or +@code{jsonrpc-async-request}. + +For handling remotely initiated contacts, which generally come in +asynchronously, the @code{make-instance} instantiation should +initialize it the @code{:request-dispatcher} and +@code{:notification-dispatcher} EIEIO keyword arguments. These are +both functions of 3 arguments: the connection object; a symbol naming +the JSONRPC method invoked remotely; and a JSONRPC @code{params} +object. @findex jsonrpc-error The function passed as @code{:request-dispatcher} is responsible for handling the remote endpoint's requests, which expect a reply from the -local endpoint (in this case, the program you're building). Inside -that function, you may either return locally (a normal return) or -non-locally (an error return). A local return value must be a Lisp -object that can be serialized as JSON (@pxref{Parsing JSON}). This -determines a success response, and the object is forwarded to the -server as the JSONRPC @code{result} object. A non-local return, -achieved by calling the function @code{jsonrpc-error}, causes an error -response to be sent to the server. The details of the accompanying -JSONRPC @code{error} are filled out with whatever was passed to +local endpoint (in this case, the application you're building). +Inside that function, you may either return locally (a regular return) +or non-locally (throw an error). Both exits from the request +dispatcher cause a reply to the remote endpoint's request to be sent +through the transport. + +A regular return determines a success response, and the return value +must be a Lisp object that can be serialized as JSON (@pxref{Parsing +JSON}). The result is forwarded to the server as the JSONRPC +@code{result} object. A non-local return, achieved by calling the +function @code{jsonrpc-error}, causes an error response to be sent to +the server. The details of the accompanying JSONRPC @code{error} +object are filled out with whatever was passed to @code{jsonrpc-error}. A non-local return triggered by an unexpected error of any other type also causes an error response to be sent (unless you have set @code{debug-on-error}, in which case this calls the Lisp debugger, @pxref{Error Debugging}). -@item A inheritance interface for building JSONRPC transport implementations - -In this scenario, @code{jsonrpc-connection} is subclassed to implement +@findex jsonrpc-convert-to-endpoint +@findex jsonrpc-convert-from-endpoint +It's possible to use the @code{jsonrpc} library to build applications +based on transport protocols that can be described as +``quasi-JSONRPC''. These are similar, but not quite identical to +JSONRPC, such as the @uref{https://www.jsonrpc.org/, DAP (Debug +Adapter Protocol)}. These protocols also define request, response and +notification messages but the format is not quite the same as JSONRPC. +The generic functions @code{jsonrpc-convert-to-endpoint} and +@code{jsonrpc-convert-from-endpoint} can be customized for converting +between the internal representation of JSONRPC and whatever the +endpoint accepts (@pxref{Generic Functions}). + +@item An API for building JSONRPC transports + +In this scenario, @code{jsonrpc-connection} is sub-classed to implement a different underlying transport strategy (for details on how to subclass, see @ref{Inheritance,Inheritance,,eieio}.). Users of the application-building interface can then instantiate objects of this concrete class (using the @code{make-instance} function) and connect -to JSONRPC endpoints using that strategy. +to JSONRPC endpoints using that strategy. See @ref{Process-based +JSONRPC connections} for a built-in transport implementation. This API has mandatory and optional parts. @findex jsonrpc-connection-send To allow its users to initiate JSONRPC contacts (notifications or -requests) or reply to endpoint requests, the subclass must have an -implementation of the @code{jsonrpc-connection-send} method. +requests) or reply to endpoint requests, the new transport +implementation must equip the @code{jsonrpc-connection-send} generic +function with a specialization for the the new subclass +(@pxref{Generic Functions}). This generic function is called +automatically by primitives such as @code{jsonrpc-request} and +@code{jsonrpc-notify}. The specialization should ensure that the +message described in the argument list is sent through whatever +underlying communication mechanism (a.k.a.@: ``wire'') is used by the +new transport to talk to endpoints. This ``wire'' may be a network +socket, a serial interface, an HTTP connection, etc. @findex jsonrpc-connection-receive Likewise, for handling the three types of remote contacts (requests, notifications, and responses to local requests), the transport implementation must arrange for the function -@code{jsonrpc-connection-receive} to be called after noticing a new -JSONRPC message on the wire (whatever that "wire" may be). +@code{jsonrpc-connection-receive} to be called from Elisp after +noticing some data on the ``wire'' that can be used to craft a JSONRPC +(or quasi-JSONRPC) message. @findex jsonrpc-shutdown @findex jsonrpc-running-p Finally, and optionally, the @code{jsonrpc-connection} subclass should -implement the @code{jsonrpc-shutdown} and @code{jsonrpc-running-p} -methods if these concepts apply to the transport. If they do, then -any system resources (e.g.@: processes, timers, etc.) used to listen for -messages on the wire should be released in @code{jsonrpc-shutdown}, -i.e.@: they should only be needed while @code{jsonrpc-running-p} is -non-@code{nil}. +add specializations to the @code{jsonrpc-shutdown} and +@code{jsonrpc-running-p} generic functions if these concepts apply to +the transport. The specialization of @code{jsonrpc-shutdown} should +ensure the release of any system resources (e.g.@: processes, timers, +etc.) used to listen for messages on the wire. The specialization of +@code{jsonrpc-running-p} should tell if these resources are still +active or have already been released (via @code{jsonrpc-shutdown} or +otherwise). @end enumerate diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 9cb6b90f733..dde1c880912 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -4,7 +4,7 @@ ;; Author: João Távora ;; Keywords: processes, languages, extensions -;; Version: 1.0.18 +;; Version: 1.0.19 ;; Package-Requires: ((emacs "25.2")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -133,6 +133,38 @@ immediately." (:method (_s _what) ;; by default all connections are ready t)) +;;; API optional +(cl-defgeneric jsonrpc-convert-to-endpoint (connection message subtype) + "Convert MESSAGE to JSONRPCesque message accepted by endpoint. +MESSAGE is a plist, jsonrpc.el's internal representation of a +JSONRPC message. SUBTYPE is one of `request', `reply' or +`notification'. + +Return a plist to be serialized to JSON with `json-serialize' and +transmitted to endpoint." + ;; TODO: describe representations and serialization in manual and + ;; link here. + (:method (_s message subtype) + `(:jsonrpc "2.0" + ,@(if (eq subtype 'reply) + ;; true JSONRPC doesn't have `method' + ;; fields in responses. + (cl-loop for (k v) on message by #'cddr + unless (eq k :method) + collect k and collect v) + message)))) + +;;; API optional +(cl-defgeneric jsonrpc-convert-from-endpoint (connection remote-message) + "Convert JSONRPC-esque REMOTE-MESSAGE to a plist. +REMOTE-MESSAGE is a plist read with `json-parse'. + +Return a plist of jsonrpc.el's internal representation of a +JSONRPC message." + ;; TODO: describe representations and serialization in manual and + ;; link here. + (:method (_s remote-message) remote-message)) + ;;; Convenience ;;; @@ -170,9 +202,12 @@ circumvent that.") This function will destructure MESSAGE and call the appropriate dispatcher in CONNECTION." (cl-destructuring-bind (&key method id error params result _jsonrpc) - message + (jsonrpc-convert-from-endpoint connection message) + (jsonrpc--log-event connection message 'server + (cond ((and method id) 'request) + (method 'notification) + (id 'reply))) (let (continuations) - (jsonrpc--log-event connection message 'server) (setf (jsonrpc-last-error connection) error) (cond (;; A remote request @@ -193,7 +228,7 @@ dispatcher in CONNECTION." "Internal error"))))) (error '(:error (:code -32603 :message "Internal error")))))) - (apply #'jsonrpc--reply connection id reply))) + (apply #'jsonrpc--reply connection id method reply))) (;; A remote notification method (funcall (jsonrpc--notification-dispatcher connection) @@ -435,11 +470,11 @@ connection object, called when the process dies.") (cl-defmethod jsonrpc-connection-send ((connection jsonrpc-process-connection) &rest args &key - _id + id method _params - _result - _error + (_result nil result-supplied-p) + error _partial) "Send MESSAGE, a JSON object, to CONNECTION." (when method @@ -448,18 +483,21 @@ connection object, called when the process dies.") ((symbolp method) (symbol-name method)) ((stringp method) method) (t (error "[jsonrpc] invalid method %s" method))))) - (let* ( (message `(:jsonrpc "2.0" ,@args)) - (json (jsonrpc--json-encode message)) - (headers - `(("Content-Length" . ,(format "%d" (string-bytes json))) - ;; ("Content-Type" . "application/vscode-jsonrpc; charset=utf-8") - ))) + (let* ((subtype (cond ((or result-supplied-p error) 'reply) + (id 'request) + (method 'notification))) + (converted (jsonrpc-convert-to-endpoint connection args subtype)) + (json (jsonrpc--json-encode converted)) + (headers + `(("Content-Length" . ,(format "%d" (string-bytes json))) + ;; ("Content-Type" . "application/vscode-jsonrpc; charset=utf-8") + ))) (process-send-string (jsonrpc--process connection) (cl-loop for (header . value) in headers concat (concat header ": " value "\r\n") into header-section finally return (format "%s\r\n%s" header-section json))) - (jsonrpc--log-event connection message 'client))) + (jsonrpc--log-event connection converted 'client subtype))) (defun jsonrpc-process-type (conn) "Return the `process-type' of JSONRPC connection CONN." @@ -526,12 +564,13 @@ With optional CLEANUP, kill any associated buffers." "Encode OBJECT into a JSON string.") (cl-defun jsonrpc--reply - (connection id &key (result nil result-supplied-p) (error nil error-supplied-p)) + (connection id method &key (result nil result-supplied-p) (error nil error-supplied-p)) "Reply to CONNECTION's request ID with RESULT or ERROR." (apply #'jsonrpc-connection-send connection `(:id ,id ,@(and result-supplied-p `(:result ,result)) - ,@(and error-supplied-p `(:error ,error))))) + ,@(and error-supplied-p `(:error ,error)) + :method ,method))) (defun jsonrpc--call-deferred (connection) "Call CONNECTION's deferred actions, who may again defer themselves." @@ -738,24 +777,19 @@ TIMEOUT is nil)." (apply #'format format args) :warning))) -(defun jsonrpc--log-event (connection message &optional type) +(defun jsonrpc--log-event (connection message &optional origin subtype) "Log a JSONRPC-related event. CONNECTION is the current connection. MESSAGE is a JSON-like -plist. TYPE is a symbol saying if this is a client or server -originated." +plist. ORIGIN is a symbol saying where event originated. +SUBTYPE tells more about the event." (let ((max (jsonrpc--events-buffer-scrollback-size connection))) (when (or (null max) (cl-plusp max)) (with-current-buffer (jsonrpc-events-buffer connection) - (cl-destructuring-bind (&key method id error &allow-other-keys) message + (cl-destructuring-bind (&key _method id error &allow-other-keys) message (let* ((inhibit-read-only t) - (subtype (cond ((and method id) 'request) - (method 'notification) - (id 'reply) - (t 'message))) (type - (concat (format "%s" (or type 'internal)) - (if type - (format "-%s" subtype))))) + (concat (format "%s" (or origin 'internal)) + (if origin (format "-%s" (or subtype 'message)))))) (goto-char (point-max)) (prog1 (let ((msg (format "[%s]%s%s %s:\n%s" diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 575a6ac8ef1..996ff276e68 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -209,27 +209,25 @@ directory hierarchy." client-replies)) (advice-add #'jsonrpc--log-event :before - (lambda (_proc message &optional type) - (cl-destructuring-bind (&key method id _error &allow-other-keys) - message - (let ((req-p (and method id)) - (notif-p method) - (reply-p id)) - (cond - ((eq type 'server) - (cond (req-p ,(when server-requests - `(push message ,server-requests))) - (notif-p ,(when server-notifications - `(push message ,server-notifications))) - (reply-p ,(when server-replies - `(push message ,server-replies))))) - ((eq type 'client) - (cond (req-p ,(when client-requests - `(push message ,client-requests))) - (notif-p ,(when client-notifications - `(push message ,client-notifications))) - (reply-p ,(when client-replies - `(push message ,client-replies))))))))) + (lambda (_proc message &optional origin subtype) + (let ((req-p (eq subtype 'request)) + (notif-p (eq subtype 'notification)) + (reply-p (eql subtype 'reply))) + (cond + ((eq origin 'server) + (cond (req-p ,(when server-requests + `(push message ,server-requests))) + (notif-p ,(when server-notifications + `(push message ,server-notifications))) + (reply-p ,(when server-replies + `(push message ,server-replies))))) + ((eq origin 'client) + (cond (req-p ,(when client-requests + `(push message ,client-requests))) + (notif-p ,(when client-notifications + `(push message ,client-notifications))) + (reply-p ,(when client-replies + `(push message ,client-replies)))))))) '((name . ,log-event-ad-sym))) ,@body) (advice-remove #'jsonrpc--log-event ',log-event-ad-sym)))) -- 2.39.2