mirror of https://codeberg.org/cage/tinmop/
- added a json-rpc2 implementation.
This commit is contained in:
cage
parent
5d3f6b69fe
commit
53379fdd37
|
|
@ -0,0 +1,441 @@
|
|||
;; fulci: a program to organize your movies collection
|
||||
;; Copyright (C) 2019 cage
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(in-package :json-rpc2)
|
||||
|
||||
(define-constant +protocol-version+ "2.0" :test #'string=)
|
||||
|
||||
(define-constant +key-name+ "jsonrpc" :test #'string=)
|
||||
|
||||
(define-constant +key-method+ "method" :test #'string=)
|
||||
|
||||
(define-constant +key-params+ "params" :test #'string=)
|
||||
|
||||
(define-constant +key-id+ "id" :test #'string=)
|
||||
|
||||
(define-constant +key-error+ "error" :test #'string=)
|
||||
|
||||
(define-constant +key-error-code+ "code" :test #'string=)
|
||||
|
||||
(define-constant +key-error-message+ "message" :test #'string=)
|
||||
|
||||
(define-constant +key-result+ "result" :test #'string=)
|
||||
|
||||
(define-constant +error-reserved-min+ -32099 :test #'=)
|
||||
|
||||
(define-constant +error-reserved-max+ -32000 :test #'=)
|
||||
|
||||
(define-constant +error-reserved-method-name+ "^rpc\\." :test #'string=)
|
||||
|
||||
(defun invalid-method-name-p (n)
|
||||
(cl-ppcre:scan +error-reserved-method-name+ n))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(defun make-response-error (code message)
|
||||
(list (cons +key-error-code+ code)
|
||||
(cons +key-error-message+ message)))
|
||||
|
||||
(defun response-error-code (err)
|
||||
(cdar err))
|
||||
|
||||
(defun response-error-message (err)
|
||||
(cdadr err)))
|
||||
|
||||
(defmacro define-error-code (name number message &key (customp nil))
|
||||
(if (and customp
|
||||
(not (<= +error-reserved-min+ number +error-reserved-max+)))
|
||||
(error (format nil "implementation defined error bust be between ~a and ~a"
|
||||
+error-reserved-min+ +error-reserved-max+))
|
||||
`(define-constant ,(misc:format-fn-symbol t "+error-~a+" name)
|
||||
(make-response-error ,number ,message)
|
||||
:test #'equalp)))
|
||||
|
||||
(define-error-code parse -32700 "Parse error")
|
||||
|
||||
(define-error-code invalid-request -32600 "Invalid Request")
|
||||
|
||||
(define-error-code method-not-found -32601 "Method not found")
|
||||
|
||||
(define-error-code invalid-params -32602 "Invalid params")
|
||||
|
||||
(define-error-code internal-error -32603 "Internal error")
|
||||
|
||||
(define-error-code unsupported-protocol -32098 "Only protocol version 2.0 is supported"
|
||||
:customp t)
|
||||
|
||||
(defclass function-param ()
|
||||
((name
|
||||
:initarg :name
|
||||
:initform ""
|
||||
:accessor name
|
||||
:type string)
|
||||
(pos
|
||||
:initarg :pos
|
||||
:initform -1
|
||||
:accessor pos
|
||||
:type integer)))
|
||||
|
||||
(defmethod print-object ((object function-param) stream)
|
||||
(format stream "[~s @ ~a]" (name object) (pos object)))
|
||||
|
||||
(defparameter *request-id* 1)
|
||||
|
||||
(defun generate-request-id ()
|
||||
(incf *request-id*)
|
||||
*request-id*)
|
||||
|
||||
(define-condition json-rpc-error (error)
|
||||
((transaction-id
|
||||
:initform nil
|
||||
:initarg :transaction-id
|
||||
:reader transaction-id)
|
||||
(code
|
||||
:initarg :code
|
||||
:reader code)
|
||||
(text
|
||||
:initarg :text
|
||||
:reader text))
|
||||
(:report (lambda (condition stream)
|
||||
(format stream "~a" (text condition))))
|
||||
(:documentation "Error for all jsonrpc related problems"))
|
||||
|
||||
(defparameter *function-db* '())
|
||||
|
||||
(defun make-fun-params (name position)
|
||||
(cond
|
||||
((not (stringp name))
|
||||
(error 'json-rpc-error
|
||||
:text (format nil "Name of a function parameter must be a string not ~a" name)))
|
||||
((or (not (integerp position))
|
||||
(< position 0))
|
||||
(error 'json-rpc-error
|
||||
:text (format nil
|
||||
"The position of a function parameter must be positive integer not ~a"
|
||||
position)))
|
||||
(t
|
||||
(make-instance 'function-param :name name :pos position))))
|
||||
|
||||
(defun find-function (sym)
|
||||
(conditions:with-default-on-error (nil)
|
||||
(symbol-function sym)))
|
||||
|
||||
(defun register-function (function-id fun &optional params)
|
||||
(let* ((actual-params (loop for param in params collect
|
||||
(make-fun-params (car param)
|
||||
(cdr param))))
|
||||
(fun (make-instance 'rpc-function
|
||||
:function-id function-id
|
||||
:fun-symbol fun
|
||||
:params actual-params)))
|
||||
(push fun *function-db*)))
|
||||
|
||||
(defun compare-functions-fn (function-id)
|
||||
(lambda (a)
|
||||
(string= function-id (function-id a))))
|
||||
|
||||
(defun unregister-function (function-id)
|
||||
(setf *function-db* (remove-if (compare-functions-fn function-id) *function-db*)))
|
||||
|
||||
(defun lookup-function (function-id)
|
||||
(find-if (compare-functions-fn function-id) *function-db*))
|
||||
|
||||
(defclass identificable ()
|
||||
((id
|
||||
:initarg :id
|
||||
:initform -1
|
||||
:accessor id
|
||||
:type integer)))
|
||||
|
||||
(defclass fun-symbol-box ()
|
||||
((fun-symbol
|
||||
:initarg :fun-symbol
|
||||
:initform nil
|
||||
:accessor fun-symbol
|
||||
:type symbol)))
|
||||
|
||||
(defmethod initialize-instance :after ((object fun-symbol-box) &key &allow-other-keys)
|
||||
(with-accessors ((fun-symbol fun-symbol)) object
|
||||
(cond
|
||||
((not (symbolp fun-symbol))
|
||||
(error 'json-rpc-error
|
||||
:text (format nil "function symbol of a function be a symbol not ~a"
|
||||
fun-symbol)))
|
||||
((not (find-function fun-symbol))
|
||||
(error 'json-rpc-error
|
||||
:text (format nil "~a is not a function" fun-symbol))))))
|
||||
|
||||
(defclass fun-box ()
|
||||
((function-id
|
||||
:initarg :function-id
|
||||
:initform ""
|
||||
:accessor function-id
|
||||
:type string)
|
||||
(params
|
||||
:initarg :params
|
||||
:initform '()
|
||||
:accessor params
|
||||
:type list)))
|
||||
|
||||
(defmethod initialize-instance :after ((object fun-box) &key &allow-other-keys)
|
||||
(with-accessors ((function-id function-id)) object
|
||||
(cond
|
||||
((not (stringp function-id))
|
||||
(error 'json-rpc-error
|
||||
:text (format nil "ID of a function must be a string not ~a" function-id)))
|
||||
((invalid-method-name-p function-id)
|
||||
(error 'json-rpc-error
|
||||
:text (format nil
|
||||
"function ID invalid, starts with a reserved prefix ~s"
|
||||
+error-reserved-method-name+))))))
|
||||
|
||||
(defmethod print-object ((object fun-box) stream)
|
||||
(format stream "function-id: ~s params ~s" (function-id object) (params object)))
|
||||
|
||||
(defclass rpc-function (fun-symbol-box fun-box) ())
|
||||
|
||||
(defmethod print-object ((object rpc-function) stream)
|
||||
(print-unreadable-object (object stream :type t)
|
||||
(format stream "symbol ~s " (fun-symbol object))
|
||||
(call-next-method)))
|
||||
|
||||
(defclass rpc-request (fun-box identificable) ())
|
||||
|
||||
(defclass rpc-request-batch ()
|
||||
((requests
|
||||
:initform '()
|
||||
:initarg :requests
|
||||
:accessor requests)))
|
||||
|
||||
(defun make-batch (&rest requests)
|
||||
(make-instance 'rpc-request-batch :requests requests))
|
||||
|
||||
(defun %make-request (method id &rest params)
|
||||
(let ((req (make-instance 'rpc-request
|
||||
:function-id method
|
||||
:id id
|
||||
:params params)))
|
||||
req))
|
||||
|
||||
(defun make-request (method id &rest params)
|
||||
(apply #'%make-request method id params))
|
||||
|
||||
(defun make-request* (method id param)
|
||||
(if (typep param 'proper-list)
|
||||
(apply #'%make-request method id param)
|
||||
(apply #'%make-request method id (list param))))
|
||||
|
||||
(defun make-notification (method &rest params)
|
||||
(apply #'%make-request method nil params))
|
||||
|
||||
(defun make-notification* (method params)
|
||||
(apply #'%make-request method nil params))
|
||||
|
||||
(defgeneric jsonify (object))
|
||||
|
||||
(defclass rpc-response ()
|
||||
((payload
|
||||
:initform nil
|
||||
:initarg :payload
|
||||
:accessor payload)))
|
||||
|
||||
(defmethod jsonify ((object rpc-response))
|
||||
(with-accessors ((payload payload)) object
|
||||
(with-output-to-string (stream)
|
||||
(yason:with-output (stream)
|
||||
(let ((yason:*list-encoder* #'yason:encode-alist))
|
||||
(yason:encode-alist (render-flat payload)))))))
|
||||
|
||||
(defmethod jsonify ((object rpc-request))
|
||||
(with-output-to-string (stream)
|
||||
(let ((yason:*list-encoder* #'yason:encode-alist))
|
||||
(yason:encode (render-flat object) stream))))
|
||||
|
||||
(defmethod jsonify ((object rpc-request-batch))
|
||||
(with-output-to-string (stream)
|
||||
(yason:with-output (stream)
|
||||
(yason:with-array ()
|
||||
(loop for request in (requests object) do
|
||||
(let ((yason:*list-encoder* #'yason:encode-alist))
|
||||
(yason:encode-array-element (render-flat request))))))))
|
||||
|
||||
(defmethod jsonify ((object (eql nil)))
|
||||
nil)
|
||||
|
||||
(defmethod jsonify ((object list))
|
||||
(with-output-to-string (stream)
|
||||
(let ((yason:*list-encoder* #'yason:encode-alist))
|
||||
(yason:with-output (stream)
|
||||
(yason:with-array ()
|
||||
(loop for element in object do
|
||||
(yason:encode-array-element (render-flat element))))))))
|
||||
|
||||
(defgeneric render-flat (object))
|
||||
|
||||
(defmethod render-flat (object)
|
||||
object)
|
||||
|
||||
(defmethod render-flat ((object rpc-request-batch))
|
||||
(loop for i in (requests object) collect (render-flat i)))
|
||||
|
||||
(defmethod render-flat ((object rpc-response))
|
||||
(payload object))
|
||||
|
||||
(defmethod render-flat ((object rpc-request))
|
||||
(with-accessors ((id id)
|
||||
(function-id function-id)
|
||||
(params params)) object
|
||||
(let ((default (list (cons +key-name+ +protocol-version+)
|
||||
(cons +key-method+ function-id))))
|
||||
(when (not (null (first params)))
|
||||
(setf default (append default (list (cons +key-params+ params)))))
|
||||
(if id
|
||||
(append default
|
||||
(list (cons +key-id+ id)))
|
||||
default))))
|
||||
|
||||
(defun make-response (results request-id &key (error-object nil))
|
||||
(make-instance 'rpc-response :payload
|
||||
(if error-object
|
||||
(list (cons +key-name+ +protocol-version+)
|
||||
(cons +key-error+ error-object)
|
||||
(cons +key-id+ request-id))
|
||||
(list (cons +key-name+ +protocol-version+)
|
||||
(cons +key-result+ results)
|
||||
(cons +key-id+ request-id)))))
|
||||
|
||||
(defun supported-version-p (v)
|
||||
(and v
|
||||
(stringp v)
|
||||
(string= v +protocol-version+)))
|
||||
|
||||
(defun called-by-name-p (fun params)
|
||||
(let ((names (loop for i in params when (consp i) collect (car i)))
|
||||
(template-names (loop for i in (params fun) collect (name i))))
|
||||
(and names
|
||||
(every (lambda (a) (or (symbolp a) (stringp a))) names)
|
||||
(null (set-difference names template-names :test #'string-equal)))))
|
||||
|
||||
(defun call-function (request)
|
||||
(flet ((call-fun (fn params)
|
||||
(apply (symbol-function (fun-symbol fn)) params)))
|
||||
(let ((fun (lookup-function (function-id request))))
|
||||
(cond
|
||||
((not fun)
|
||||
(error 'json-rpc-error
|
||||
:code (response-error-code +error-method-not-found+)
|
||||
:transaction-id (id request)
|
||||
:text (format nil
|
||||
"~a: ~s"
|
||||
(response-error-message +error-method-not-found+)
|
||||
(function-id request))))
|
||||
((/= (length (params request))
|
||||
(length (params fun)))
|
||||
(error 'json-rpc-error
|
||||
:code (response-error-code +error-invalid-params+)
|
||||
:transaction-id (id request)
|
||||
:text (format nil
|
||||
"Number of parameters (arity) not compatible with function")))
|
||||
(t
|
||||
(let* ((params (params request))
|
||||
(called-by-name-p (called-by-name-p fun params)))
|
||||
(if called-by-name-p
|
||||
(let ((params-list (make-list (length (params fun)))))
|
||||
(loop for p in (params fun) do
|
||||
(let* ((param-name (name p))
|
||||
(param-pos (pos p))
|
||||
(param-value (cdr (assoc param-name params
|
||||
:test #'string-equal))))
|
||||
(setf (elt params-list param-pos) param-value)))
|
||||
(call-fun fun params-list))
|
||||
(call-fun fun params))))))))
|
||||
|
||||
(defun displace-single-request (request)
|
||||
(flet ((lookup (k)
|
||||
(and (consp request)
|
||||
(every #'consp request)
|
||||
(cdr (assoc k request :test #'string-equal)))))
|
||||
(let ((protocol-version (lookup +key-name+))
|
||||
(method (lookup +key-method+))
|
||||
(params (lookup +key-params+))
|
||||
(id (lookup +key-id+)))
|
||||
(cond
|
||||
((null protocol-version)
|
||||
(error 'json-rpc-error
|
||||
:code (response-error-code +error-invalid-request+)
|
||||
:text (response-error-message +error-invalid-request+)))
|
||||
((not (supported-version-p protocol-version))
|
||||
(error 'json-rpc-error
|
||||
:code (response-error-code +error-unsupported-protocol+)
|
||||
:text (response-error-message +error-unsupported-protocol+)))
|
||||
((not (listp params))
|
||||
(error 'json-rpc-error
|
||||
:code (response-error-code +error-invalid-request+)
|
||||
:text (response-error-message +error-invalid-request+)))
|
||||
(t
|
||||
(values method id params))))))
|
||||
|
||||
(defun elaborate-single-request (request)
|
||||
(handler-case
|
||||
(multiple-value-bind (method id params)
|
||||
(displace-single-request request)
|
||||
(let* ((request (apply #'make-request method id params))
|
||||
(elaborated (call-function request)))
|
||||
(when id
|
||||
;; if id is null is a notification (i.e. the client
|
||||
;; does not care about an answer)
|
||||
(make-response elaborated id :error-object nil))))
|
||||
(json-rpc-error (e)
|
||||
(make-response nil
|
||||
(transaction-id e)
|
||||
:error-object
|
||||
(make-response-error (or (code e)
|
||||
(response-error-code +error-invalid-request+))
|
||||
(text e))))
|
||||
(error ()
|
||||
(make-response nil nil :error-object +error-internal-error+))))
|
||||
|
||||
(defun likely-not-batch-p (request)
|
||||
(and (every (lambda (a) (and (consp a)
|
||||
(car a)
|
||||
(cdr a)))
|
||||
request)
|
||||
(assoc +key-name+ request :test #'string-equal)
|
||||
(assoc +key-method+ request :test #'string-equal)
|
||||
(assoc +key-params+ request :test #'string-equal)))
|
||||
|
||||
(defun request-batch-p (request)
|
||||
(handler-case
|
||||
(progn
|
||||
(displace-single-request request)
|
||||
nil)
|
||||
(json-rpc-error ()
|
||||
(if (likely-not-batch-p request)
|
||||
nil
|
||||
t))
|
||||
(error () t)))
|
||||
|
||||
(defun elaborate-request (raw-request)
|
||||
(handler-case
|
||||
(with-input-from-string (stream raw-request)
|
||||
(let ((decoded (yason:parse stream :object-as :alist)))
|
||||
(if (request-batch-p decoded)
|
||||
(if (null decoded)
|
||||
(elaborate-single-request decoded) ;; will build an error response
|
||||
(remove-if #'null
|
||||
(mapcar #'elaborate-single-request decoded)))
|
||||
(elaborate-single-request decoded))))
|
||||
(error ()
|
||||
(make-response nil nil :error-object +error-parse+))))
|
||||
|
|
@ -3005,6 +3005,27 @@
|
|||
:load-sys-module
|
||||
:load-module))
|
||||
|
||||
(defpackage :json-rpc2
|
||||
(:use :cl
|
||||
:alexandria
|
||||
:yason)
|
||||
(:export
|
||||
:generate-request-id
|
||||
:*function-db*
|
||||
:register-function
|
||||
:unregister-function
|
||||
:make-request
|
||||
:make-request*
|
||||
:make-notification
|
||||
:make-notification*
|
||||
:make-batch
|
||||
:jsonify
|
||||
:json-rpc-error
|
||||
:elaborate-request
|
||||
:transaction-id
|
||||
:code
|
||||
:text))
|
||||
|
||||
(defpackage :scripts
|
||||
(:use
|
||||
:cl
|
||||
|
|
|
|||
|
|
@ -0,0 +1,180 @@
|
|||
;; fulci: a program to organize your movies collection
|
||||
;; Copyright (C) 2019 cage
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(in-package :jsonrpc2-tests)
|
||||
|
||||
(defsuite jsonrpc-suite (all-suite))
|
||||
|
||||
(defun dummy-update (&rest params)
|
||||
(mapcar #'1+ params))
|
||||
|
||||
(defmacro prepare-rpc (&body body)
|
||||
`(let ((*function-db* '()))
|
||||
(register-function "add" '+ (list (cons "a" 0) (cons "b" 1)))
|
||||
(register-function "subtract" '- (list (cons "subtrahend" 1)
|
||||
(cons "minuend" 0)))
|
||||
(register-function "update" 'dummy-update (list (cons "values0" 0)
|
||||
(cons "values1" 1)
|
||||
(cons "values2" 2)
|
||||
(cons "values3" 3)
|
||||
(cons "values4" 4)))
|
||||
(register-function "notify_sum" '+ (list (cons "values0" 0)
|
||||
(cons "values1" 1)
|
||||
(cons "values2" 2)))
|
||||
(register-function "notify_hello" '+ (list (cons "values0" 0)))
|
||||
,@body))
|
||||
|
||||
(deftest test-simple (jsonrpc-suite)
|
||||
(prepare-rpc
|
||||
(assert-equality #'string=
|
||||
"{\"jsonrpc\":\"2.0\",\"result\":30,\"id\":1}"
|
||||
(jsonify (elaborate-request (jsonify (make-request "add"
|
||||
1
|
||||
'("b" . 10)
|
||||
'("a" . 20))))))))
|
||||
|
||||
(defun transaction-test (req expected-req expected-response &optional (show-json-p nil))
|
||||
(prepare-rpc
|
||||
(let* ((json-req (jsonify req))
|
||||
(json-resp (jsonify (elaborate-request json-req))))
|
||||
(when show-json-p
|
||||
(format t "~%~a~%~a~%" json-req json-resp))
|
||||
(assert-equality #'string= expected-req json-req)
|
||||
(assert-equality #'string= expected-response json-resp))))
|
||||
|
||||
(deftest test-sub-positional (jsonrpc-suite)
|
||||
(transaction-test (make-request "subtract" 1 42 23)
|
||||
"{\"jsonrpc\":\"2.0\",\"method\":\"subtract\",\"params\":[42,23],\"id\":1}"
|
||||
"{\"jsonrpc\":\"2.0\",\"result\":19,\"id\":1}"))
|
||||
|
||||
(deftest test-sub-positional-2 (jsonrpc-suite)
|
||||
(transaction-test (make-request "subtract" 2 23 42)
|
||||
"{\"jsonrpc\":\"2.0\",\"method\":\"subtract\",\"params\":[23,42],\"id\":2}"
|
||||
"{\"jsonrpc\":\"2.0\",\"result\":-19,\"id\":2}"))
|
||||
|
||||
(deftest test-sub-named (jsonrpc-suite)
|
||||
(transaction-test (make-request "subtract" 3 (cons "subtrahend" 23)
|
||||
(cons "minuend" 42))
|
||||
(strcat "{\"jsonrpc\":\"2.0\",\"method\":\"subtract\","
|
||||
"\"params\":{\"subtrahend\":23,\"minuend\":42},\"id\":3}")
|
||||
"{\"jsonrpc\":\"2.0\",\"result\":19,\"id\":3}"))
|
||||
|
||||
(deftest test-sub-named-2 (jsonrpc-suite)
|
||||
(transaction-test (make-request "subtract" 4
|
||||
(cons "minuend" 42)
|
||||
(cons "subtrahend" 23))
|
||||
(strcat "{\"jsonrpc\":\"2.0\",\"method\":\"subtract\","
|
||||
"\"params\":{\"minuend\":42,\"subtrahend\":23},\"id\":4}")
|
||||
"{\"jsonrpc\":\"2.0\",\"result\":19,\"id\":4}"))
|
||||
|
||||
(deftest test-notifications (jsonrpc-suite)
|
||||
(transaction-test (make-notification* "update" '(1 2 3 4 5))
|
||||
"{\"jsonrpc\":\"2.0\",\"method\":\"update\",\"params\":[1,2,3,4,5]}"
|
||||
nil))
|
||||
|
||||
(deftest test-non-existent-method (jsonrpc-suite)
|
||||
(transaction-test (make-request "foobar" 1)
|
||||
"{\"jsonrpc\":\"2.0\",\"method\":\"foobar\",\"id\":1}"
|
||||
(strcat "{\"jsonrpc\":\"2.0\","
|
||||
"\"error\":{\"code\":-32601,"
|
||||
"\"message\":\"Method not found: \\\"foobar\\\"\"},\"id\":1}")))
|
||||
|
||||
(deftest test-invalid-json (jsonrpc-suite)
|
||||
(let* ((json-req "{\"jsonrpc\": \"2.0\", \"method\": \"foobar, \"params\": \"bar\", \"baz]")
|
||||
(json-resp (jsonify (elaborate-request json-req))))
|
||||
(assert-true
|
||||
(string= json-resp
|
||||
(strcat "{\"jsonrpc\":\"2.0\",\"error\":{\"code\":-32700,"
|
||||
"\"message\":\"Parse error\"},\"id\":null}")))))
|
||||
|
||||
(deftest test-invalid-request (jsonrpc-suite)
|
||||
(let* ((json-req "{\"jsonrpc\": \"2.0\", \"method\": 1, \"params\": \"bar\"}")
|
||||
(json-resp (jsonify (elaborate-request json-req))))
|
||||
(assert-true
|
||||
(string= json-resp
|
||||
(strcat "{\"jsonrpc\":\"2.0\",\"error\":"
|
||||
"{\"code\":-32600,\"message\":\"Invalid Request\"},\"id\":null}")))))
|
||||
|
||||
(deftest test-batch (jsonrpc-suite)
|
||||
(prepare-rpc
|
||||
(let ((req (make-batch (make-request "add"
|
||||
2
|
||||
'("b" . 10)
|
||||
'("a" . 20))
|
||||
(make-request "foo" 1 1 2)
|
||||
(make-request "add" 1 1 2)))
|
||||
(expected (strcat "["
|
||||
"{\"jsonrpc\":\"2.0\",\"result\":30,\"id\":2},"
|
||||
"{\"jsonrpc\":\"2.0\",\"error\":{\"code\":-32601,"
|
||||
"\"message\":\"Method not found: \\\"foo\\\"\"},\"id\":1},"
|
||||
"{\"jsonrpc\":\"2.0\",\"result\":3,\"id\":1}"
|
||||
"]")))
|
||||
(assert-equality #'string=
|
||||
expected
|
||||
(jsonify (elaborate-request (jsonify req)))))))
|
||||
|
||||
(deftest test-batch-json-invalid (jsonrpc-suite)
|
||||
(let* ((json-req (strcat "["
|
||||
"{\"jsonrpc\": \"2.0\", \"method\": \"sum\", \"params\":"
|
||||
"[1,2,4], \"id\": \"1\"},"
|
||||
"{\"jsonrpc\": \"2.0\", \"method\""
|
||||
"]"))
|
||||
(json-resp (jsonify (elaborate-request json-req))))
|
||||
(assert-true
|
||||
(string= json-resp
|
||||
(strcat "{\"jsonrpc\":\"2.0\",\"error\":"
|
||||
"{\"code\":-32700,\"message\":\"Parse error\"},\"id\":null}")))))
|
||||
|
||||
(deftest test-batch-empty-array (jsonrpc-suite)
|
||||
(let* ((json-req "[]")
|
||||
(json-resp (jsonify (elaborate-request json-req))))
|
||||
(assert-true
|
||||
(string= json-resp
|
||||
(strcat "{\"jsonrpc\":\"2.0\",\"error\":"
|
||||
"{\"code\":-32600,\"message\":\"Invalid Request\"},\"id\":null}")))))
|
||||
|
||||
(deftest test-batch-invalid (jsonrpc-suite)
|
||||
(let* ((json-req "[1]")
|
||||
(json-resp (jsonify (elaborate-request json-req))))
|
||||
(assert-true
|
||||
(string= json-resp
|
||||
(strcat "["
|
||||
"{\"jsonrpc\":\"2.0\",\"error\":"
|
||||
"{\"code\":-32600,\"message\":\"Invalid Request\"},\"id\":null}"
|
||||
"]")))))
|
||||
|
||||
(deftest test-batch-invalid-2 (jsonrpc-suite)
|
||||
(let* ((json-req "[1, 2, 3]")
|
||||
(json-resp (jsonify (elaborate-request json-req))))
|
||||
(assert-true
|
||||
(string= json-resp
|
||||
(strcat "["
|
||||
"{\"jsonrpc\":\"2.0\",\"error\":"
|
||||
"{\"code\":-32600,\"message\":\"Invalid Request\"},\"id\":null},"
|
||||
"{\"jsonrpc\":\"2.0\",\"error\":"
|
||||
"{\"code\":-32600,\"message\":\"Invalid Request\"},\"id\":null},"
|
||||
"{\"jsonrpc\":\"2.0\",\"error\":{\"code\":"
|
||||
"-32600,\"message\":\"Invalid Request\"},\"id\":null}"
|
||||
"]")))))
|
||||
|
||||
(deftest test-batch-notification (jsonrpc-suite)
|
||||
(transaction-test (make-batch (make-notification "notify_sum" 1 2 4)
|
||||
(make-notification "notify_hello" 7))
|
||||
(strcat "["
|
||||
"{\"jsonrpc\":\"2.0\",\"method\":\"notify_sum\",\"params\":[1,2,4]},"
|
||||
"{\"jsonrpc\":\"2.0\",\"method\":\"notify_hello\",\"params\":[7]}"
|
||||
"]")
|
||||
nil))
|
||||
|
|
@ -126,3 +126,12 @@
|
|||
:kami
|
||||
:all-tests)
|
||||
(:export))
|
||||
|
||||
(defpackage :jsonrpc2-tests
|
||||
(:use :cl
|
||||
:clunit
|
||||
:misc
|
||||
:text-utils
|
||||
:json-rpc2
|
||||
:all-tests)
|
||||
(:export))
|
||||
|
|
|
|||
|
|
@ -144,6 +144,7 @@
|
|||
(:file "ui-goodies")
|
||||
(:file "scheduled-events")
|
||||
(:file "modules")
|
||||
(:file "json-rpc2")
|
||||
(:file "main")
|
||||
(:module tests
|
||||
:components ((:file "package")
|
||||
|
|
@ -159,7 +160,8 @@
|
|||
(:file "gemini-parser-tests")
|
||||
(:file "program-events-tests")
|
||||
(:file "x509-tests")
|
||||
(:file "idn-tests")))))
|
||||
(:file "idn-tests")
|
||||
(:file "jsonrpc2-tests")))))
|
||||
|
||||
;;(push :debug-mode *features*)
|
||||
;;(push :debug-gemini-request *features*)
|
||||
|
|
|
|||
Loading…
Reference in New Issue