65 lines
2.0 KiB
Racket
65 lines
2.0 KiB
Racket
#lang racket/base
|
|
(require web-server/http/response-structs
|
|
web-server/http/xexpr
|
|
racket/list)
|
|
|
|
(define response/basic? response?)
|
|
(define (make-response/basic c m s mime hs)
|
|
(response/full c m s mime hs #""))
|
|
(define response/basic-code response-code)
|
|
(define response/basic-message response-message)
|
|
(define response/basic-seconds response-seconds)
|
|
(define response/basic-mime response-mime)
|
|
(define response/basic-headers response-headers)
|
|
|
|
(define BODIES (make-weak-hasheq))
|
|
(define response/full? response?)
|
|
(define (make-response/full c m s mime hs bs)
|
|
(define r (response/full c m s mime hs bs))
|
|
(hash-set! BODIES r bs)
|
|
r)
|
|
(define response/full-code response-code)
|
|
(define response/full-message response-message)
|
|
(define response/full-seconds response-seconds)
|
|
(define response/full-mime response-mime)
|
|
(define response/full-headers response-headers)
|
|
(define (response/full-body r)
|
|
(hash-ref BODIES r))
|
|
|
|
(define GENS (make-weak-hasheq))
|
|
(define response/incremental? response?)
|
|
(define (make-response/incremental c m s mime hs gen)
|
|
(define r
|
|
(response c m s mime hs
|
|
(λ (out)
|
|
(gen (λ bss
|
|
(for ([bs (in-list bss)])
|
|
(write-bytes bs out)))))))
|
|
(hash-set! GENS r gen)
|
|
r)
|
|
(define response/incremental-code response-code)
|
|
(define response/incremental-message response-message)
|
|
(define response/incremental-seconds response-seconds)
|
|
(define response/incremental-mime response-mime)
|
|
(define response/incremental-headers response-headers)
|
|
(define (response/incremental-body r)
|
|
(hash-ref GENS r))
|
|
|
|
(define make-xexpr-response response/xexpr)
|
|
|
|
(define (normalize-response r [close? #f])
|
|
(cond
|
|
[(response? r) r]
|
|
[(and (pair? r) (bytes? (car r)))
|
|
(response/full 200 #"Okay" (current-seconds) (car r)
|
|
empty
|
|
(map (λ (x) (if (bytes? x) x (string->bytes/utf-8 x)))
|
|
(cdr r)))]
|
|
[else
|
|
(response/xexpr r)]))
|
|
|
|
(provide
|
|
(except-out (all-defined-out)
|
|
BODIES
|
|
GENS))
|