From 20089be386bdeac66a0e9b2211215fd45d61932b Mon Sep 17 00:00:00 2001
From: saturn <saturn@glxl.net>
Date: Tue, 21 May 2024 03:49:08 -0500
Subject: [PATCH] Add initial support for /collaborateOnPost links.

---
 lw2.lisp         | 19 +++++++++++++++++++
 src/backend.lisp |  4 +++-
 2 files changed, 22 insertions(+), 1 deletion(-)

diff --git a/lw2.lisp b/lw2.lisp
index fda79c16..e01232cc 100644
--- a/lw2.lisp
+++ b/lw2.lisp
@@ -1282,6 +1282,25 @@
    (:post ()
 	  (post-comment :post-id post-id :need-auth need-auth))))
 
+(define-page view-collaborate-on-post "/collaborateOnPost" ()
+  (request-method
+   (:get ()
+    (let* ((post-id (hunchentoot:get-parameter "postId"))
+	   (key (hunchentoot:get-parameter "key"))
+	   ;; Make sure key is alphanumeric
+	   (key (and key (ppcre:scan "^[a-zA-Z0-9]*$" key)
+		     key))
+	   (*graphql-uri-hook* (lambda (uri)
+				 (if key
+				     (concatenate 'string uri "?key=" key)
+				     uri)))
+	   (post (lw2-graphql-query (lw2-query-string :post :single (alist :document-id post-id) :context :body)
+				    :auth-token *current-auth-token*))
+	   (title (cdr (assoc :title post))))
+      (emit-page (out-stream :title title
+			     :content-class "post-page comment-thread-page no-comments")
+		 (post-body-to-html post))))))
+
 (defparameter *edit-post-template* (compile-template* "edit-post.html"))
 
 (define-page view-edit-post "/edit-post" (title url section tags post-id link-post)
diff --git a/src/backend.lisp b/src/backend.lisp
index b38b0140..6151173f 100644
--- a/src/backend.lisp
+++ b/src/backend.lisp
@@ -6,6 +6,7 @@
   (:import-from #:lw2.user-context #:*current-auth-token*)
   (:reexport #:lw2.backend-modules)
   (:export #:*use-alignment-forum*
+	   #:*graphql-uri-hook*
 	   #:*graphql-debug-output*
 	   #:*revalidate-default* #:*force-revalidate-default*
            #:*messages-index-fields*
@@ -54,6 +55,7 @@
       dex:*use-connection-pool* nil)
 
 (defvar *use-alignment-forum* nil)
+(defvar *graphql-uri-hook* #'identity)
 
 (defvar *graphql-debug-output* nil)
 
@@ -346,7 +348,7 @@
   (backend-graphql
    (call-with-http-response
     fn
-    (graphql-uri *current-backend*)
+    (funcall *graphql-uri-hook* (graphql-uri *current-backend*))
     :method :post
     :headers (backend-request-headers auth-token nil)
     :content (dynamic-let ((q (alist :query query))) (json:encode-json-to-string q))
-- 
2.11.4.GIT