tinmop/src/gui/client/json-rpc-communication.lisp

;; tinmop: an humble gemini and pleroma client
;; Copyright (C) 2023  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 *server-process* nil)

(defparameter *server-stream*  nil)

(defun read-from-server ()
  (let ((json (read-json *server-stream*)))
    (rpc:maybe-log-message (format nil "json from server: ~a" json))
    (json:parse json
                :object-as :plist
                :object-key-fn #'format-keyword)))

(defgeneric send-to-server (object))

(defmethod send-to-server ((object string))
  (send-to-server (string->octets object)))

(defmethod send-to-server ((object vector))
  (write-sequence object *server-stream*)
  (write-byte +command-delimiter+ *server-stream*)
  (finish-output *server-stream*))

(defmethod send-to-server ((object character))
  (send-to-server (char-code object)))

(defmethod send-to-server ((object integer))
  (write-byte (logand object #xff) *server-stream*)
  (finish-output *server-stream*))

(defparameter *request-lock* (bt:make-lock))

(defgeneric make-request (method id &rest args))

(defmethod make-request ((method symbol) id &rest args)
  (misc:with-lock (*request-lock*)
    (apply #'make-request (string-downcase (symbol-name method)) id args)))

(define-condition rpc-error-response (conditions:text-error)
  ((data
    :initform nil
    :initarg :data
    :reader  data)
   (code
    :initform nil
    :initarg :code
    :reader  code)
   (id
    :initform nil
    :initarg :id
    :reader  id))
  (:report (lambda (condition stream)
             (format stream
                     "id: ~a (~a) ~a data ~a"
                     (id              condition)
                     (code            condition)
                     (conditions:text condition)
                     (data            condition))))
   (:documentation "Error failed rpc request"))

(defmethod make-request ((method string) id &rest args)
  (let ((request (rpc:encode-to-string (apply #'rpc:make-request method id args))))
    (send-to-server request)
    (let ((raw-response (read-from-server)))
      (if (rpc:error-response-p raw-response)
          (multiple-value-bind (id message code data)
              (rpc:extract-error raw-response)
            (error 'rpc-error-response
                   :id id
                   :code code
                   :data data
                   :text message))
          (values (rpc:extract-results raw-response)
                  raw-response)))))

(defun close-server ()
  (make-request :quit-program 1))

(defun start-client ()
  (with-output-to-string (stream)
    (let ((process  (os-utils:run-external-program "/home/cage/lisp/tinmop/tinmop" ;+program-name+
                                                   (list (format nil
                                                                 "-~a"
                                                                 command-line:+start-server-command-line+))
                                                   :search t
                                                   :wait   nil
                                                   :output :stream
                                                   :input  :stream
                                                   :error  :stream)))
      (if process
          (let ((process-stream (make-two-way-stream (os-utils:process-output process)
                                                     (os-utils:process-input  process))))
            (setf *server-stream*  process-stream
                  *server-process* process))
          (error (_ "Unable to create server process"))))))

(defun start-client* ()
  (with-output-to-string (stream)
    (let* ((test-iri "gemini://omg.pebcak.club/")
           (process  (os-utils:run-external-program "/home/cage/lisp/tinmop/tinmop" ;+program-name+
                                                   (list (format nil
                                                                 "-~a"
                                                                 command-line:+start-server-command-line+))
                                                   :search t
                                                   :wait   nil
                                                   :output :stream
                                                   :input  :stream
                                                   :error  :stream)))
      (if process
          (let ((process-stream (make-two-way-stream (os-utils:process-output process)
                                                     (os-utils:process-input  process))))
            (setf *server-stream*  process-stream
                  *server-process* process)
            (loop repeat 2 do
              (let ((request (rpc:encode-to-string (rpc:make-request "gemini-request"
                                                                     1
                                                                     test-iri
                                                                     t))))
                (format t "sending ~a~%" request)
                (send-to-server request)
                (format t "returned ~s~%" (read-from-server))))
            (sleep 3)
            (let ((info-request (rpc:encode-to-string (rpc:make-request "gemini-stream-info"
                                                                         1
                                                                         test-iri))))
               (format t "sending ~a~%" info-request)
               (send-to-server info-request)
              (format t "returned ~s~%" (read-from-server)))
            (let ((status-request (make-request "gemini-stream-completed-p" 1 test-iri)))
              (format t "returned ~s~%" status-request))
            (let ((line-request (rpc:encode-to-string (rpc:make-request "gemini-stream-parsed-line"
                                                                         1
                                                                         test-iri
                                                                         2))))
               (format t "sending ~a~%" line-request)
               (send-to-server line-request)
              (format t "returned ~s~%" (read-from-server)))
            (let ((lines-request (rpc:encode-to-string
                                  (rpc:make-request "gemini-stream-parsed-line-slice"
                                                    1
                                                    test-iri
                                                    10
                                                    15))))
              (format t "sending ~a~%" lines-request)
              (send-to-server lines-request)
              (format t "returned ~s~%" (read-from-server)))
            (let ((all-info-request (rpc:encode-to-string
                                     (rpc:make-request "gemini-all-stream-info" 1))))
              (format t "sending ~a~%" all-info-request)
              (send-to-server all-info-request)
              (format t "returned ~s~%" (read-from-server)))
            (let ((pop-history-request (rpc:encode-to-string
                                     (rpc:make-request "gemini-pop-url-from-history" 1))))
              (format t "sending ~a~%" pop-history-request)
              (send-to-server pop-history-request)
              (format t "returned ~s~%" (read-from-server)))
            (let ((certificates (rpc:encode-to-string
                                 (rpc:make-request "gemini-certificates" 1))))
              (format t "sending ~a~%" certificates)
              (send-to-server certificates)
              (format t "returned ~s~%" (read-from-server)))
            (let ((toc (rpc:encode-to-string
                        (rpc:make-request "gemini-toc" 1 test-iri))))
              (format t "sending ~a~%" toc)
              (send-to-server toc)
              (format t "returned ~s~%" (read-from-server)))
            (close-server))
          (error (_ "Unable to create server process"))))))