Commit cbe0db05 authored by amirouche's avatar amirouche

helpers: add cookies helpers.

- Add a #:cookies key parameter to 'redirect' that allows to set
  cookies. This is done in 'redirect' because it seems to me that
  settings cookies is only useful after a form a successful POST
  request and POST requests must always be followed by a redirect to
  avoid buggy request replay (via page refresh).

- Add 'request-cookies' public procedure.
parent 0fdb05b8
......@@ -44,8 +44,40 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
(values (build-response #:code 404)
(string-append "Resource not found: " uri)))
(define-public (redirect uri)
(values (build-response #:code 303 #:headers `((Location . ,uri))) ""))
(define (make-set-cookie-header pair) ;; XXX: https://mdn.io/Set-Cookie,
(let ((key (car pair))
(value (cdr pair)))
;; The cookie will have the lifetime of a session cookie.
`(Set-Cookie . ,(string-append (symbol->string key)
"= "
value
"; HttpOnly"
"; SameSite=Strict"))))
(define (alist->set-cookie-headers alist)
(let loop ((alist alist)
(out '()))
(if (null? alist)
out
(loop (cdr alist) (cons (make-set-cookie-header (car alist)) out)))))
(define-public redirect
(lambda* (uri #:key cookies)
(if cookies
(let ((headers (append `((Location . ,uri))
(alist->set-cookie-headers cookies))))
(values (build-response #:code 303 #:headers headers) ""))
(values (build-response #:code 303 #:headers `((Location . ,uri))) ""))))
(define-public (error)
(values (build-response #:code 500)))
(define (%make-cookie item)
(let ((item* (string-split item #\=)))
(cons (string->symbol (car item*)) (cadr item*))))
(define-public (request-cookies request)
(let ((headers (request-headers request)))
(and=> (assq-ref headers 'cookie)
(lambda (cookie)
(map %make-cookie (map string-trim (string-split cookie #\;)))))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment