syndicate-rkt/syndicate/examples/web-core.rkt

46 lines
1.7 KiB
Racket
Raw Normal View History

#lang imperative-syndicate
(require/activate imperative-syndicate/drivers/web)
(require/activate imperative-syndicate/drivers/timer)
(define server (http-server "localhost" 8081 #f))
(spawn
(during (http-request $id $method $resource _ _ _)
(stop-when (asserted ($ details (http-request-peer-details id _ _ _ _)))
(log-info "~a: ~a ~v ~v" id method resource details)))
(during/spawn (http-request $id 'get (http-resource server '("" ())) _ _ _)
(assert (http-accepted id))
(assert (http-response id 200 #"OK" (current-seconds)
#"text/plain"
'()
#"Hi")))
(during/spawn (http-request $id 'get (http-resource server '("chunked" ())) _ _ _)
(assert (http-accepted id))
(assert (http-response id 200 #"Chunked" (current-seconds)
#"text/plain"
'()
'chunked))
(on-start (sleep 1)
(send! (http-response-chunk id #"One\n"))
(sleep 1)
(send! (http-response-chunk id #"Two\n"))
(sleep 1)
(send! (http-response-chunk id #"Three\n"))
(stop-current-facet)))
(during/spawn (http-request $id 'get (http-resource server '("ws-echo" ())) _ _ _)
(assert (http-accepted id))
(assert (http-response-websocket id '()))
(on (message (websocket-in id $body))
(log-info "~a sent: ~v" id body)
(send! (websocket-out id (format "You said: ~a" body))))
(on (message (websocket-in id "quit"))
(stop-current-facet))
(on-start (log-info "Starting websocket connection ~a" id))
(on-stop (log-info "Stopping websocket connection ~a" id)))
)