47 lines
1.5 KiB
Racket
47 lines
1.5 KiB
Racket
#lang racket/base
|
|
(require net/cookie
|
|
web-server/http/request-structs
|
|
web-server/http/response-structs
|
|
xml
|
|
web-server/private/xexpr
|
|
racket/contract)
|
|
|
|
(provide/contract
|
|
[make-cookie ((cookie-name? cookie-value?) (#:comment (or/c false/c string?)
|
|
#:domain (or/c false/c valid-domain?)
|
|
#:max-age (or/c false/c exact-nonnegative-integer?)
|
|
#:path (or/c false/c string?)
|
|
#:secure? (or/c false/c boolean?))
|
|
. ->* . cookie?)]
|
|
[cookie->header (cookie? . -> . header?)])
|
|
|
|
(define-syntax setter
|
|
(syntax-rules ()
|
|
[(_ e)
|
|
e]
|
|
[(_ e (f arg) . more)
|
|
(let ([x e])
|
|
(setter (if arg
|
|
(f x arg)
|
|
x)
|
|
. more))]))
|
|
|
|
(define (make-cookie name val
|
|
#:comment [comment #f]
|
|
#:domain [domain #f]
|
|
#:max-age [max-age #f]
|
|
#:path [path #f]
|
|
#:secure? [secure? #f])
|
|
(setter (set-cookie name val)
|
|
(cookie:add-comment comment)
|
|
(cookie:add-domain domain)
|
|
(cookie:add-max-age max-age)
|
|
(cookie:add-path path)
|
|
(cookie:secure secure?)))
|
|
|
|
;; cookie->header : cookie -> header
|
|
;; gets the header that will set the given cookie
|
|
(define (cookie->header cookie)
|
|
(make-header #"Set-Cookie" (string->bytes/utf-8 (print-cookie cookie))))
|
|
|