From 0bc1904df50a1828b5d43b909e86fc6b52d8227f Mon Sep 17 00:00:00 2001 From: kilianmh Date: Sun, 16 Jun 2024 12:16:23 +0200 Subject: [PATCH 1/2] Chore: reorganize symbols - jsonrpc restructured in recent changes. - call import from jsonrpc/base - client import from jsonrpc/client - bind-server-to-transport import from jsonrpc/server - explicitly import-from symbols in openrpc-client/core and remove package qualifiers - update README with jsonrpc/client:client --- README.md | 2 +- client/core.lisp | 80 ++++++++++++------- client/docs.lisp | 2 +- server/clack.lisp | 2 +- .../multiple-types/client-class.lisp | 2 +- 5 files changed, 53 insertions(+), 35 deletions(-) diff --git a/README.md b/README.md index f027aa2..f1dfebf 100644 --- a/README.md +++ b/README.md @@ -406,7 +406,7 @@ For example, this macro call: Will generate the whole bunch of classes and methods: ``` -(defclass petshop (jsonrpc/class:client) nil) +(defclass petshop (jsonrpc/client:client) nil) (defun make-petshop () (make-instance 'petshop)) diff --git a/client/core.lisp b/client/core.lisp index 32007d9..2dc9d11 100644 --- a/client/core.lisp +++ b/client/core.lisp @@ -3,11 +3,29 @@ (:import-from #:kebab #:to-lisp-case) (:import-from #:log) - (:import-from #:yason) - (:import-from #:jsonrpc/class) - (:import-from #:str) - (:import-from #:dexador) + (:import-from #:closer-mop + #:method-lambda-list + #:method-specializers + #:method-generic-function + #:generic-function-name + #:eql-specializer-object + #:specializer-direct-methods + #:specializer) + (:import-from #:yason + #:parse + #:false) + (:import-from #:jsonrpc/client + #:client) + (:import-from #:jsonrpc/base + #:call) + (:import-from #:str + #:starts-with-p + #:replace-all) + (:import-from #:dexador + #:response-body + #:http-request-internal-server-error) (:import-from #:alexandria + #:symbolicate #:length= #:make-keyword #:appendf @@ -23,18 +41,18 @@ (in-package #:openrpc-client/core) -(declaim (ftype (function (closer-mop:specializer stream) null) +(declaim (ftype (function (specializer stream) null) generate-method-descriptions)) (defun generate-method-descriptions (class stream) "Prints method lambda lists wherein a class is used as parameter specializer. The list is ordered alphabetically and excludes the describe-object method." (flet ((proper-lambda-list (method) - (let* ((lambda-list (closer-mop:method-lambda-list method)) - (specializers (closer-mop:method-specializers method)) + (let* ((lambda-list (method-lambda-list method)) + (specializers (method-specializers method)) (list-element 0) (method-name (intern (symbol-name - (closer-mop:generic-function-name - (closer-mop:method-generic-function method))))) + (generic-function-name + (method-generic-function method))))) (lambda-list-parameters (mapcar (lambda (element) (let ((type @@ -43,7 +61,7 @@ The list is ordered alphabetically and excludes the describe-object method." (list (intern (symbol-name element)) (if (string-equal 'eql-specializer (class-name (class-of type))) - (list 'eql (closer-mop:eql-specializer-object type)) + (list 'eql (eql-specializer-object type)) (intern (symbol-name (class-name type))))) (typecase element (symbol @@ -60,12 +78,12 @@ The list is ordered alphabetically and excludes the describe-object method." (list method-name))))))) (format stream "Supported RPC methods:~2%") (mapc #'proper-lambda-list - (stable-sort (copy-list (closer-mop:specializer-direct-methods class)) + (stable-sort (copy-list (specializer-direct-methods class)) (lambda (method1 method2) - (string-lessp (closer-mop:generic-function-name - (closer-mop:method-generic-function method1)) - (closer-mop:generic-function-name - (closer-mop:method-generic-function method2)))))) + (string-lessp (generic-function-name + (method-generic-function method1)) + (generic-function-name + (method-generic-function method2)))))) nil)) (eval-when (:compile-toplevel :load-toplevel :execute) @@ -73,8 +91,8 @@ The list is ordered alphabetically and excludes the describe-object method." cons) generate-client-class)) (defun generate-client-class (class-name &key export-symbols) - (let* ((make-func-name (alexandria:symbolicate "MAKE-" class-name)) - (result `((defclass ,class-name (jsonrpc/class:client) + (let* ((make-func-name (symbolicate "MAKE-" class-name)) + (result `((defclass ,class-name (client) ()) (defun ,make-func-name () (make-instance ',class-name)) @@ -89,7 +107,7 @@ The list is ordered alphabetically and excludes the describe-object method." (defun normalize-name (string) (string-upcase (to-lisp-case - (str:replace-all "." "-" string)))) + (replace-all "." "-" string)))) (declaim (ftype (function (hash-table) cons) schema-to-type)) (defun schema-to-type (schema) @@ -105,7 +123,7 @@ The list is ordered alphabetically and excludes the describe-object method." (push 'integer type-list)) ((string-equal type "string") (push 'string type-list)) ((string-equal type "boolean") - (push '(eql yason:false) type-list) + (push '(eql false) type-list) (push '(eql t) type-list)) ((string-equal type "object") (push 'hash-table type-list)) ((string-equal type "array") (push 'list type-list)) @@ -186,7 +204,7 @@ The list is ordered alphabetically and excludes the describe-object method." for name = (intern (normalize-name (gethash "name" param))) for default = nil - for given-name = (alexandria:symbolicate name "-GIVEN-P") + for given-name = (symbolicate name "-GIVEN-P") collect (list name default given-name)))))) (declare (list required-parameter keyword-parameter)) (return (if required-parameter @@ -216,7 +234,7 @@ The list is ordered alphabetically and excludes the describe-object method." ,@(loop for param in keyword-params for original-name = (gethash "name" param) for name = (intern (normalize-name original-name)) - for given-name = (alexandria:symbolicate name "-GIVEN-P") + for given-name = (symbolicate name "-GIVEN-P") collect `(when ,given-name (setf (gethash ,original-name args) ,name))) @@ -224,15 +242,15 @@ The list is ordered alphabetically and excludes the describe-object method." args)))) (defun get-or-create-class (x-cl-class schema classes-cache &key export-symbols) - (let* ((class-name (alexandria:symbolicate (string-upcase x-cl-class))) + (let* ((class-name (symbolicate (string-upcase x-cl-class))) (existing-code (gethash class-name classes-cache))) (unless existing-code (loop with properties = (gethash "properties" schema) for name being the hash-key of properties - for name-symbol = (alexandria:symbolicate (string-upcase + for name-symbol = (symbolicate (string-upcase (to-lisp-case name))) - for name-keyword = (alexandria:make-keyword name-symbol) - for reader-func = (alexandria:symbolicate class-name + for name-keyword = (make-keyword name-symbol) + for reader-func = (symbolicate class-name "-" name-symbol) collect `(export ',reader-func) into slot-reader-exports @@ -431,12 +449,12 @@ lambda-list a separate defmethod." path)))) (defun retrieve-spec (url-or-path) - (yason:parse + (parse (etypecase url-or-path (pathname (retrieve-data-from-path url-or-path)) (string (cond - ((str:starts-with-p "http" url-or-path) + ((starts-with-p "http" url-or-path) (retrieve-data-from-url url-or-path)) (t (retrieve-data-from-path url-or-path)))))))) @@ -444,10 +462,10 @@ lambda-list a separate defmethod." (defgeneric rpc-call (client func-name arguments) (:method ((client t) func-name (arguments t)) - (handler-bind ((dexador.error:http-request-internal-server-error + (handler-bind ((http-request-internal-server-error (lambda (condition) - (let* ((body (dex:response-body condition)) - (response (yason:parse body)) + (let* ((body (response-body condition)) + (response (parse body)) (error (gethash "error" response)) (code (gethash "code" error)) (message (gethash "message" error))) @@ -459,7 +477,7 @@ lambda-list a separate defmethod." :message message :func-name func-name :func-arguments arguments))))) - (jsonrpc/class:call client func-name arguments)))) + (call client func-name arguments)))) (eval-when (:compile-toplevel :load-toplevel :execute) diff --git a/client/docs.lisp b/client/docs.lisp index edeba98..d171e82 100644 --- a/client/docs.lisp +++ b/client/docs.lisp @@ -27,7 +27,7 @@ Will generate the whole bunch of classes and methods: ``` -(defclass petshop (jsonrpc/class:client) nil) +(defclass petshop (jsonrpc/client:client) nil) (defun make-petshop () (make-instance 'petshop)) diff --git a/server/clack.lisp b/server/clack.lisp index 17735e3..cd39552 100644 --- a/server/clack.lisp +++ b/server/clack.lisp @@ -3,7 +3,7 @@ (:import-from #:jsonrpc) (:import-from #:yason) (:import-from #:lack.request) - (:import-from #:jsonrpc/class + (:import-from #:jsonrpc/server #:bind-server-to-transport) (:import-from #:jsonrpc/transport/websocket #:websocket-transport) diff --git a/t/client/regress-data/multiple-types/client-class.lisp b/t/client/regress-data/multiple-types/client-class.lisp index fc02be9..6cb0e77 100644 --- a/t/client/regress-data/multiple-types/client-class.lisp +++ b/t/client/regress-data/multiple-types/client-class.lisp @@ -1,4 +1,4 @@ -((defclass the-class (jsonrpc/class:client) nil) +((defclass the-class (jsonrpc/client:client) nil) (defun make-the-class () (make-instance 'the-class)) (defmethod describe-object ((openrpc-client/core::client the-class) stream) (openrpc-client/core::generate-method-descriptions From 7945161189c5212eb1349f58f62631eea0f245c7 Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Tue, 18 Jun 2024 18:51:08 +0300 Subject: [PATCH 2/2] Update qlfile.lock and fix CI pipeline. --- .github/workflows/client-ci.yml | 36 ++----------- .github/workflows/docs.yml | 88 ------------------------------- .github/workflows/server-ci.yml | 92 +++++---------------------------- .gitignore | 1 + openrpc-deps.asd | 2 + openrpc-server.asd | 5 +- qlfile.lock | 6 +-- server/ci.lisp | 32 ++++++------ server/clack.lisp | 1 + 9 files changed, 45 insertions(+), 218 deletions(-) delete mode 100644 .github/workflows/docs.yml create mode 100644 openrpc-deps.asd diff --git a/.github/workflows/client-ci.yml b/.github/workflows/client-ci.yml index b5e9ccc..78bd446 100644 --- a/.github/workflows/client-ci.yml +++ b/.github/workflows/client-ci.yml @@ -24,41 +24,15 @@ "steps": [ { "name": "Checkout Code", - "uses": "actions/checkout@v3" - }, - { - "name": "Grant All Perms to Make Cache Restoring Possible", - "run": "sudo mkdir -p /usr/local/etc/roswell\n sudo chown \"${USER}\" /usr/local/etc/roswell\n # Here the ros binary will be restored:\n sudo chown \"${USER}\" /usr/local/bin", - "shell": "bash" - }, - { - "name": "Get Current Month", - "id": "current-month", - "run": "echo \"value=$(date -u \"+%Y-%m\")\" >> $GITHUB_OUTPUT", - "shell": "bash" - }, - { - "name": "Cache Roswell Setup", - "id": "cache", - "uses": "actions/cache@v3", - "with": { - "path": "qlfile\nqlfile.lock\n~/.cache/common-lisp/\n~/.roswell\n/usr/local/etc/roswell\n/usr/local/bin/ros\n/usr/local/Cellar/roswell\n.qlot", - "key": "a-${{ steps.current-month.outputs.value }}-${{ env.cache-name }}-ubuntu-latest-quicklisp-sbcl-bin-${{ hashFiles('qlfile.lock', '*.asd') }}" - } - }, - { - "name": "Restore Path To Cached Files", - "run": "echo $HOME/.roswell/bin >> $GITHUB_PATH\n echo .qlot/bin >> $GITHUB_PATH", - "shell": "bash", - "if": "steps.cache.outputs.cache-hit == 'true'" + "uses": "actions/checkout@v4" }, { "name": "Setup Common Lisp Environment", - "uses": "40ants/setup-lisp@v2", + "uses": "40ants/setup-lisp@v4", "with": { - "asdf-system": "openrpc-client" - }, - "if": "steps.cache.outputs.cache-hit != 'true'" + "asdf-system": "openrpc-client", + "cache": "true" + } }, { "name": "Change dist to Ultralisp if qlfile does not exist", diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml deleted file mode 100644 index e60bcde..0000000 --- a/.github/workflows/docs.yml +++ /dev/null @@ -1,88 +0,0 @@ -{ - "name": "DOCS", - "on": { - "push": { - "branches": [ - "master" - ] - }, - "pull_request": null, - "schedule": [ - { - "cron": "0 10 * * 1" - } - ] - }, - "jobs": { - "linter": { - "runs-on": "ubuntu-latest", - "env": { - "OS": "ubuntu-latest", - "QUICKLISP_DIST": "quicklisp", - "LISP": "sbcl-bin" - }, - "steps": [ - { - "name": "Checkout Code", - "uses": "actions/checkout@v3" - }, - { - "name": "Setup Common Lisp Environment", - "uses": "40ants/setup-lisp@v2", - "with": { - "asdf-system": "openrpc-docs" - } - }, - { - "name": "Change dist to Ultralisp if qlfile does not exist", - "run": "if [[ ! -e qlfile ]]; then echo 'dist ultralisp http://dist.ultralisp.org' > qlfile; fi", - "shell": "bash" - }, - { - "name": "Update Qlot", - "run": "qlot update --no-deps", - "shell": "bash" - }, - { - "name": "Install SBLint wrapper", - "run": "qlot exec ros install 40ants-asdf-system 40ants-linter", - "shell": "bash" - }, - { - "name": "Run Linter", - "run": "qlot exec 40ants-linter --system \"openrpc-docs\" --imports", - "shell": "bash" - } - ] - }, - "build-docs": { - "runs-on": "ubuntu-latest", - "env": { - "OS": "ubuntu-latest", - "QUICKLISP_DIST": "quicklisp", - "LISP": "sbcl-bin" - }, - "steps": [ - { - "name": "Checkout Code", - "uses": "actions/checkout@v3" - }, - { - "name": "Setup Common Lisp Environment", - "uses": "40ants/setup-lisp@v2", - "with": { - "asdf-system": "openrpc-docs" - } - }, - { - "name": "Build Docs", - "uses": "40ants/build-docs@v1", - "with": { - "asdf-system": "openrpc-docs", - "error-on-warnings": true - } - } - ] - } - } -} \ No newline at end of file diff --git a/.github/workflows/server-ci.yml b/.github/workflows/server-ci.yml index 204816b..a03d5c6 100644 --- a/.github/workflows/server-ci.yml +++ b/.github/workflows/server-ci.yml @@ -24,41 +24,15 @@ "steps": [ { "name": "Checkout Code", - "uses": "actions/checkout@v3" - }, - { - "name": "Grant All Perms to Make Cache Restoring Possible", - "run": "sudo mkdir -p /usr/local/etc/roswell\n sudo chown \"${USER}\" /usr/local/etc/roswell\n # Here the ros binary will be restored:\n sudo chown \"${USER}\" /usr/local/bin", - "shell": "bash" - }, - { - "name": "Get Current Month", - "id": "current-month", - "run": "echo \"value=$(date -u \"+%Y-%m\")\" >> $GITHUB_OUTPUT", - "shell": "bash" - }, - { - "name": "Cache Roswell Setup", - "id": "cache", - "uses": "actions/cache@v3", - "with": { - "path": "qlfile\nqlfile.lock\n~/.cache/common-lisp/\n~/.roswell\n/usr/local/etc/roswell\n/usr/local/bin/ros\n/usr/local/Cellar/roswell\n.qlot", - "key": "a-${{ steps.current-month.outputs.value }}-${{ env.cache-name }}-ubuntu-latest-quicklisp-sbcl-bin-${{ hashFiles('qlfile.lock', '*.asd') }}" - } - }, - { - "name": "Restore Path To Cached Files", - "run": "echo $HOME/.roswell/bin >> $GITHUB_PATH\n echo .qlot/bin >> $GITHUB_PATH", - "shell": "bash", - "if": "steps.cache.outputs.cache-hit == 'true'" + "uses": "actions/checkout@v4" }, { "name": "Setup Common Lisp Environment", - "uses": "40ants/setup-lisp@v2", + "uses": "40ants/setup-lisp@v4", "with": { - "asdf-system": "openrpc-server" - }, - "if": "steps.cache.outputs.cache-hit != 'true'" + "asdf-system": "openrpc-server", + "cache": "true" + } }, { "name": "Change dist to Ultralisp if qlfile does not exist", @@ -88,23 +62,7 @@ "matrix": { "os": [ "ubuntu-latest", - "macos-latest" - ], - "exclude": [ - { - "os": "macos-latest", - "lisp": "clisp" - }, - { - "os": "macos-latest", - "lisp": "ecl" - } - ], - "lisp": [ - "sbcl-bin", - "ccl-bin/1.12.1", - "clisp", - "ecl" + "macos-13" ] } }, @@ -112,47 +70,21 @@ "env": { "OS": "${{ matrix.os }}", "QUICKLISP_DIST": "ultralisp", - "LISP": "${{ matrix.lisp }}" + "LISP": "sbcl-bin" }, "steps": [ { "name": "Checkout Code", - "uses": "actions/checkout@v3" - }, - { - "name": "Grant All Perms to Make Cache Restoring Possible", - "run": "sudo mkdir -p /usr/local/etc/roswell\n sudo chown \"${USER}\" /usr/local/etc/roswell\n # Here the ros binary will be restored:\n sudo chown \"${USER}\" /usr/local/bin", - "shell": "bash" - }, - { - "name": "Get Current Month", - "id": "current-month", - "run": "echo \"value=$(date -u \"+%Y-%m\")\" >> $GITHUB_OUTPUT", - "shell": "bash" - }, - { - "name": "Cache Roswell Setup", - "id": "cache", - "uses": "actions/cache@v3", - "with": { - "path": "qlfile\nqlfile.lock\n~/.cache/common-lisp/\n~/.roswell\n/usr/local/etc/roswell\n/usr/local/bin/ros\n/usr/local/Cellar/roswell\n.qlot", - "key": "a-${{ steps.current-month.outputs.value }}-${{ env.cache-name }}-${{ matrix.os }}-ultralisp-${{ matrix.lisp }}-${{ hashFiles('qlfile.lock', '*.asd') }}" - } - }, - { - "name": "Restore Path To Cached Files", - "run": "echo $HOME/.roswell/bin >> $GITHUB_PATH\n echo .qlot/bin >> $GITHUB_PATH", - "shell": "bash", - "if": "steps.cache.outputs.cache-hit == 'true'" + "uses": "actions/checkout@v4" }, { "name": "Setup Common Lisp Environment", - "uses": "40ants/setup-lisp@v2", + "uses": "40ants/setup-lisp@v4", "with": { "asdf-system": "openrpc-server", - "qlfile-template": "{% ifequal quicklisp_dist \"ultralisp\" %}\ndist ultralisp http://dist.ultralisp.org\n{% endifequal %}" - }, - "if": "steps.cache.outputs.cache-hit != 'true'" + "qlfile-template": "{% ifequal env.quicklisp_dist \"ultralisp\" %}\ndist ultralisp http://dist.ultralisp.org\n{% endifequal %}", + "cache": "true" + } }, { "name": "Run Tests", diff --git a/.gitignore b/.gitignore index f7b802d..e218a20 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ /env/ /.qlot /.DS_Store +.*undo-tree* diff --git a/openrpc-deps.asd b/openrpc-deps.asd new file mode 100644 index 0000000..7a0a047 --- /dev/null +++ b/openrpc-deps.asd @@ -0,0 +1,2 @@ +(defsystem "openrpc-deps" + :depends-on ("jsonrpc")) diff --git a/openrpc-server.asd b/openrpc-server.asd index cbd278a..bbd8c06 100644 --- a/openrpc-server.asd +++ b/openrpc-server.asd @@ -5,7 +5,10 @@ :class :40ants-asdf-system :defsystem-depends-on ("40ants-asdf-system") :pathname "server" - :depends-on ("openrpc-server/server" + :serial t + :depends-on ("log4cl-extras" + ;; "jsonrpc" + "openrpc-server/server" "openrpc-server/class" "openrpc-server/discovery") :description "OpenRPC server implementation for Common Lisp." diff --git a/qlfile.lock b/qlfile.lock index abd6458..8f7badd 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -1,8 +1,8 @@ ("quicklisp" . (:class qlot/source/dist:source-dist - :initargs (:distribution "http://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest) + :initargs (:distribution "https://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest) :version "2023-10-21")) ("ultralisp" . (:class qlot/source/dist:source-dist - :initargs (:distribution "http://dist.ultralisp.org" :%version :latest) - :version "20240303155001")) + :initargs (:distribution "https://dist.ultralisp.org" :%version :latest) + :version "20240618125502")) diff --git a/server/ci.lisp b/server/ci.lisp index 405d722..b0360d9 100644 --- a/server/ci.lisp +++ b/server/ci.lisp @@ -22,26 +22,28 @@ :jobs ((40ants-ci/jobs/linter:linter :check-imports t) (run-tests :os ("ubuntu-latest" - "macos-latest") + "macos-13") :quicklisp (;; Quicklisp is not working yet, because - ;; there is old JSONRPC where no "jsonrpc/transport/http" system. + ;; there is old JSONRPC where no "jsonrpc/server" system. ;; "quicklisp" "ultralisp") :lisp ("sbcl-bin" - ;; On CCL there are some strange network errors both on ubuntu and OSX - "ccl-bin/1.12.1" - "clisp" - "ecl") - :exclude ( - ;; For some reason CLISP of OSX does not support threading - ;; and bordeaux-threads fails to compile - (:os "macos-latest" - :lisp "clisp") - ;; ECL on OSX fails to compile prometheus-gc/sbcl - (:os "macos-latest" - :lisp "ecl")) + ;; If somebody cares about these or other implementations + ;; you can join as a maintainer: + ;; "ccl-bin" + ;; "clisp" + ;; "ecl" + ) + ;; :exclude ( + ;; ;; For some reason CLISP of OSX does not support threading + ;; ;; and bordeaux-threads fails to compile + ;; (:os "macos-13" + ;; :lisp "clisp") + ;; ;; ECL on OSX fails to compile prometheus-gc/sbcl + ;; (:os "macos-13" + ;; :lisp "ecl")) :coverage t - :qlfile "{% ifequal quicklisp_dist \"ultralisp\" %} + :qlfile "{% ifequal env.quicklisp_dist \"ultralisp\" %} dist ultralisp http://dist.ultralisp.org {% endifequal %}"))) diff --git a/server/clack.lisp b/server/clack.lisp index cd39552..73b5015 100644 --- a/server/clack.lisp +++ b/server/clack.lisp @@ -3,6 +3,7 @@ (:import-from #:jsonrpc) (:import-from #:yason) (:import-from #:lack.request) + (:import-from #:jsonrpc) (:import-from #:jsonrpc/server #:bind-server-to-transport) (:import-from #:jsonrpc/transport/websocket