29 lines
983 B
Racket
29 lines
983 B
Racket
|
#lang imperative-syndicate
|
||
|
|
|
||
|
|
(provide server-facet/tcp
|
||
|
|
default-tcp-broker-port
|
||
|
|
spawn-tcp-broker!)
|
||
|
|
|
||
|
|
(require "../wire-protocol.rkt")
|
||
|
|
|
||
|
|
(require/activate imperative-syndicate/drivers/tcp)
|
||
|
|
(require/activate imperative-syndicate/broker/server)
|
||
|
|
|
||
|
|
(define (server-facet/tcp id scope)
|
||
|
|
(assert (tcp-accepted id))
|
||
|
|
(assert (server-connection id scope))
|
||
|
|
(define accumulate! (packet-accumulator (lambda (p) (send! (server-inbound id p)))))
|
||
|
|
(on (message (tcp-in id $bs))
|
||
|
|
(accumulate! bs))
|
||
|
|
(on (message (server-outbound id $p))
|
||
|
|
(send! (tcp-out id (encode p)))))
|
||
|
|
|
||
|
|
(define default-tcp-broker-port 8001)
|
||
|
|
|
||
|
|
(define (spawn-tcp-broker! [port default-tcp-broker-port])
|
||
|
|
(spawn #:name 'tcp-server-listener
|
||
|
|
(define tcp-scope "broker") ;; TODO: allow this to be negotiated during protocol startup
|
||
|
|
(during/spawn (tcp-connection $id (tcp-listener port))
|
||
|
|
#:name `(server-connection ,tcp-scope ,id)
|
||
|
|
(server-facet/tcp id tcp-scope))))
|