diff options
| -rw-r--r-- | dnd.asd | 1 | ||||
| -rw-r--r-- | endpoints.lisp | 4 | ||||
| -rw-r--r-- | flash.lisp | 55 |
3 files changed, 40 insertions, 20 deletions
@@ -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" () () @@ -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)))) |