commit 30a099eda0fc01f9db4bd2753daaf9edd9dd5667
parent 6c613089306ad2d4e59534d7415c3bd9fd13a856
Author: Decay <decay@todayiwilllaunchmyinfantsonintoorbit.com>
Date: Tue, 14 Feb 2023 21:16:15 -0800
Major improvements
LOGIN, LOGIN-WITH-TOKEN, GET-POST and GET-DASH now have reasonable
return values and stabilized interfaces, see README for more information
Diffstat:
5 files changed, 55 insertions(+), 18 deletions(-)
diff --git a/README.markdown b/README.markdown
@@ -47,7 +47,7 @@ Login with the token returned from an earlier LOGIN:
```
CL-USER> (cohost:login-with-token *cohost* "foo")
-#<DRAKMA:COOKIE-JAR (with 1 cookie) {1004380433}>
+"someupdatedlogintoken"
```
Create a simple post:
@@ -103,9 +103,11 @@ All boolean values are [generalized booleans](http://clhs.lisp.se/Body/26_glo_g.
* EMAIL - String email address
* PASSWORD - String password
- **Returns**: An opaque string authentication token that can be passed to LOGIN-WITH-TOKEN for later sessions.
+ **Returns**: On success, an opaque string authentication token that can be passed to LOGIN-WITH-TOKEN for later sessions. On failure, NIL.
**Side Effects**: Logs the CLIENT into Cohost.
+
+ **Notes**: Currently does not distinguish incorrect credentials from any other failure mode. If a token is returned, however, you can be sure that the login was successful and the client is ready for further calls. See LOGIN-WITH-TOKEN for details about the auth token and expirations.
* `(LOGIN-WITH-TOKEN CLIENT TOKEN)` - Login with authentication token
@@ -113,10 +115,12 @@ All boolean values are [generalized booleans](http://clhs.lisp.se/Body/26_glo_g.
* CLIENT - Initialized client object
* TOKEN - An opaque authentication token returned from a previous call to LOGIN.
-
+
+ **Returns**: On success, an updated authentication token with refreshed expiration. On failure, NIL.
+
**Side Effects**: Logs the CLIENT into Cohost.
- **Notes**: Token expiration is hardwired into the token (which is currently just the contents of the "connect.sid" cookie) so it will expire eventually; logins via either LOGIN or LOGIN-WITH-TOKEN can expire at any time, including in the middle of a session. LOGIN-WITH-TOKEN currently doesn't do any verification that the token is not expired.
+ **Notes**: Token expiration is hardwired into the token (which is currently just the contents of the "connect.sid" cookie) so it will expire eventually; logins via either LOGIN or LOGIN-WITH-TOKEN can expire at any time, including in the middle of a session. LOGIN-WITH-TOKEN will verify that the token was valid and that the client is correctly logged in; on success, it will return the updated auth token with a new expiration time, so this can also be used to refresh an active login (as can any other Cohost API call at present, since they will all implicitly update the auth cookie).
### Post creation/manipulation
@@ -246,8 +250,6 @@ All boolean values are [generalized booleans](http://clhs.lisp.se/Body/26_glo_g.
### Getters
-**WARNING**: All of these are very preliminary, rely on awkward hacks and do not yet return structured CLOS objects but just deserialized JSON as alists, as explained above. Everything below here can and will change at any time, in any way you can think of. **If you call any of these, anything can happen up to and including making your computer shoot out chains and demons like Hellraiser. Caveat utilitor!**
-
* `(GET-POST CLIENT POST-ID)` - Get the content of a single post by ID
**Parameters**
@@ -255,7 +257,7 @@ All boolean values are [generalized booleans](http://clhs.lisp.se/Body/26_glo_g.
* CLIENT - Logged-in client object
* POST-ID - ID of the post to fetch.
- **Returns**: Deserialized JSON representing the bare Cohost API response; all object keys are keywords translated from camel-case JS names as described in [the CL-JSON documentation](https://cl-json.common-lisp.dev/cl-json.html#CAMEL-CASE-TRANSLATION).
+ **Returns**: A fully-hydrated CHOST object as described above.
**Notes**: As the Cohost API does not yet provide a convenient way to fetch a single post with just the ID, this is a two-step process that calls project\_post to get the associated project name and then calls tRPC posts.single\_post, so it requires two round-trips per post.
@@ -265,7 +267,7 @@ All boolean values are [generalized booleans](http://clhs.lisp.se/Body/26_glo_g.
* CLIENT - Logged-in client object
- **Returns**: Deserialized JSON representing the bare Cohost API response; all object keys are keywords translated from camel-case JS names as described in [the CL-JSON documentation](https://cl-json.common-lisp.dev/cl-json.html#CAMEL-CASE-TRANSLATION).
+ **Returns**: A list of fully-hydrated CHOST objects representing the posts present on the user's dash at the time of execution.
**Notes**: There's no API call for this so it actually peels the JSON output out of a full page load of the cohost dashboard; expect a lot more data transfer than would be normal if this was just a JSON API response (around 60k by my tests).
diff --git a/src/client-v1-impl.lisp b/src/client-v1-impl.lisp
@@ -42,13 +42,21 @@
128)))
(let* ((salt (%salt client email))
(client-hash (usb8-array-to-base64-string (derive-client-hash password salt))))
- (%login client email client-hash)
- (serialize-connect-token (cookie-jar client)))))
+ (multiple-value-bind (json http-code)
+ (%login client email client-hash)
+ (when (eql http-code 200)
+ (serialize-connect-token (cookie-jar client)))))))
+
+(defun logged-in-p (client)
+ (let ((result (assoc-val :result (car (cohost-trpc-batch client (list (login.logged-in)))))))
+ (assoc-val :logged-in (assoc-val :data result))))
(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)))))
+ (make-instance 'drakma:cookie-jar :cookies (list cookie)))
+ (when (logged-in-p client)
+ (serialize-connect-token (cookie-jar client)))))
(defgeneric encode-block (block)
(:method ((block attachment))
@@ -162,6 +170,25 @@
new-post))
(t (values post-obj post-response)))))
+(defun json->block (client block-json)
+ (case (make-keyword (assoc-val :type block-json))
+ (:attachment (new-attachment client (assoc-val :attachment-id block-json)
+ :alt-text (assoc-val :alt-text block-json)))
+ (:markdown (new-markdown-block client
+ (assoc-val :content (assoc-val :markdown block-json))))))
+
+(defun json->post (client post-json)
+ (new-post client (assoc-val :handle (assoc-val :posting-project post-json))
+ :share-of (assoc-val :share-of-post-id post-json)
+ :tags (assoc-val :tags post-json)
+ :headline (assoc-val :headline post-json)
+ :content-warnings (assoc-val :cws post-json)
+ :adult-content (assoc-val :effective-adult-content post-json)
+ :draft (eql (assoc-val :state post-json) 0)
+ :id (assoc-val :post-id post-json)
+ :blocks (loop for block in (assoc-val :blocks post-json)
+ collect (json->block client block))))
+
(defmethod get-post ((client cohost-client-v1) post-id)
(let* ((post-response (cohost-rpc client (format nil "/project_post/~a" post-id) :get))
(post-id (assoc-val :post-id post-response))
@@ -173,7 +200,7 @@
(project (when project-href (subseq project-href 16)))
(full-post-response (when (and post-id project) (cohost-trpc-batch client (list (posts.single-post project post-id))))))
(when full-post-response
- full-post-response)))
+ (json->post client (assoc-val :post (assoc-val :data (assoc-val :result (car full-post-response))))))))
;;; FIXME: This is awful! We scrape the loaded JSON off the front page, which also means
;;; loading 60-some k of HTML. This needs to be replaced with something less shit ass as
@@ -187,17 +214,17 @@
;; Only try to parse out the posts if we actually got the expected result
(when (and (plump:fulltext-element-p json-entity)
(string= (string-downcase (plump:tag-name json-entity)) "script"))
- (json:decode-json-from-string (plump:text json-entity)))))
+ (let ((dash-json (json:decode-json-from-string (plump:text json-entity))))
+ (loop for post in (assoc-val :posts (assoc-val :dashboard dash-json))
+ collect (json->post client post))))))
;;; Event stream methods
-
(defmethod open-event-stream ((client cohost-client-v1))
(funcall (http-request client)
(concatenate 'string (base-uri client) "rc/dashboard/event-stream")
:cookie-jar (cookie-jar client) :accept "text/event-stream" :want-stream t))
;;; tRPC primitive queries
-
(define-trpc-request "projects.listEditedProjects" ())
(define-trpc-request "projects.followingState" ("projectHandle"))
(define-trpc-request "login.loggedIn" ())
diff --git a/src/packages.lisp b/src/packages.lisp
@@ -1,6 +1,6 @@
(defpackage cohost.util
(:use :cl)
- (:export #:sym->str #:strcat #:-> #:->>
+ (:export #:make-keyword #:sym->str #:strcat #:-> #:->>
#:encode-json-boolean #:encode-json-array #:sassoc #:assoc-val #:lisp-to-cdn-case))
(defpackage cohost.file
@@ -27,7 +27,7 @@
#:define-trpc-request))
(defpackage cohost.client-v1-impl
- (:use :cl :cohost.client :cohost.util :cohost.file)
+ (:use :cl :cohost.util :cohost.client :cohost.file)
(:import-from :cohost.rpc #:cohost-rpc #:cohost-json-rpc #:cohost-trpc-batch #:define-trpc-request)
(:import-from :babel #:string-to-octets)
(:import-from :base64 #:base64-string-to-usb8-array #:usb8-array-to-base64-string)
diff --git a/src/util.lisp b/src/util.lisp
@@ -1,5 +1,8 @@
(in-package :cohost.util)
+(defun make-keyword (str)
+ (intern (string-upcase str) 'keyword))
+
(defun sym->str (sym)
(json:lisp-to-camel-case (symbol-name sym)))
diff --git a/tests/main.lisp b/tests/main.lisp
@@ -40,7 +40,12 @@
:domain "cohost.org"
:securep t
:http-only-p t)))
- (json:encode-json-plist-to-string `(:user-id ,+test-user-id+ :email ,+test-email+))))
+ (values (json:encode-json-plist-to-string `(:user-id ,+test-user-id+ :email ,+test-email+)) 200)))
+ ;; login state
+ ((and (string= uri "https://cohost.org/api/v1/trpc/login.loggedIn")
+ (string= (assoc-val "batch" parameters) "1")
+ (eql method :get))
+ (json:encode-json-to-string '(((:result (:data (:logged-in . t)))))))
;; Failed login
((and (string= uri "https://cohost.org/api/v1/login")
(eql method :post))
