cohost

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:
M
src/client-v1-impl.lisp
 | 
25
++++++++++++++++++++++++-
M
src/client.lisp
 | 
3
+++
M
src/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))