summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--dnd.asd1
-rw-r--r--endpoints.lisp4
-rw-r--r--flash.lisp55
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))))