66 lines
2.4 KiB
Racket
66 lines
2.4 KiB
Racket
#lang racket/base
|
|
|
|
(provide sleep
|
|
random-hex-string
|
|
extend-url-string-query
|
|
web-respond/status!
|
|
web-request!)
|
|
|
|
(require (only-in file/sha1 bytes->hex-string))
|
|
(require (only-in racket/random crypto-random-bytes))
|
|
(require net/url)
|
|
(require syndicate/actor)
|
|
(require syndicate/drivers/timer)
|
|
(require syndicate/drivers/web)
|
|
|
|
(module+ test (require rackunit))
|
|
|
|
(define (sleep sec)
|
|
(define timer-id (gensym 'sleep))
|
|
(until (message (timer-expired timer-id _))
|
|
(on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))
|
|
|
|
(define (random-hex-string half-length)
|
|
(bytes->hex-string (crypto-random-bytes half-length)))
|
|
|
|
(define (extend-url-string-query urlstr extension)
|
|
(define u (string->url urlstr))
|
|
(url->string (struct-copy url u [query (append (url-query u) extension)])))
|
|
|
|
(define (web-respond/status! id code message [body #""])
|
|
(web-respond/bytes! id
|
|
#:header (web-response-header
|
|
#:code code
|
|
#:message message
|
|
#:headers '())
|
|
body))
|
|
|
|
(define (web-request! verb urlstr #:body [body #""] #:headers [headers '()])
|
|
(define req-id (gensym 'req))
|
|
(define u (string->url urlstr))
|
|
(define res (url->resource u))
|
|
(react/suspend (k)
|
|
(on-start
|
|
(printf "~a --> ~a ~a ~v\n" req-id verb urlstr body)
|
|
(send! (web-request req-id
|
|
'outbound
|
|
(web-request-header verb res headers (url-query u))
|
|
body)))
|
|
(stop-when (message (web-response-complete req-id $resp $body))
|
|
(printf "~a <-- ~v ~v\n" req-id resp body)
|
|
(k resp body))))
|
|
|
|
(module+ test
|
|
(check-equal? (extend-url-string-query "http://localhost/" '((a . "hi")))
|
|
"http://localhost/?a=hi")
|
|
(check-equal? (extend-url-string-query "http://localhost/" '())
|
|
"http://localhost/")
|
|
(check-equal? (extend-url-string-query "http://localhost?foo=bar" '())
|
|
"http://localhost?foo=bar")
|
|
(check-equal? (extend-url-string-query "http://localhost/?foo=bar" '())
|
|
"http://localhost/?foo=bar")
|
|
(check-equal? (extend-url-string-query "http://localhost?foo=bar" '((a . "hi")))
|
|
"http://localhost?foo=bar&a=hi")
|
|
(check-equal? (extend-url-string-query "http://localhost/?foo=bar" '((a . "hi")))
|
|
"http://localhost/?foo=bar&a=hi"))
|