28 lines
1.1 KiB
Racket
28 lines
1.1 KiB
Racket
#lang imperative-syndicate
|
|
|
|
(provide standard-localhost-server/tcp
|
|
(struct-out server-tcp-connection))
|
|
|
|
(require "../client.rkt")
|
|
(require "../wire-protocol.rkt")
|
|
(require "../protocol.rkt")
|
|
(require imperative-syndicate/reassert)
|
|
|
|
(require/activate imperative-syndicate/drivers/tcp)
|
|
|
|
(assertion-struct server-tcp-connection (host port))
|
|
|
|
(define standard-localhost-server/tcp (server-tcp-connection "localhost" 8001))
|
|
|
|
(spawn #:name 'tcp-client-factory
|
|
(during/spawn (server-connection ($ address (server-tcp-connection $host $port)))
|
|
#:name address
|
|
(define id (list (gensym 'client) host port))
|
|
(reassert-on (tcp-connection id (tcp-address host port))
|
|
(retracted (tcp-accepted id))
|
|
(asserted (tcp-rejected id _)))
|
|
(during (tcp-accepted id)
|
|
(define accumulate! (packet-accumulator (lambda (p) (send! (server-packet address p)))))
|
|
(on (message (tcp-in id $bs)) (accumulate! bs))
|
|
(generic-client-session-facet address (lambda (x) (send! (tcp-out id (encode x))))))))
|