From 8b428c172da7bb7c8f12aa2025a820b2d3dfce51 Mon Sep 17 00:00:00 2001
From: saturn <saturn@glxl.net>
Date: Wed, 16 Mar 2022 22:37:15 -0500
Subject: [PATCH] Add initial support for posts only visible to logged-in
 users.

---
 src/backend.lisp    | 19 +++++++++++++++----
 src/conditions.lisp |  5 ++++-
 2 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/src/backend.lisp b/src/backend.lisp
index 838b11c7..d712d86c 100644
--- a/src/backend.lisp
+++ b/src/backend.lisp
@@ -2,6 +2,7 @@
   (:use #:cl #:sb-thread #:flexi-streams #:alexandria #:iterate #:lw2-viewer.config #:lw2.sites #:lw2.context #:lw2.graphql #:lw2.lmdb
 	#:lw2.utils #:lw2.hash-utils #:lw2.backend-modules #:lw2.schema-type #:lw2.conditions #:lw2.web-push)
   (:import-from #:collectors #:with-collector)
+  (:import-from #:lw2.user-context #:*current-auth-token*)
   (:reexport #:lw2.backend-modules)
   (:export #:*use-alignment-forum*
 	   #:*graphql-debug-output*
@@ -197,6 +198,7 @@
                (cond
                  ((search "document_not_found" message) (error 'lw2-not-found-error))
                  ((search "app.missing_document" message) (error 'lw2-not-found-error))
+		 ((search "only visible to logged-in users" message) (error 'lw2-login-required-error))
                  ((search "not_allowed" message) (error 'lw2-not-allowed-error))
                  (t (error 'lw2-unknown-error :message message)))))))
 
@@ -621,9 +623,18 @@
 (define-backend-function get-post-body (post-id &key (revalidate *revalidate-default*) (force-revalidate *force-revalidate-default*) auth-token)
   (backend-graphql
    (let ((query-string (lw2-query-string :post :single (alist :document-id post-id) :context :body)))
-     (if auth-token
-	 (lw2-graphql-query query-string :auth-token auth-token)
-	 (lw2-graphql-query-timeout-cached query-string "post-body-json" post-id :revalidate revalidate :force-revalidate force-revalidate))))
+     (block nil
+       (tagbody retry
+	  (handler-bind ((lw2-login-required-error (lambda (&rest args)
+						     (declare (ignore args))
+						     (let ((current-auth-token *current-auth-token*))
+						       (when (and (not auth-token) current-auth-token)
+							 (setf auth-token current-auth-token)
+							 (go retry))))))
+	    (return
+	      (if auth-token
+		  (lw2-graphql-query query-string :auth-token auth-token)
+		  (lw2-graphql-query-timeout-cached query-string "post-body-json" post-id :revalidate revalidate :force-revalidate force-revalidate))))))))
   (backend-lw2-tags
    (declare (ignore auth-token))
    (acons :tags (get-post-tags post-id :revalidate revalidate :force-revalidate force-revalidate) (call-next-method))))
@@ -926,7 +937,7 @@
       (trivia:ematch (lw2-graphql-query (lw2-query-string target-type :single
 							  (alist :document-id id)
 							  :fields '(:html-body (:contents :markdown)))
-					:auth-token lw2.user-context:*current-auth-token*)
+					:auth-token *current-auth-token*)
 		     ((trivia:alist (:html-body . html-body)
 				    (:contents . (assoc :markdown markdown)))
 		      (cache-put db-name id (alist :version (base64:usb8-array-to-base64-string (hash-string html-body)) :markdown markdown) :value-type :lisp)
diff --git a/src/conditions.lisp b/src/conditions.lisp
index 6afd8b42..9276459b 100644
--- a/src/conditions.lisp
+++ b/src/conditions.lisp
@@ -7,7 +7,7 @@
 	   #:error-to-html
            #:lw2-error
 	   #:csrf-check-failed
-	   #:lw2-client-error #:lw2-not-found-error #:lw2-user-not-found-error #:lw2-not-allowed-error #:lw2-server-error #:lw2-connection-error #:lw2-unknown-error
+	   #:lw2-client-error #:lw2-not-found-error #:lw2-user-not-found-error #:lw2-not-allowed-error #:lw2-login-required-error #:lw2-server-error #:lw2-connection-error #:lw2-unknown-error
 	   #:html-output-stream-error-p
 	   #:log-condition #:log-conditions
 	   #:log-and-ignore-errors)
@@ -65,6 +65,9 @@
 (define-condition lw2-not-allowed-error (lw2-client-error) ((http-return-code :allocation :class :initform 403))
   (:report "LW server reports: not allowed."))
 
+(define-condition lw2-login-required-error (lw2-client-error) ((http-return-code :allocation :class :initform 403))
+  (:report "This document is only visible to logged-in users."))
+
 (define-condition lw2-server-error (lw2-error)
   ((message :initarg :message :reader lw2-server-error-message)
    (introduction :allocation :class :reader condition-introduction))
-- 
2.11.4.GIT