mirror of
https://github.com/vale981/lack
synced 2025-03-05 17:31:39 -05:00
66 lines
2 KiB
Common Lisp
66 lines
2 KiB
Common Lisp
(in-package :cl-user)
|
|
(defpackage lack.response
|
|
(:use :cl)
|
|
(:import-from :quri
|
|
:url-encode)
|
|
(:import-from :local-time
|
|
:format-timestring
|
|
:universal-to-timestamp
|
|
:+gmt-zone+)
|
|
(:export :response
|
|
:make-response
|
|
:finalize-response
|
|
:response-status
|
|
:response-headers
|
|
:response-body
|
|
:response-set-cookies))
|
|
(in-package :lack.response)
|
|
|
|
(defstruct (response
|
|
(:constructor make-response (&optional status headers (body nil has-body)
|
|
&aux (no-body (not has-body)))))
|
|
status
|
|
headers
|
|
body
|
|
no-body
|
|
set-cookies)
|
|
|
|
(defun finalize-response (res)
|
|
(finalize-cookies res)
|
|
(with-slots (status headers body no-body) res
|
|
(list* status headers
|
|
(cond
|
|
(no-body nil)
|
|
((stringp body) (list (list body)))
|
|
(t (list body))))))
|
|
|
|
(defun finalize-cookies (res)
|
|
(setf (response-headers res)
|
|
(append (response-headers res)
|
|
(loop for (k v) on (response-set-cookies res) by #'cddr
|
|
append (list :set-cookie (bake-cookie k v))))))
|
|
|
|
(defun bake-cookie (key value)
|
|
(unless value
|
|
(return-from bake-cookie ""))
|
|
|
|
(destructuring-bind (&key domain path expires secure httponly &allow-other-keys)
|
|
value
|
|
(with-output-to-string (s)
|
|
(format s "~A=~A"
|
|
(quri:url-encode (string key))
|
|
(quri:url-encode (getf value :value)))
|
|
(when domain
|
|
(format s "; domain=~A" domain))
|
|
(when path
|
|
(format s "; path=~A" path))
|
|
(when expires
|
|
(format s "; expires=")
|
|
(format-timestring
|
|
s (universal-to-timestamp expires)
|
|
:format '(:short-weekday ", " (:day 2) #\Space :short-month #\Space (:year 4) #\Space (:hour 2) #\: (:min 2) #\: (:sec 2) " GMT")
|
|
:timezone +gmt-zone+))
|
|
(when secure
|
|
(write-string "; secure" s))
|
|
(when httponly
|
|
(write-string "; HttpOnly" s)))))
|