syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Support binary/text websocket payloads

This commit is contained in:
Tony Garnock-Jones 2018-11-15 06:49:31 +00:00
parent 93371894a0
commit 6c1e3b033d
1 changed files with 11 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
syndicate/drivers/web.rkt
View File

@ -22,6 +22,7 @@
(require racket/exn)
(require (only-in racket/list flatten))
(require (only-in racket/string string-append*))
(require (only-in racket/bytes bytes-append*))
(require racket/tcp)
(require net/rfc6455)
@ -190,7 +191,14 @@
(on-stop (channel-put ws-ch 'quit)
(stop-facet root-facet))
(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)))
(if (eof-object? body)
(stop-current-facet)
@ -297,7 +305,7 @@
(shutdown!)))]
(let loop ()
(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)))
(loop)))
(handle-evt ws-ch (match-lambda
@ -305,7 +313,7 @@
(set! quit-seen? #t)
(void)]
[(list 'send m)
(ws-send! wsc m)
(ws-send! wsc m #:payload-type (if (bytes? m) 'binary 'text))
(loop)]))))
(ws-close! wsc))
(when (not quit-seen?)