From fffea1715cfb51837cd990adf881443df9ccb74b Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Wed, 25 Jan 2023 21:17:11 -0800
Subject: Modify: flash feature to be more robust; add labels

---
 dnd.asd        |  1 +
 endpoints.lisp |  4 ++--
 flash.lisp     | 55 +++++++++++++++++++++++++++++++++++++------------------
 3 files changed, 40 insertions(+), 20 deletions(-)

diff --git a/dnd.asd b/dnd.asd
index bd4c74b..f440080 100644
--- a/dnd.asd
+++ b/dnd.asd
@@ -23,6 +23,7 @@
                (:file "utilities")
                (:file "init")
                (:file "model")
+               (:file "flash")
                (:file "endpoints")
                (:file "pages")
 	       (:file "transactions")
diff --git a/endpoints.lisp b/endpoints.lisp
index ff6f97c..06a521f 100644
--- a/endpoints.lisp
+++ b/endpoints.lisp
@@ -39,7 +39,7 @@ I.e. It should be called within the scope of a request handler."
   (redirect-to "/tavern-door"))
 
 (defendpoint* :get "/tavern-door" () ()
-  (a:if-let (name (flashed-value))
+  (a:if-let (name (flashed-value :tavern-door))
     (doorkeeper :message (format nil "M'fraid I've n'er 'eard o' ~a." name))
     (doorkeeper)))
 
@@ -51,7 +51,7 @@ I.e. It should be called within the scope of a request handler."
 				 :path "/" :domain "localhost")  ; TODO: generalize domain
 	(redirect-to "/tavern"))
       (progn
-        (flash name)
+        (flash :tavern-door name)
         (redirect-to (format nil "/tavern-door"))))))
 
 (defendpoint* :get "/godess-shrine" () ()
diff --git a/flash.lisp b/flash.lisp
index 27a6c31..09818b0 100644
--- a/flash.lisp
+++ b/flash.lisp
@@ -9,33 +9,52 @@
 (defparameter +flash-value-lifetime+ 10
   "Number of seconds a flashed value lives.")
 
+(defstruct flash-entry
+  (timestamp (get-universal-time))
+  (table nil))
 
-(defun flash (value)
+(defun flash-entry-alive-p (entry)
+  "Returns T if ENTRY has not expired."
+  (<= (get-universal-time)
+      (+ (flash-entry-timestamp entry) +flash-value-lifetime+)))
+
+(defun flash (label value)
   "A flash is a one-time inter-request value. Once stored, it can only
 be retrieved once. And if not retrieved in a short period of time, it
 expires."
-  (let ((key (nuid))
-        (now (get-universal-time)))
-    (setf (gethash key *flashes*) (cons value now))
+  (check-type label keyword)
+  (let* ((key
+           (or (lzb:request-cookie +flash-cookie-name+) (nuid)))
+         (now
+           (get-universal-time))
+         (entry
+           (gethash key *flashes* (make-flash-entry))))
+    ;; update the entry
+    (setf (flash-entry-timestamp entry) now
+          (getf (flash-entry-table entry) label) value
+          (gethash key *flashes*) entry)
+    ;; set the cookie, updating its expiration if necessary 
     (lzb:set-response-cookie
      +flash-cookie-name+ key
      ;; TODO: generalize domain
      :path "/" :domain "localhost" 
-     :expires (+ +flash-value-lifetime+ now))  
-    key))
-
-(defun flashed-value-alive-p (val)
-  (<= (+ (cdr val) +flash-value-lifetime+)
-      (get-universal-time)))
+     :expires (+ +flash-value-lifetime+ now))))
 
-(defun flashed-value ()
-  "Retrieves the value flashed in this request, if it exists, and
-returns it.  
 
-Removes the flashed value from the hash table if it was found."
+(defun flashed-value (label)
+  "Retrieves and deletes the flashed value with label LABEL associated
+with this request. If the value exists, return it. Otherwise return
+NIL."
   (a:when-let* ((key (lzb:request-cookie +flash-cookie-name+))
-                (val (gethash key *flashes*)))
-    (remhash key *flashes*)
-    (when (flashed-value-alive-p val)
-      (car val))))
+                (entry (gethash key *flashes*)))
+    (cond
+      ((flash-entry-alive-p entry)
+       (let ((val (getf (flash-entry-table entry) label)))
+         ;; can only retrieve once
+         (remf (flash-entry-table entry) label)
+         val))
+      (t
+       ;; drop expired entries and return nil
+       (remhash key *flashes*)
+       nil))))
 
-- 
cgit v1.2.3