- [gui] added an actual funcion for API;

- [jsonrpc] added more information when an internal error occurred;
- added 'main:rpc-server-init'.

src/gui/json-rpc-communication.lisp

@@ -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))

src/json-rpc2.lisp

@@ -1,5 +1,5 @@
-;; fulci: a program to organize your movies collection
+;; tinmop: an humble gemini and pleroma client
-;; Copyright (C) 2019  cage
+;; 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 ()
+    (error (e)
-      (make-response nil nil :error-object +error-internal-error+))))
+      (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)

src/main.lisp

@@ -110,8 +110,9 @@ etc.) happened"
 (defun reset-timeline-pagination ()
   (ui:reset-timeline-pagination))
 
-(defun load-configuration-files ()
+(defun load-configuration-files (&key (verbose t))
-  (when (not command-line:*script-file*)
+  (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))
+                                            (declare (ignore h))
-                                             (c:end-screen)
+                                            (c:end-screen)
-                                             (print c))))
+                                            (print c))))
          (tui-init)
          (run first-time-starting))))))

src/tests/jsonrpc2-tests.lisp

@@ -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 "values1" 1)
-                                                         (cons "values2" 2)
+                                                           (cons "values2" 2)
-                                                         (cons "values3" 3)
+                                                           (cons "values3" 3)
-                                                         (cons "values4" 4)))
+                                                           (cons "values4" 4)))
      (register-function "notify_sum"   '+            (list (cons "values0" 0)
-                                                         (cons "values1" 1)
+                                                           (cons "values1" 1)
-                                                         (cons "values2" 2)))
+                                                           (cons "values2" 2)))
      (register-function "notify_hello" '+            (list (cons "values0" 0)))
      ,@body))
 

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")
+                :components ((:file "package")
-                                     (:file "all-tests")
+                             (:file "all-tests")
-                                     (:file "misc-tests")
+                             (:file "misc-tests")
-                                     (:file "box-tests")
+                             (:file "box-tests")
-                                     (:file "uri-tests")
+                             (:file "uri-tests")
-                                     (:file "iri-tests")
+                             (:file "iri-tests")
-                                     (:file "numeric-tests")
+                             (:file "numeric-tests")
-                                     (:file "text-utils-tests")
+                             (:file "text-utils-tests")
-                                     (:file "mtree-tests")
+                             (:file "mtree-tests")
-                                     (:file "thread-window-tests")
+                             (:file "thread-window-tests")
-                                     (:file "gemini-parser-tests")
+                             (:file "gemini-parser-tests")
-                                     (:file "program-events-tests")
+                             (:file "program-events-tests")
-                                     (:file "x509-tests")
+                             (:file "x509-tests")
-                                     (:file "idn-tests")
+                             (:file "idn-tests")
-                                     (:file "jsonrpc2-tests")))))
+                             (:file "jsonrpc2-tests")))))
 
 ;;(push :debug-mode            *features*)
 ;;(push :debug-gemini-request  *features*)