session, cookies, woo...

cookies/package.lisp

@@ -0,0 +1,14 @@
+(defpackage #:wst.cookies
+  (:use #:cl)
+  (:export
+   #:initialize-session
+   #:recover-session
+   #:terminate-session
+   #:update-session))
+
+(in-package :wst.cookies)
+
+(defgeneric initialize-session (driver data &key &allow-other-keys))
+(defgeneric recover-session (driver session-id &key &allow-other-keys))
+(defgeneric terminate-session (driver session &key &allow-other-keys))
+(defgeneric update-session (driver session &key &allow-other-keys))

routing/responses.lisp

@@ -1,16 +1,16 @@
 (in-package :wst.routing)
 
 (defun write-response (response
-		       &key
-			 content
-			 status
-			 headers
-			 (content-type "text/html"))
+                       &key
+                         content
+                         status
+                         headers
+                         (content-type "text/html"))
   (setf (response-status response) status
-	(response-headers response) (append (response-headers response)
-					    (list :content-type content-type)
-					    headers)
-	(response-content response) content)
+        (response-headers response) (append (response-headers response)
+                                            (list :content-type content-type)
+                                            headers)
+        (response-content response) content)
   response)
 
 (defun default-internal-server-error-resounse (response)
@@ -22,12 +22,13 @@
   (:method ((ty t) response &key headers content)
     (write-response response :status 200 :headers headers :content content)))
 
-(defgeneric internal-server-error-response (ty response &key headers)
+(defgeneric internal-server-error-response (ty response &key headers content)
   (:documentation "Build a response for a type TY (:json, :html, t = html).
  CONTENT is any object that is serialized accourding to the type.")
-  (:method ((ty t) response &key headers)
-    (declare (ignorable headers))
-    (default-internal-server-error-resounse response)))
+  (:method ((ty t) response &key headers content)
+    (if content
+        (write-response response :status 500 :content content :headers headers)
+        (default-internal-server-error-resounse response))))
 
 (defgeneric not-found-response (ty response &key)
   (:documentation "Build a response for a type TY (:json, :html, t = html).
@@ -58,7 +59,7 @@
  CONTENT is any object that is serialized accourding to the type.")
   (:method ((ty t) response location &key)
     (write-response response :status 303 :content "see-other"
-			     :headers (list :location location))))
+                             :headers (list :location location))))
 
 (defgeneric unprocessable-entity (ty response &key)
   (:documentation "Build a response for a type TY (:json, :html, t = html).

routing/routes.lisp

@@ -99,7 +99,7 @@
               (setf (gethash key cookies) value)
               cookies))
           (cl-ppcre:split ";\\s?" cookies)
-          :initial-value (make-hash-table)))
+          :initial-value (make-hash-table :test 'equal)))
 
 (declaim (ftype (function (hash-table request response) t)
                 parse-cookies))

routing/types.lisp

@@ -26,7 +26,7 @@
   (let ((ref (gensym "DATA")))
     `(let* ((,ref (request-data ,request))
             ,@(mapcar (lambda (item)
-                        (list (intern (string-upcase (string item)))
+                        (list item
                               `(getf ,ref ,(intern (string item) :keyword))))
                       keys))
        ,@body)))
@@ -35,7 +35,7 @@
   (let ((ref (gensym "DATA")))
     `(let* ((,ref (response-data ,response))
             ,@(mapcar (lambda (item)
-                        (list (intern (string-upcase (string item)))
+                        (list item
                               `(getf ,ref ,(intern (string item) :keyword))))
                       keys))
        ,@body)))

session/package.lisp

@@ -0,0 +1,29 @@
+(defpackage #:wst.session
+  (:use #:cl)
+  (:export
+   #:create-session
+   #:recover-session
+   #:update-session
+   #:session-exists-p
+   #:renew-session
+   #:terminate-session))
+
+(in-package :wst.session)
+
+(defgeneric create-session (object data &key &allow-other-keys)
+  (:documentation "Creates a new session for a user, returning a unique session ID."))
+
+(defgeneric recover-session (object session-id &key &allow-other-keys)
+  (:documentation "Retrieves the session data for the given session ID, or NIL if expired or non-existent."))
+
+(defgeneric update-session (object session &key &allow-other-keys)
+  (:documentation "Updates the SESSION for the given session ID."))
+
+(defgeneric session-exists-p (object session-id &key &allow-other-keys)
+  (:documentation "Returns T if the session exists and is active, NIL otherwise."))
+
+(defgeneric renew-session (object session-id &optional additional-time &key &allow-other-keys)
+  (:documentation "Renews the session by extending its expiry time."))
+
+(defgeneric terminate-session (object session-id &key &allow-other-keys)
+  (:documentation "Destroys the session with the given session ID."))

web-server/session-csrf.lisp

@@ -0,0 +1,14 @@
+(defpackage #:wst.web-server.session-csrf
+  (:use #:cl)
+  (:export
+   #:session-csrf-token
+   #:add-session-csrf-token
+   #:remove-session-csrf-token
+   #:verify-session-csrf-token))
+
+(in-package :wst.web-server.session-csrf)
+
+(defgeneric session-csrf-token (obj &key &allow-other-keys))
+(defgeneric add-session-csrf-token (obj key &key &allow-other-keys))
+(defgeneric remove-session-csrf-token (obj &key &allow-other-keys))
+(defgeneric verify-session-csrf-token (obj key &key &allow-other-keys))

wst.cookies.asd

@@ -0,0 +1,4 @@
+(asdf:defsystem #:wst.cookies
+  :pathname "cookies"
+  :serial t
+  :components ((:file "package")))

wst.session.asd

@@ -0,0 +1,4 @@
+(asdf:defsystem #:wst.session
+  :pathname "session"
+  :serial t
+  :components ((:file "package")))

wst.web-server.session-csrf.asd

@@ -0,0 +1,4 @@
+(asdf:defsystem #:wst.web-server.session-csrf
+  :pathname "web-server"
+  :serial t
+  :components ((:file "session-csrf")))

wst.web-server.woo.asd

@@ -0,0 +1,4 @@
+(asdf:defsystem #:wst.web-server.woo
+  :pathname "web-server"
+  :serial t
+  :components ((:file "woo")))