;;;; flash.lisp -- communicating between page loads

(in-package :dnd)

(defvar *flashes*
  (make-hash-table :test #'equal :synchronized t))
(defvar *flash-lock*
  (bt:make-lock "flash lock"))

(defparameter +flash-cookie-name+ "DNDFLASHKEY")
(defparameter +flash-value-lifetime+ 10
  "Number of seconds a flashed value lives.")

(defstruct flash-entry
  "TABLE is a PLIST"
  (timestamp (get-universal-time))
  (table nil))

(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."
  (check-type label keyword)
  (let* ((key
           (or (lzb:request-cookie +flash-cookie-name+) (nuid)))
         (now
           (get-universal-time)))
    ;; holding a lock here b/c I do stuff in between getting an entry
    ;; and writing to it.
    (bt:with-lock-held (*flash-lock*)
      (let ((entry
              (or (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))))


(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."
  (bt:with-lock-held (*flash-lock*) 
    (a:when-let* ((key (lzb:request-cookie +flash-cookie-name+))
                  (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)
           ;; might as well delete the entry if its table is empty.
           (when (null (flash-entry-table entry))
             (remhash key *flashes*))
           val))
        (t
         ;; drop expired entries and return nil
         (remhash key *flashes*)
         nil)))))