client.lisp (7549B)
1 (in-package :cohost.client) 2 3 (defclass cohost-client () 4 ((http-request 5 :initarg :http-request 6 :initform #'drakma:http-request 7 :accessor http-request) 8 (base-uri 9 :initarg :base-uri 10 :initform "https://cohost.org/" 11 :accessor base-uri) 12 (api-path 13 :initarg :api-path 14 :accessor api-path) 15 (cookie-jar 16 :initarg :cookie-jar 17 :initform nil 18 :accessor cookie-jar) 19 (event-thread 20 :initform nil 21 :accessor %event-thread) 22 (end-event-thread 23 :initform nil 24 :accessor %end-event-thread))) 25 26 (defclass chost () 27 ((id 28 :initarg :id 29 :initform nil 30 :accessor post-id) 31 (project 32 :initarg :project 33 :initform nil 34 :accessor project) 35 (adult-content 36 :initarg :adult-content 37 :initform nil 38 :accessor adult-content) 39 (blocks 40 :initarg :blocks 41 :initform nil 42 :accessor content-blocks) 43 (content-warnings 44 :initarg :content-warnings 45 :initform nil 46 :accessor content-warnings) 47 (draft 48 :initarg :draft 49 :initform nil 50 :accessor draft) 51 (headline 52 :initarg :headline 53 :initform nil 54 :accessor headline) 55 (tags 56 :initarg :tags 57 :initform nil 58 :accessor tags) 59 (share-of 60 :initarg :share-of 61 :initform nil 62 :accessor share-of))) 63 64 (defclass content-block () ()) 65 66 (defclass attachment (content-block) 67 ((alt-text 68 :initarg :alt-text 69 :initform nil 70 :accessor alt-text) 71 (attachment-id 72 :initarg :attachment-id 73 :initform nil 74 :accessor attachment-id))) 75 76 (defclass file-attachment (content-block) 77 ((alt-text 78 :initarg :alt-text 79 :initform nil 80 :accessor alt-text) 81 (pathname 82 :initarg :pathname 83 :initform nil 84 :accessor attachment-pathname) 85 (filename 86 :initarg :filename 87 :initform nil 88 :accessor attachment-filename) 89 (content-type 90 :initarg :content-type 91 :initform nil 92 :accessor attachment-content-type))) 93 94 (defclass markdown (content-block) 95 ((content 96 :initarg :content 97 :initform nil 98 :accessor content))) 99 100 (defgeneric init-client (api-ver) 101 (:documentation "Initialize client for given Cohost API version")) 102 103 (defgeneric login (client email password) 104 (:documentation "Log in to Cohost with email and password")) 105 106 (defgeneric login-with-token (client token) 107 (:documentation "Log in with an opaque auth token as returned from LOGIN")) 108 109 (defgeneric new-markdown-block (client content) 110 (:documentation "Create new markdown block for posting") 111 (:method (client content) 112 (make-instance 'markdown :content content))) 113 114 (defgeneric new-attachment (client attachment-id &key alt-text) 115 (:documentation "Create a new existing attachment block") 116 (:method (client attachment-id &key alt-text) 117 (make-instance 'attachment :attachment-id attachment-id 118 :alt-text alt-text))) 119 120 (defgeneric new-file-attachment (client pathname &key alt-text filename content-type) 121 (:documentation "Create new attachment block from PATHNAME") 122 (:method (client pathname &key alt-text filename content-type) 123 (make-instance 'file-attachment :pathname pathname 124 :alt-text alt-text 125 :filename (or filename (file-namestring pathname)) 126 :content-type (or content-type (mimes:mime pathname))))) 127 128 (defgeneric new-post (client project &key id draft adult-content blocks content-warnings headline tags share-of) 129 (:documentation "Create new post object") 130 (:method (client project &key id draft adult-content blocks content-warnings headline tags share-of) 131 (make-instance 'chost :id id 132 :project project 133 :draft draft 134 :adult-content adult-content 135 :share-of share-of 136 :blocks blocks 137 :content-warnings content-warnings 138 :headline headline 139 :tags tags))) 140 141 (defgeneric clone-block (client block) 142 (:documentation "Clone a block object") 143 (:method (client (block attachment)) 144 (new-attachment client (attachment-id block) :alt-text (alt-text block))) 145 (:method (client (block file-attachment)) 146 (new-file-attachment client (attachment-pathname block) 147 :alt-text (alt-text block) 148 :filename (attachment-filename block) 149 :content-type (attachment-content-type block))) 150 (:method (client (block markdown)) 151 (new-markdown-block client (content block)))) 152 153 (defun copy-post (client post) 154 "Clone a post object" 155 (labels ((clone-blocks (blocks) 156 (loop for block in blocks 157 for new-block = (clone-block client block) 158 collect new-block))) 159 (make-instance 'chost :id (post-id post) 160 :project (project post) 161 :draft (draft post) 162 :adult-content (adult-content post) 163 :share-of (share-of post) 164 :blocks (clone-blocks (content-blocks post)) 165 :content-warnings (copy-list (content-warnings post)) 166 :headline (headline post) 167 :tags (copy-list (tags post))))) 168 169 (defgeneric post (client post-obj) 170 (:documentation "Post POST-OBJ, handling uploads for attachments as necessary.")) 171 172 (defun simple-post (client project headline markdown &key share-of adult-content tags content-warnings draft) 173 (post client (new-post client project 174 :headline headline 175 :adult-content adult-content 176 :share-of share-of 177 :draft draft 178 :blocks (list (new-markdown-block client markdown)) 179 :content-warnings content-warnings 180 :tags tags))) 181 182 (defgeneric get-post (client post-id) 183 (:documentation "Fetch POST-ID as a fully populated post object.")) 184 185 (defgeneric get-dash (client) 186 (:documentation "Get the most recent posts from the user's dashboard.")) 187 188 (defgeneric open-event-stream (client) 189 (:documentation "Open the dashboard event stream")) 190 191 (defun attach-event-listener (client listener) 192 "Attach LISTENER to process events on the event stream. This starts a background thread that invokes LISTENER on each new event." 193 (setf (%end-event-thread client) nil) 194 (setf (%event-thread client) 195 (bt:make-thread 196 (lambda () 197 (let ((event-stream (open-event-stream client))) 198 (unwind-protect 199 (loop while (not (%end-event-thread client)) 200 for line = (string-trim '(#\Space #\Newline #\Linefeed) (read-line event-stream nil :eof)) 201 while (not (or (eql line :eof) (string= line ""))) 202 do (funcall listener line)) ; FIXME: parse the JSON here 203 (when (streamp event-stream) 204 (close event-stream))))) 205 :name "Cohost event listener thread"))) 206 207 (defun detach-event-listener (client) 208 "Detach the current event listener and kill the listener thread." 209 (when (and (%event-thread client) (bt:threadp (%event-thread client)) (bt:thread-alive-p (%event-thread client))) 210 (setf (%end-event-thread client) t) 211 (bt:join-thread (%event-thread client))) 212 (setf (%end-event-thread client) nil) 213 (setf (%event-thread client) nil))