-
-
Notifications
You must be signed in to change notification settings - Fork 11
/
cors.rkt
77 lines (62 loc) · 2.35 KB
/
cors.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
#lang racket/base
(require racket/contract/base
racket/function
racket/string
web-server/http
"contract.rkt"
"profiler.rkt"
"url.rkt")
(provide
(contract-out
[current-cors-origin (parameter/c (or/c #f non-empty-string?))]
[current-cors-methods (parameter/c (listof non-empty-string?))]
[current-cors-headers (parameter/c (listof non-empty-string?))]
[current-cors-max-age (parameter/c exact-nonnegative-integer?)]
[current-cors-credentials-allowed? (parameter/c boolean?)]
[wrap-cors middleware/c]))
(define current-cors-origin
(make-parameter #f))
(define current-cors-methods
(make-parameter '("HEAD" "DELETE" "GET" "PATCH" "POST" "PUT" "OPTIONS")))
(define current-cors-headers
(make-parameter (list "*")))
(define current-cors-max-age
(make-parameter 86400))
(define current-cors-credentials-allowed?
(make-parameter #t))
(define (make-allow-origin-header)
(define origin
(string->bytes/utf-8
(cond
[(current-cors-origin)
=> identity]
[else
(format "~a://~a"
(current-application-url-scheme)
(current-application-url-host))])))
(make-header #"Access-Control-Allow-Origin" origin))
(define (make-options-headers)
(define headers
(list (make-allow-origin-header)
(make-header #"Access-Control-Allow-Methods"
(string->bytes/utf-8
(string-join (current-cors-methods) ",")))
(make-header #"Access-Control-Allow-Headers"
(string->bytes/utf-8
(string-join (current-cors-headers) ",")))
(make-header #"Access-Control-Max-Age"
(string->bytes/utf-8
(number->string (current-cors-max-age))))))
(if (current-cors-credentials-allowed?)
(cons (make-header #"Access-Control-Allow-Credentials" #"true") headers)
headers))
(define ((wrap-cors handler) req . args)
(with-timing 'cors "wrap-cors"
(cond
[(bytes=? (request-method req) #"OPTIONS")
(response/full 200 #"OK" (current-seconds) #f (make-options-headers) null)]
[else
(define resp (apply handler req args))
(define headers (cons (make-allow-origin-header)
(response-headers resp)))
(struct-copy response resp [headers headers])])))