summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcolin <colin@cicadas.surf>2023-01-25 18:26:18 -0800
committercolin <colin@cicadas.surf>2023-01-25 18:26:18 -0800
commitb4cd3bb5cba1551ee85b66716deb2f26722b1ef8 (patch)
tree55b1c9ac3c34263ca76d07d9870a890260de4027
parent59ae4f81e108eef2a1997f42f5b210e79e3d328a (diff)
Add: initial flash function; modified endpoints to use it
This is untested. Just commiting to share.
-rw-r--r--endpoints.lisp13
-rw-r--r--flash.lisp41
2 files changed, 49 insertions, 5 deletions
diff --git a/endpoints.lisp b/endpoints.lisp
index e947562..ff6f97c 100644
--- a/endpoints.lisp
+++ b/endpoints.lisp
@@ -38,18 +38,21 @@ I.e. It should be called within the scope of a request handler."
(defendpoint* :get "/" () ()
(redirect-to "/tavern-door"))
-(defendpoint* :get "/tavern-door" ((name str)) ()
- (if name (doorkeeper :message (format nil "M'fraid I've n'er 'eard o' ~a." name))
- (doorkeeper)))
+(defendpoint* :get "/tavern-door" () ()
+ (a:if-let (name (flashed-value))
+ (doorkeeper :message (format nil "M'fraid I've n'er 'eard o' ~a." name))
+ (doorkeeper)))
(defendpoint* :post "/tavern-door" () ()
(with-plist ((name :name)) (lzb:request-body)
(a:if-let ((hero (hero-known-as name)))
(a:when-let ((sesh (new-sesh hero)))
(lzb:set-response-cookie +session-cookie-name+ (session-id sesh)
- :path "/" :domain "localhost")
+ :path "/" :domain "localhost") ; TODO: generalize domain
(redirect-to "/tavern"))
- (redirect-to (format nil "/tavern-door?name=~a" (quri:url-encode name))))))
+ (progn
+ (flash name)
+ (redirect-to (format nil "/tavern-door"))))))
(defendpoint* :get "/godess-shrine" () ()
(godess-shrine))
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))))
+