39 lines
1.3 KiB
Racket
39 lines
1.3 KiB
Racket
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
;;; SPDX-FileCopyrightText: Copyright © 2010-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
|
|
|
#lang syndicate
|
|
|
|
(provide server-facet/websocket
|
|
default-http-server-port
|
|
spawn-websocket-server!)
|
|
|
|
(require "../wire-protocol.rkt")
|
|
(require "../internal-protocol.rkt")
|
|
|
|
(require syndicate/protocol/credit)
|
|
|
|
(require/activate syndicate/drivers/web)
|
|
(require/activate syndicate/distributed/server)
|
|
|
|
(define (server-facet/websocket id)
|
|
(assert (http-accepted id))
|
|
(assert (http-response-websocket id))
|
|
(assert (server-poa id))
|
|
(stop-when (retracted (server-poa-ready id)))
|
|
(on (message (websocket-in id $body))
|
|
(define-values (packet remainder) (decode body))
|
|
(when (not (equal? remainder #""))
|
|
(error 'server-facet/websocket "Multiple packets in a single websocket message"))
|
|
(send! (message-poa->server id packet)))
|
|
(on (message (message-server->poa id $p))
|
|
(send! (websocket-out id (encode p)))
|
|
(when (Err? p) (stop-current-facet))))
|
|
|
|
(define default-http-server-port 8000)
|
|
|
|
(define (spawn-websocket-server! [port default-http-server-port])
|
|
(spawn #:name 'websocket-server-listener
|
|
(during/spawn (http-request $id 'get (http-resource (http-server _ port #f) `("" ())) _ _ _)
|
|
#:name `(server-poa ,id)
|
|
(server-facet/websocket id))))
|