diff --git a/src/gui/server/public-api-gemini-certificates.lisp b/src/gui/server/public-api-gemini-certificates.lisp new file mode 100644 index 0000000..ca09eda --- /dev/null +++ b/src/gui/server/public-api-gemini-certificates.lisp @@ -0,0 +1,39 @@ +;; 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) + +(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:with-array () + (loop for certificate in (gemini-certificates-payload object) do + (yason:encode-array-element certificate)))))) + +(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)) diff --git a/src/gui/server/public-api-gemini-stream.lisp b/src/gui/server/public-api-gemini-stream.lisp new file mode 100644 index 0000000..af04cb4 --- /dev/null +++ b/src/gui/server/public-api-gemini-stream.lisp @@ -0,0 +1,310 @@ +;; 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) + +(defun complete-net-address (hint) + (let ((prompt (ui:open-url-prompt))) + (funcall (complete:make-complete-gemini-iri-fn prompt) hint))) + +(defun request-success-dispatched-fn (status code-description meta response socket iri parsed-iri) + (declare (ignore iri)) + (multiple-value-bind (actual-iri host path query port fragment) + (gemini-client:displace-iri parsed-iri ) + (gemini-client:debug-gemini "response is a stream") + (labels ((make-text-based-stream (gemini-format-p) + (let* ((starting-status :streaming) + (gemini-stream (make-instance 'gemini-viewer::gemini-file-stream + :host host + :port port + :path path + :query query + :fragment fragment + :meta meta + :status-code status + :status-code-description + code-description + :stream-status starting-status + :download-iri actual-iri + :download-stream response + :download-socket socket)) + (favicon (gemini-viewer::fetch-favicon parsed-iri)) + (thread-fn (gemini-viewer::request-stream-gemini-document-thread gemini-stream + host + port + path + query + fragment + favicon + gemini-format-p))) + (gemini-viewer:push-db-stream gemini-stream) + (gemini-viewer::downloading-start-thread gemini-stream + thread-fn + host + port + path + query + fragment)))) + (cond + ((gemini-client:gemini-file-stream-p meta) + (gemini-client:debug-gemini "response is a gemini document stream") + (gemini-viewer:push-url-to-history *gemini-window* actual-iri) + (make-text-based-stream t) + (make-gemini-response gemini-client:+success+ meta actual-iri)) + ((gemini-client:text-file-stream-p meta) + (gemini-client:debug-gemini "response is a text stream") + (make-text-based-stream nil) + (make-gemini-response gemini-client:+success+ meta actual-iri)) + (t + (let* ((starting-status :streaming) + (gemini-stream (make-instance 'gemini-others-data-stream + :stream-status starting-status + :download-stream response + :download-socket socket)) + (thread-fn (gemini-viewer::request-stream-other-document-thread gemini-stream + socket + host + port + path + query + fragment + status + code-description + meta))) + (gemini-client:debug-gemini "response is *not* a gemini file stream") + (gemini-viewer::downloading-start-thread gemini-stream + thread-fn + host + port + path + query + fragment) + (make-gemini-response gemini-client:+success+ meta actual-iri))))))) + +(defun make-gemini-response (code meta iri &key (cached nil)) + (list (cons "status" (gemini-client:code code)) + (cons "status-description" (gemini-client:description code)) + (cons "meta" meta) + (cons "cached" cached) + (cons "iri" iri))) + +(defun %gemini-request (url &key + (certificate nil) + (certificate-key nil) + (use-cached-file-if-exists nil) + (do-nothing-if-exists-in-db nil)) + (labels ((redirect-dispatch (status code-description meta response socket iri parsed-iri) + (declare (ignore parsed-iri code-description response socket)) + (gemini-client:debug-gemini "response redirect to: ~s" meta) + (make-gemini-response status meta iri)) + (input-dispatch (status code-description meta response socket iri parsed-iri) + (declare (ignore code-description response socket parsed-iri)) + (gemini-client:debug-gemini "response requested input: ~s" meta) + (make-gemini-response status meta iri)) + (sensitive-input-dispatch (status code-description meta response socket iri parsed-iri) + (declare (ignore code-description response socket parsed-iri)) + (gemini-client:debug-gemini "response requested sensitive input: ~s" + meta) + (make-gemini-response status meta iri)) + (certificate-request-dispatch (status + code-description + meta + response + socket iri + parsed-iri) + (declare (ignore status code-description response socket meta parsed-iri)) + (gemini-client:debug-gemini "response requested certificate") + (multiple-value-bind (cached-certificate cached-key) + (gemini-client:fetch-cached-certificate iri) + (%gemini-request iri + :do-nothing-if-exists-in-db do-nothing-if-exists-in-db + :certificate-key cached-key + :certificate cached-certificate)))) + (handler-case + (gemini-client:with-request-dispatch-table ((:certificate-requested + #'certificate-request-dispatch + :input-requested + #'input-dispatch + :sensitive-input-requested + #'sensitive-input-dispatch + :redirect + #'redirect-dispatch + :success + #'request-success-dispatched-fn) + :ignore-warning nil) + (gemini-client:debug-gemini "viewer requesting iri ~s" url) + (let ((actual-iri (gemini-client:displace-iri (iri:iri-parse url)))) + (if use-cached-file-if-exists + (progn + (gemini-client:debug-gemini "checking cache") + (if (gemini-viewer:find-db-stream-url actual-iri) + (progn + (gemini-client:debug-gemini "caching found for ~a" actual-iri) + (gemini-viewer:push-url-to-history *gemini-window* actual-iri) + (make-gemini-response gemini-client:+success+ nil + actual-iri + :cached t)) + (progn + (gemini-client:debug-gemini "caching *not* found for ~a" actual-iri) + (%gemini-request actual-iri + :certificate-key certificate-key + :certificate certificate + :use-cached-file-if-exists nil + :do-nothing-if-exists-in-db + do-nothing-if-exists-in-db)))) + (gemini-client:request-dispatch url + gemini-client::dispatch-table + :certificate certificate + :certificate-key certificate-key)))) + (gemini-client:gemini-tofu-error (e) + (error (format nil "TOFU error: ~a" e))) + (conditions:not-implemented-error (e) + (error (format nil (_ "Error: ~a") e))) + (gemini-client:gemini-protocol-error (e) + (error (format nil "~a" e))) + (error (e) + (error (format nil (_ "Error getting ~s: ~a") url e))) + (condition (c) + (error (format nil (_ "Error getting ~s: ~a") url c)))))) + +(defun gemini-request (iri use-cache) + (%gemini-request iri :use-cached-file-if-exists use-cache)) + +(defgeneric rearrange-for-encoding (object)) + +(defmethod rearrange-for-encoding (object) + object) + +(defmethod rearrange-for-encoding ((object symbol)) + (string-downcase (symbol-name object))) + +(defun rearrange-parsed-line-for-encoding (lines) + (flet ((contains-children-p (node) + (evenp (length node)))) + (loop for line in lines + collect + (let ((flattened (mapcar #'rearrange-for-encoding (a:flatten line)))) + (if (contains-children-p flattened) + (append (list "type") + (subseq flattened 0 (1- (length flattened))) + (list "line" (a:last-elt flattened))) + (cons "type" flattened)))))) + +(defmethod yason:encode ((object gw:gemini-stream) &optional (stream *standard-output*)) + (with-accessors ((stream-status gw:stream-status) + (download-iri gw:download-iri) + (start-time gw:start-time) + (support-file gw:support-file) + (parsed-lines gw:parsed-lines) + (octect-count gw:octect-count) + (port gw:port) + (status-code gw:status-code) + (status-code-description gw:status-code-description) + (meta gw:meta) + (path gw:path) + (query gw:query) + (fragment gw:fragment) + (host gw:host)) object + (let* ((actual-start-time (db-utils:decode-datetime-string start-time)) + (info-alist (list (cons "stream-status" stream-status) + (cons "download-iri" download-iri) + (cons "start-time" actual-start-time) + (cons "support-file" support-file) + (cons "octect-count" octect-count) + (cons "port" port) + (cons "status-code" status-code) + (cons "status-code-description" status-code-description) + (cons "meta" meta) + (cons "path" path) + (cons "query" query) + (cons "fragment" fragment) + (cons "host" host)))) + (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) + (json:with-object () + (loop for ((k . v)) on info-alist do + (json:with-object-element (k) + (json:encode v))))))))) + +(defun gemini-stream-parsed-line (iri line-number) + (let ((stream-wrapper (gw:find-db-stream-url iri))) + (if (null stream-wrapper) + (error "no such stream") + (let ((parsed-lines (gw:parsed-lines stream-wrapper))) + (cond + ((or (not (integerp line-number)) + (< line-number 0)) + (error (format nil + "Line number argument provided is not a positive integer ~a" + line-number))) + ((>= line-number (length parsed-lines)) + (error (format nil + "No parsed line available for line number ~a" + line-number))) + (t + (let ((res (rearrange-parsed-line-for-encoding (list (elt parsed-lines + line-number))))) + (first res)))))))) + +(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) + (yason:*list-encoder* #'yason:encode-plist) + (json:*symbol-key-encoder* #'json:encode-symbol-as-lowercase)) + (yason:with-output (stream) + (json:with-array () + (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) + (let ((stream-wrapper (gw:find-db-stream-url iri))) + (if (null stream-wrapper) + (error "no such stream") + (let ((parsed-lines (gw:parsed-lines stream-wrapper))) + (cond + ((or (not (integerp line-number-start)) + (< line-number-start 0)) + (error (format nil + "Line number index start argument provided is not a positive integer ~a" + line-number-start))) + ((and (integerp line-number-end) + (< line-number-end 0)) + (error (format nil + "Line number index end argument provided is not a positive integer ~a" + line-number-end))) + ((and (integerp line-number-end) + (>= line-number-end (length parsed-lines))) + (error (format nil + "No parsed line available for line number ~a" + line-number-end))) + (t + (let ((res (rearrange-parsed-line-for-encoding (subseq parsed-lines + line-number-start + line-number-end)))) + (make-parsed-lines-slice :payload res)))))))) + +(defun gemini-stream-info (iri) + (let ((stream-wrapper (gw:find-db-stream-url iri))) + (if stream-wrapper + stream-wrapper + (error "no such stream")))) + +(defun gemini-all-stream-info () + gw:*gemini-streams-db*) diff --git a/src/gui/server/public-api-gemini-tour-links.lisp b/src/gui/server/public-api-gemini-tour-links.lisp new file mode 100644 index 0000000..c8080d3 --- /dev/null +++ b/src/gui/server/public-api-gemini-tour-links.lisp @@ -0,0 +1,38 @@ +;; 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) + +(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*)) diff --git a/src/gui/server/public-api.lisp b/src/gui/server/public-api.lisp index 587558f..2dd29f0 100644 --- a/src/gui/server/public-api.lisp +++ b/src/gui/server/public-api.lisp @@ -25,342 +25,6 @@ ,function-symbol (make-rpc-parameters ,@parameters))) -(defun complete-net-address (hint) - (let ((prompt (ui:open-url-prompt))) - (funcall (complete:make-complete-gemini-iri-fn prompt) hint))) - -(defun request-success-dispatched-fn (status code-description meta response socket iri parsed-iri) - (declare (ignore iri)) - (multiple-value-bind (actual-iri host path query port fragment) - (gemini-client:displace-iri parsed-iri ) - (gemini-client:debug-gemini "response is a stream") - (labels ((make-text-based-stream (gemini-format-p) - (let* ((starting-status :streaming) - (gemini-stream (make-instance 'gemini-viewer::gemini-file-stream - :host host - :port port - :path path - :query query - :fragment fragment - :meta meta - :status-code status - :status-code-description - code-description - :stream-status starting-status - :download-iri actual-iri - :download-stream response - :download-socket socket)) - (favicon (gemini-viewer::fetch-favicon parsed-iri)) - (thread-fn (gemini-viewer::request-stream-gemini-document-thread gemini-stream - host - port - path - query - fragment - favicon - gemini-format-p))) - (gemini-viewer:push-db-stream gemini-stream) - (gemini-viewer::downloading-start-thread gemini-stream - thread-fn - host - port - path - query - fragment)))) - (cond - ((gemini-client:gemini-file-stream-p meta) - (gemini-client:debug-gemini "response is a gemini document stream") - (gemini-viewer:push-url-to-history *gemini-window* actual-iri) - (make-text-based-stream t) - (make-gemini-response gemini-client:+success+ meta actual-iri)) - ((gemini-client:text-file-stream-p meta) - (gemini-client:debug-gemini "response is a text stream") - (make-text-based-stream nil) - (make-gemini-response gemini-client:+success+ meta actual-iri)) - (t - (let* ((starting-status :streaming) - (gemini-stream (make-instance 'gemini-others-data-stream - :stream-status starting-status - :download-stream response - :download-socket socket)) - (thread-fn (gemini-viewer::request-stream-other-document-thread gemini-stream - socket - host - port - path - query - fragment - status - code-description - meta))) - (gemini-client:debug-gemini "response is *not* a gemini file stream") - (gemini-viewer::downloading-start-thread gemini-stream - thread-fn - host - port - path - query - fragment) - (make-gemini-response gemini-client:+success+ meta actual-iri))))))) - -(defun make-gemini-response (code meta iri &key (cached nil)) - (list (cons "status" (gemini-client:code code)) - (cons "status-description" (gemini-client:description code)) - (cons "meta" meta) - (cons "cached" cached) - (cons "iri" iri))) - -(defun %gemini-request (url &key - (certificate nil) - (certificate-key nil) - (use-cached-file-if-exists nil) - (do-nothing-if-exists-in-db nil)) - (labels ((redirect-dispatch (status code-description meta response socket iri parsed-iri) - (declare (ignore parsed-iri code-description response socket)) - (gemini-client:debug-gemini "response redirect to: ~s" meta) - (make-gemini-response status meta iri)) - (input-dispatch (status code-description meta response socket iri parsed-iri) - (declare (ignore code-description response socket parsed-iri)) - (gemini-client:debug-gemini "response requested input: ~s" meta) - (make-gemini-response status meta iri)) - (sensitive-input-dispatch (status code-description meta response socket iri parsed-iri) - (declare (ignore code-description response socket parsed-iri)) - (gemini-client:debug-gemini "response requested sensitive input: ~s" - meta) - (make-gemini-response status meta iri)) - (certificate-request-dispatch (status - code-description - meta - response - socket iri - parsed-iri) - (declare (ignore status code-description response socket meta parsed-iri)) - (gemini-client:debug-gemini "response requested certificate") - (multiple-value-bind (cached-certificate cached-key) - (gemini-client:fetch-cached-certificate iri) - (%gemini-request iri - :do-nothing-if-exists-in-db do-nothing-if-exists-in-db - :certificate-key cached-key - :certificate cached-certificate)))) - (handler-case - (gemini-client:with-request-dispatch-table ((:certificate-requested - #'certificate-request-dispatch - :input-requested - #'input-dispatch - :sensitive-input-requested - #'sensitive-input-dispatch - :redirect - #'redirect-dispatch - :success - #'request-success-dispatched-fn) - :ignore-warning nil) - (gemini-client:debug-gemini "viewer requesting iri ~s" url) - (let ((actual-iri (gemini-client:displace-iri (iri:iri-parse url)))) - (if use-cached-file-if-exists - (progn - (gemini-client:debug-gemini "checking cache") - (if (gemini-viewer:find-db-stream-url actual-iri) - (progn - (gemini-client:debug-gemini "caching found for ~a" actual-iri) - (gemini-viewer:push-url-to-history *gemini-window* actual-iri) - (make-gemini-response gemini-client:+success+ nil - actual-iri - :cached t)) - (progn - (gemini-client:debug-gemini "caching *not* found for ~a" actual-iri) - (%gemini-request actual-iri - :certificate-key certificate-key - :certificate certificate - :use-cached-file-if-exists nil - :do-nothing-if-exists-in-db - do-nothing-if-exists-in-db)))) - (gemini-client:request-dispatch url - gemini-client::dispatch-table - :certificate certificate - :certificate-key certificate-key)))) - (gemini-client:gemini-tofu-error (e) - (error (format nil "TOFU error: ~a" e))) - (conditions:not-implemented-error (e) - (error (format nil (_ "Error: ~a") e))) - (gemini-client:gemini-protocol-error (e) - (error (format nil "~a" e))) - (error (e) - (error (format nil (_ "Error getting ~s: ~a") url e))) - (condition (c) - (error (format nil (_ "Error getting ~s: ~a") url c)))))) - -(defun gemini-request (iri use-cache) - (%gemini-request iri :use-cached-file-if-exists use-cache)) - -(defgeneric rearrange-for-encoding (object)) - -(defmethod rearrange-for-encoding (object) - object) - -(defmethod rearrange-for-encoding ((object symbol)) - (string-downcase (symbol-name object))) - -(defun rearrange-parsed-line-for-encoding (lines) - (flet ((contains-children-p (node) - (evenp (length node)))) - (loop for line in lines - collect - (let ((flattened (mapcar #'rearrange-for-encoding (a:flatten line)))) - (if (contains-children-p flattened) - (append (list "type") - (subseq flattened 0 (1- (length flattened))) - (list "line" (a:last-elt flattened))) - (cons "type" flattened)))))) - -(defmethod yason:encode ((object gw:gemini-stream) &optional (stream *standard-output*)) - (with-accessors ((stream-status gw:stream-status) - (download-iri gw:download-iri) - (start-time gw:start-time) - (support-file gw:support-file) - (parsed-lines gw:parsed-lines) - (octect-count gw:octect-count) - (port gw:port) - (status-code gw:status-code) - (status-code-description gw:status-code-description) - (meta gw:meta) - (path gw:path) - (query gw:query) - (fragment gw:fragment) - (host gw:host)) object - (let* ((actual-start-time (db-utils:decode-datetime-string start-time)) - (info-alist (list (cons "stream-status" stream-status) - (cons "download-iri" download-iri) - (cons "start-time" actual-start-time) - (cons "support-file" support-file) - (cons "octect-count" octect-count) - (cons "port" port) - (cons "status-code" status-code) - (cons "status-code-description" status-code-description) - (cons "meta" meta) - (cons "path" path) - (cons "query" query) - (cons "fragment" fragment) - (cons "host" host)))) - (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) - (json:with-object () - (loop for ((k . v)) on info-alist do - (json:with-object-element (k) - (json:encode v))))))))) - -(defun gemini-stream-parsed-line (iri line-number) - (let ((stream-wrapper (gw:find-db-stream-url iri))) - (if (null stream-wrapper) - (error "no such stream") - (let ((parsed-lines (gw:parsed-lines stream-wrapper))) - (cond - ((or (not (integerp line-number)) - (< line-number 0)) - (error (format nil - "Line number argument provided is not a positive integer ~a" - line-number))) - ((>= line-number (length parsed-lines)) - (error (format nil - "No parsed line available for line number ~a" - line-number))) - (t - (let ((res (rearrange-parsed-line-for-encoding (list (elt parsed-lines - line-number))))) - (first res)))))))) - -(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) - (yason:*list-encoder* #'yason:encode-plist) - (json:*symbol-key-encoder* #'json:encode-symbol-as-lowercase)) - (yason:with-output (stream) - (json:with-array () - (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) - (let ((stream-wrapper (gw:find-db-stream-url iri))) - (if (null stream-wrapper) - (error "no such stream") - (let ((parsed-lines (gw:parsed-lines stream-wrapper))) - (cond - ((or (not (integerp line-number-start)) - (< line-number-start 0)) - (error (format nil - "Line number index start argument provided is not a positive integer ~a" - line-number-start))) - ((and (integerp line-number-end) - (< line-number-end 0)) - (error (format nil - "Line number index end argument provided is not a positive integer ~a" - line-number-end))) - ((and (integerp line-number-end) - (>= line-number-end (length parsed-lines))) - (error (format nil - "No parsed line available for line number ~a" - line-number-end))) - (t - (let ((res (rearrange-parsed-line-for-encoding (subseq parsed-lines - line-number-start - line-number-end)))) - (make-parsed-lines-slice :payload res)))))))) - -(defun gemini-stream-info (iri) - (let ((stream-wrapper (gw:find-db-stream-url iri))) - (if stream-wrapper - stream-wrapper - (error "no such stream")))) - -(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:with-array () - (loop for certificate in (gemini-certificates-payload object) do - (yason:encode-array-element certificate)))))) - -(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*)) - (defun quit-program () (fs:clean-temporary-directories) (fs:clean-temporary-files) diff --git a/tinmop.asd b/tinmop.asd index 67ffba2..63a642d 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -149,6 +149,9 @@ (:module gui-server :pathname "gui/server" :components ((:file "main-window-server-side") + (:file "public-api-gemini-stream") + (:file "public-api-gemini-certificates") + (:file "public-api-gemini-tour-links") (:file "public-api") (:file "json-rpc-communication"))) (:module gui-client