cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [RPC] added functions for managing tour links and clients certificates.

This commit is contained in:
cage 2023-01-12 16:08:10 +01:00
parent 51c4a03c2c
commit 8b1d00817f
3 changed files with 76 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/gui/server/json-rpc-communication.lisp
View File

@ -162,16 +162,19 @@
(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))))
(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))))
(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)))
(close-server))
(error (_ "Unable to create server process"))))))

15
src/gui/server/main-window-server-side.lisp
View File

@ -37,22 +37,25 @@
(setf (links-tour object) (misc:shuffle (links-tour object)))
object)
(defmethod add-tour-link ((object gemini-window) (link string))
(defmethod add-tour-link ((object gemini-window) (link gemini-parser:gemini-link))
(with-accessors ((links-tour links-tour)) object
(a:reversef links-tour)
(push link links-tour)
(a:reversef links-tour)
object))
(defmethod add-tour-link ((object gemini-window) (link gemini-parser:gemini-link))
(add-tour-link object (gemini-parser:target link)))
(defmethod pop-tour-link ((object gemini-window))
(pop (links-tour object)))
(with-accessors ((links-tour links-tour)) object
(when links-tour
(pop links-tour))))
(defmethod delete-tour-link-element ((object gemini-window) url)
(with-accessors ((links-tour links-tour)) object
(setf links-tour (remove url links-tour :test #'string=))))
(setf links-tour (remove-if (lambda (a)
(string= (gemini-parser:target a)
url))
links-tour))
object))
(defmethod clear-tour-link ((object gemini-window))
(with-accessors ((links-tour links-tour)) object

65
src/gui/server/public-api.lisp
View File

@ -270,8 +270,10 @@
line-number)))))
(first res))))))))
(defstruct parsed-lines-slice
(lines))
(defstruct box
(payload))
(defstruct (parsed-lines-slice (:include box)))
(defmethod yason:encode ((object parsed-lines-slice) &optional (stream *standard-output*))
(let ((json:*symbol-encoder* #'json:encode-symbol-as-lowercase)
@ -279,7 +281,7 @@
(json:*symbol-key-encoder* #'json:encode-symbol-as-lowercase))
(yason:with-output (stream)
(json:with-array ()
(loop for parsed-line in (parsed-lines-slice-lines object) do
(loop for parsed-line in (parsed-lines-slice-payload object) do
(json:encode-array-element parsed-line))))))
(defun gemini-stream-parsed-line-slice (iri line-number-start line-number-end)
@ -307,7 +309,7 @@
(let ((res (rearrange-parsed-line-for-encoding (subseq parsed-lines
line-number-start
line-number-end))))
(make-parsed-lines-slice :lines res))))))))
(make-parsed-lines-slice :payload res))))))))
(defun gemini-stream-info (iri)
(let ((stream-wrapper (gw:find-db-stream-url iri)))
@ -318,6 +320,46 @@
(defun gemini-all-stream-info ()
gw:*gemini-streams-db*)
(defstruct (gemini-certificates (:include box)))
(defmethod yason:encode ((object gemini-certificates) &optional (stream *standard-output*))
(let ((json:*symbol-encoder* #'json:encode-symbol-as-lowercase)
(yason:*list-encoder* #'yason:encode-plist)
(json:*symbol-key-encoder* #'json:encode-symbol-as-lowercase))
(yason:with-output (stream)
(yason:encode (gemini-certificates-payload object)))))
(defun gemini-certificates ()
(make-gemini-certificates :payload (db:find-tls-certificates-rows)))
(defun invalidate-cached-value (cache-key)
(db:cache-invalidate cache-key)
t)
(defun gemini-delete-certificate (cache-key)
(invalidate-cached-value cache-key)
(defun tour-shuffle ()
(shuffle-tour *gemini-window*))
(defun tour-add-link (link-value link-label)
(add-tour-link *gemini-window*
(make-instance 'gemini-parser:gemini-link
:name link-label
:target link-value)))
(defun tour-pop-link ()
(a:when-let ((link (pop-tour-link *gemini-window*)))
(list :link-value (gemini-parser:target link)
:link-label (gemini-parser:name link))))
(defun tour-delete-link (url)
(delete-tour-link-element *gemini-window* url))
(defun clear-tour ()
(clear-tour-link *gemini-window*))
(defmacro prepare-rpc (&body body)
`(let ((rpc:*function-db* '()))
(gen-rpc "add"
@ -346,5 +388,18 @@
(gen-rpc "gemini-all-stream-info" 'gemini-all-stream-info)
(gen-rpc "gemini-current-url" 'gemini-current-url)
(gen-rpc "gemini-pop-url-from-history" 'gemini-pop-url-from-history)
(gen-rpc "gemini-certificates" 'gemini-certificates)
(gen-rpc "gemini-delete-certificate"
'gemini-delete-certificate
"cache-key" 0)
(gen-rpc "tour-shuffle" 'tour-shuffle)
(gen-rpc "tour-add-link"
'tour-add-link
"link-value" 0
"link-label" 1)
(gen-rpc "tour-pop-link" 'tour-pop-link)
(gen-rpc "tour-delete-link"
'tour-delete-link
"url" 0)
(gen-rpc "clear-tour" 'clear-tour)
,@body))