racket/collects/web-server/http/cookie.rkt
2010-12-07 14:14:49 -07:00

47 lines
1.5 KiB
Racket

#lang racket
(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))))