mirror of https://codeberg.org/cage/tinmop/
- [gui] added an actual funcion for API;
- [jsonrpc] added more information when an internal error occurred; - added 'main:rpc-server-init'.
This commit is contained in:
cage
parent
39878d6475
commit
fb4be7bb9f
|
|
@ -1,3 +1,20 @@
|
|||
;; tinmop: an humble gemini and pleroma client
|
||||
;; Copyright (C) 2022 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/][http://www.gnu.org/licenses/]].
|
||||
|
||||
(in-package :json-rpc-communication)
|
||||
|
||||
(defparameter *stop-server* nil)
|
||||
|
|
@ -16,11 +33,6 @@
|
|||
|
||||
(a:define-constant +command-delimiter+ 0 :test #'=)
|
||||
|
||||
(defmacro prepare-rpc (&body body)
|
||||
`(let ((rpc:*function-db* '()))
|
||||
(rpc:register-function "add" '+ (list (cons "a" 0) (cons "b" 1)))
|
||||
,@body))
|
||||
|
||||
(defun read-json (stream)
|
||||
(to-s (read-delimited-into-array-unbuffered stream
|
||||
:delimiter +command-delimiter+)))
|
||||
|
|
@ -106,7 +118,7 @@
|
|||
(os-utils:process-input process))))
|
||||
(setf *server-stream* process-stream
|
||||
*server-process* process)
|
||||
(let ((request (rpc:jsonify (rpc:make-request "add" 1 10 20))))
|
||||
(let ((request (rpc:jsonify (rpc:make-request "complete-net-address" 1 "foo"))))
|
||||
(format t "sending ~a~%" request)
|
||||
(send-to-server request)
|
||||
(format t "returned ~s~%" (read-from-server))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;; fulci: a program to organize your movies collection
|
||||
;; Copyright (C) 2019 cage
|
||||
;; tinmop: an humble gemini and pleroma client
|
||||
;; Copyright (C) 2022 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
|
||||
|
|
@ -12,7 +12,8 @@
|
|||
;; 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/>.
|
||||
;; along with this program.
|
||||
;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
|
||||
|
||||
(in-package :json-rpc2)
|
||||
|
||||
|
|
@ -71,11 +72,12 @@
|
|||
|
||||
(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)
|
||||
|
||||
(defun make-internal-error-message (msg)
|
||||
(make-response-error -32603 (format nil "Internal error: ~a" msg)))
|
||||
|
||||
(defclass function-param ()
|
||||
((name
|
||||
:initarg :name
|
||||
|
|
@ -171,7 +173,7 @@
|
|||
(cond
|
||||
((not (symbolp fun-symbol))
|
||||
(error 'json-rpc-error
|
||||
:text (format nil "function symbol of a function be a symbol not ~a"
|
||||
:text (format nil "function symbol of a function must be a symbol not ~a"
|
||||
fun-symbol)))
|
||||
((not (find-function fun-symbol))
|
||||
(error 'json-rpc-error
|
||||
|
|
@ -404,8 +406,10 @@
|
|||
(make-response-error (or (code e)
|
||||
(response-error-code +error-invalid-request+))
|
||||
(text e))))
|
||||
(error ()
|
||||
(make-response nil nil :error-object +error-internal-error+))))
|
||||
(error (e)
|
||||
(make-response nil
|
||||
nil
|
||||
:error-object (make-internal-error-message (format nil "~a" e))))))
|
||||
|
||||
(defun likely-not-batch-p (request)
|
||||
(and (every (lambda (a) (and (consp a)
|
||||
|
|
|
|||
|
|
@ -110,8 +110,9 @@ etc.) happened"
|
|||
(defun reset-timeline-pagination ()
|
||||
(ui:reset-timeline-pagination))
|
||||
|
||||
(defun load-configuration-files ()
|
||||
(when (not command-line:*script-file*)
|
||||
(defun load-configuration-files (&key (verbose t))
|
||||
(when (and verbose
|
||||
(not command-line:*script-file*))
|
||||
(format t
|
||||
(_ "Loading configuration file ~a~%")
|
||||
swconf:+shared-conf-filename+))
|
||||
|
|
@ -132,11 +133,24 @@ etc.) happened"
|
|||
(invoke-restart 'res:create-empty-in-home))))
|
||||
(swconf:load-config-file swconf:+conf-filename+)))
|
||||
|
||||
(defun shared-init ()
|
||||
(defun shared-init (&key (verbose t))
|
||||
(num:lcg-set-seed)
|
||||
(load-configuration-files)
|
||||
(load-configuration-files :verbose verbose)
|
||||
(init-db))
|
||||
|
||||
(defun rpc-server-init ()
|
||||
"Initialize the program"
|
||||
(shared-init :verbose nil)
|
||||
(db-utils:with-ready-database (:connect nil)
|
||||
(when command-line:*module-file*
|
||||
(handler-case
|
||||
(modules:load-module command-line:*module-file*)
|
||||
(error ()
|
||||
(ui:notify (format nil
|
||||
(_ "Unable to load module ~a")
|
||||
command-line:*module-file*)
|
||||
:as-error t))))))
|
||||
|
||||
(defun tui-init ()
|
||||
"Initialize the program"
|
||||
(shared-init)
|
||||
|
|
@ -230,7 +244,9 @@ etc.) happened"
|
|||
(command-line:manage-opts)
|
||||
(cond
|
||||
(command-line:*rpc-server-mode*
|
||||
(json-rpc-communication:start-server))
|
||||
(db-utils:with-ready-database (:connect nil)
|
||||
(rpc-server-init)
|
||||
(json-rpc-communication:start-server)))
|
||||
(command-line:*rpc-client-mode*
|
||||
(json-rpc-communication:start-client))
|
||||
(command-line:*print-lisp-dependencies*
|
||||
|
|
@ -239,8 +255,8 @@ etc.) happened"
|
|||
(load-script-file))
|
||||
(t
|
||||
(let ((croatoan::*debugger-hook* #'(lambda (c h)
|
||||
(declare (ignore h))
|
||||
(c:end-screen)
|
||||
(print c))))
|
||||
(declare (ignore h))
|
||||
(c:end-screen)
|
||||
(print c))))
|
||||
(tui-init)
|
||||
(run first-time-starting))))))
|
||||
|
|
|
|||
|
|
@ -27,13 +27,13 @@
|
|||
(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)))
|
||||
(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)))
|
||||
(cons "values1" 1)
|
||||
(cons "values2" 2)))
|
||||
(register-function "notify_hello" '+ (list (cons "values0" 0)))
|
||||
,@body))
|
||||
|
||||
|
|
|
|||
33
tinmop.asd
33
tinmop.asd
|
|
@ -147,24 +147,25 @@
|
|||
(:file "modules")
|
||||
(:file "json-rpc2")
|
||||
(:module gui
|
||||
:components ((:file "json-rpc-communication")))
|
||||
:components ((:file "public-api")
|
||||
(:file "json-rpc-communication")))
|
||||
(:file "main")
|
||||
(:module tests
|
||||
:components ((:file "package")
|
||||
(:file "all-tests")
|
||||
(:file "misc-tests")
|
||||
(:file "box-tests")
|
||||
(:file "uri-tests")
|
||||
(:file "iri-tests")
|
||||
(:file "numeric-tests")
|
||||
(:file "text-utils-tests")
|
||||
(:file "mtree-tests")
|
||||
(:file "thread-window-tests")
|
||||
(:file "gemini-parser-tests")
|
||||
(:file "program-events-tests")
|
||||
(:file "x509-tests")
|
||||
(:file "idn-tests")
|
||||
(:file "jsonrpc2-tests")))))
|
||||
:components ((:file "package")
|
||||
(:file "all-tests")
|
||||
(:file "misc-tests")
|
||||
(:file "box-tests")
|
||||
(:file "uri-tests")
|
||||
(:file "iri-tests")
|
||||
(:file "numeric-tests")
|
||||
(:file "text-utils-tests")
|
||||
(:file "mtree-tests")
|
||||
(:file "thread-window-tests")
|
||||
(:file "gemini-parser-tests")
|
||||
(:file "program-events-tests")
|
||||
(:file "x509-tests")
|
||||
(:file "idn-tests")
|
||||
(:file "jsonrpc2-tests")))))
|
||||
|
||||
;;(push :debug-mode *features*)
|
||||
;;(push :debug-gemini-request *features*)
|
||||
|
|
|
|||
Loading…
Reference in New Issue