Support binary/text websocket payloads
This commit is contained in:
parent
93371894a0
commit
6c1e3b033d
|
@ -22,6 +22,7 @@
|
||||||
(require racket/exn)
|
(require racket/exn)
|
||||||
(require (only-in racket/list flatten))
|
(require (only-in racket/list flatten))
|
||||||
(require (only-in racket/string string-append*))
|
(require (only-in racket/string string-append*))
|
||||||
|
(require (only-in racket/bytes bytes-append*))
|
||||||
(require racket/tcp)
|
(require racket/tcp)
|
||||||
|
|
||||||
(require net/rfc6455)
|
(require net/rfc6455)
|
||||||
|
@ -190,7 +191,14 @@
|
||||||
(on-stop (channel-put ws-ch 'quit)
|
(on-stop (channel-put ws-ch 'quit)
|
||||||
(stop-facet root-facet))
|
(stop-facet root-facet))
|
||||||
(on (message (websocket-out id $body))
|
(on (message (websocket-out id $body))
|
||||||
(channel-put ws-ch (list 'send (string-append* (flatten body)))))
|
(define flat (flatten body))
|
||||||
|
(define payload (cond [(null? flat) ""]
|
||||||
|
[(bytes? (car flat)) (bytes-append* flat)]
|
||||||
|
[(string? (car flat)) (string-append* flat)]
|
||||||
|
[else (error 'respond/websocket!
|
||||||
|
"Bad payload: mixed content: ~v"
|
||||||
|
flat)]))
|
||||||
|
(channel-put ws-ch (list 'send payload)))
|
||||||
(on (message (inbound (websocket-in id $body)))
|
(on (message (inbound (websocket-in id $body)))
|
||||||
(if (eof-object? body)
|
(if (eof-object? body)
|
||||||
(stop-current-facet)
|
(stop-current-facet)
|
||||||
|
@ -297,7 +305,7 @@
|
||||||
(shutdown!)))]
|
(shutdown!)))]
|
||||||
(let loop ()
|
(let loop ()
|
||||||
(sync (handle-evt wsc (lambda _args
|
(sync (handle-evt wsc (lambda _args
|
||||||
(define msg (ws-recv wsc #:payload-type 'text))
|
(define msg (ws-recv wsc #:payload-type 'auto))
|
||||||
(ground-send! (inbound (websocket-in id msg)))
|
(ground-send! (inbound (websocket-in id msg)))
|
||||||
(loop)))
|
(loop)))
|
||||||
(handle-evt ws-ch (match-lambda
|
(handle-evt ws-ch (match-lambda
|
||||||
|
@ -305,7 +313,7 @@
|
||||||
(set! quit-seen? #t)
|
(set! quit-seen? #t)
|
||||||
(void)]
|
(void)]
|
||||||
[(list 'send m)
|
[(list 'send m)
|
||||||
(ws-send! wsc m)
|
(ws-send! wsc m #:payload-type (if (bytes? m) 'binary 'text))
|
||||||
(loop)]))))
|
(loop)]))))
|
||||||
(ws-close! wsc))
|
(ws-close! wsc))
|
||||||
(when (not quit-seen?)
|
(when (not quit-seen?)
|
||||||
|
|
Loading…
Reference in New Issue