cohost

Unofficial Common Lisp client library for Cohost
git clone https://todayiwilllaunchmyinfantsonintoorbit.com/cohost.git
Log | Files | Refs | LICENSE

commit 971041e188093edbc8a54adc3f1ab45a81e7c28b
parent 8b8d6cd20634208b9a466306110f77509805c2b3
Author: Decay <decay@todayiwilllaunchmyinfantsonintoorbit.com>
Date:   Tue,  7 Feb 2023 22:58:58 -0800

Implement LOGIN-WITH-TOKEN and update exported functions

LOGIN now returns an opaque token that can be used to reauth with LOGIN-WITH-TOKEN

Diffstat:
Msrc/client-v1-impl.lisp | 25++++++++++++++++++++++++-
Msrc/client.lisp | 3+++
Msrc/packages.lisp | 26++++++++++++++------------
3 files changed, 41 insertions(+), 13 deletions(-)

diff --git a/src/client-v1-impl.lisp b/src/client-v1-impl.lisp @@ -11,6 +11,23 @@ (defun %login (client email client-hash) (cohost-rpc client "login" :post :email email :client-hash client-hash)) +(defun serialize-connect-token (cookie-jar) + (let ((cookie (find-if (lambda (cookie) (string= (drakma:cookie-name cookie) "connect.sid")) + (drakma:cookie-jar-cookies cookie-jar)))) + (format nil "~a;~a" (drakma:cookie-value cookie) (drakma:cookie-expires cookie)))) + +(defun deserialize-connect-token (token) + (let* ((split-pos (position #\; token)) + (value (subseq token 0 split-pos)) + (expiration (parse-integer (subseq token (1+ split-pos))))) + (make-instance 'drakma:cookie + :name "connect.sid" + :value value + :expires expiration + :domain "cohost.org" + :securep t + :http-only-p t))) + (defmethod login ((client cohost-client-v1) email password) (labels ((pad-base64 (salt) (format nil "~A~v@{~A~:*~}" salt (mod (length salt) 4) #\.)) @@ -25,7 +42,13 @@ 128))) (let* ((salt (%salt client email)) (client-hash (usb8-array-to-base64-string (derive-client-hash password salt)))) - (%login client email client-hash)))) + (%login client email client-hash) + (serialize-connect-token (cookie-jar client))))) + +(defmethod login-with-token ((client cohost-client-v1) token) + (let ((cookie (deserialize-connect-token token))) + (setf (cookie-jar client) + (make-instance 'drakma:cookie-jar :cookies (list cookie))))) (defgeneric encode-block (block) (:method ((block attachment)) diff --git a/src/client.lisp b/src/client.lisp @@ -103,6 +103,9 @@ (defgeneric login (client email password) (:documentation "Log in to Cohost with email and password")) +(defgeneric login-with-token (client token) + (:documentation "Log in with an opaque auth token as returned from LOGIN")) + (defgeneric new-markdown-block (client content) (:documentation "Create new markdown block for posting") (:method (client content) diff --git a/src/packages.lisp b/src/packages.lisp @@ -9,12 +9,12 @@ (defpackage cohost.client (:use :cl :cohost.util) - (:export #:cohost-client #:init-client #:base-uri #:api-path #:login #:http-request #:cookie-jar - #:new-post #:adult-content #:content-blocks #:content-warnings #:headline #:tags - #:attachment #:file-attachment #:markdown #:alt-text #:attachment-id #:pathname - #:filename #:content-type #:content #:copy-post #:clone-block #:get-post #:get-dash - #:attachment-pathname #:attachment-filename #:attachment-content-type - #:new-markdown-block #:new-attachment #:new-file-attachment + (:export #:cohost-client #:init-client #:base-uri #:api-path #:login #:login-with-token + #:http-request #:cookie-jar #:new-post #:adult-content #:content-blocks + #:content-warnings #:headline #:tags #:attachment #:file-attachment #:markdown + #:alt-text #:attachment-id #:pathname #:filename #:content-type #:content #:copy-post + #:clone-block #:get-post #:get-dash #:attachment-pathname #:attachment-filename + #:attachment-content-type #:new-markdown-block #:new-attachment #:new-file-attachment #:project #:draft #:share-of #:post #:simple-post #:post-id #:%event-stream #:open-event-stream)) @@ -35,17 +35,19 @@ (defpackage cohost (:use :cl) - (:import-from :cohost.client #:base-uri #:login #:simple-post #:new-post #:new-attachment - #:new-file-attachment #:new-markdown-block + (:import-from :cohost.client #:base-uri #:login #:login-with-token #:simple-post #:new-post + #:new-attachment #:new-file-attachment #:new-markdown-block #:copy-post #:post #:post-id #:project #:adult-content #:content-blocks #:content-warnings #:draft #:headline #:tags #:share-of #:alt-text #:attachment-id #:attachment-pathname - #:attachment-filename #:attachment-content-type #:content) - (:export #:init-client #:base-uri #:login #:simple-post #:new-post #:new-attachment - #:new-file-attachment #:new-markdown-block + #:attachment-filename #:attachment-content-type #:content + #:get-post #:get-dash) + (:export #:init-client #:base-uri #:login #:login-with-token #:simple-post #:new-post + #:new-attachment #:new-file-attachment #:new-markdown-block #:copy-post #:post #:post-id #:project #:adult-content #:content-blocks #:content-warnings #:draft #:headline #:tags #:share-of #:alt-text #:attachment-id #:attachment-pathname - #:attachment-filename #:attachment-content-type #:content)) + #:attachment-filename #:attachment-content-type #:content + #:get-post #:get-dash))