Add: initial flash function; modified endpoints to use it

This is untested. Just commiting to share.

1 files changed, 41 insertions, 0 deletions

diff --git a/flash.lisp b/flash.lisp
new file mode 100644
index 0000000..27a6c31
--- /dev/null
+++ b/flash.lisp
@@ -0,0 +1,41 @@
+;;;; flash.lisp -- communicating between page loads
+
+(in-package :dnd)
+
+(defvar *flashes*
+  (make-hash-table :test #'equal :synchronized t))
+
+(defparameter +flash-cookie-name+ "DNDFLASHKEY")
+(defparameter +flash-value-lifetime+ 10
+  "Number of seconds a flashed value lives.")
+
+
+(defun flash (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))
+    (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)))
+
+(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."
+  (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))))
+