47 lines
1.5 KiB
Racket
47 lines
1.5 KiB
Racket
#lang imperative-syndicate
|
|
|
|
(provide generic-client-session-facet)
|
|
|
|
(require "wire-protocol.rkt")
|
|
(require "protocol.rkt")
|
|
(require imperative-syndicate/term)
|
|
|
|
(define-logger syndicate/broker)
|
|
|
|
(spawn #:name 'client-factory
|
|
(during (to-broker $a _) (assert (broker-connection a)))
|
|
(during (observe (from-broker $a _)) (assert (broker-connection a)))
|
|
(during (observe (broker-connected $a)) (assert (broker-connection a))))
|
|
|
|
(define (generic-client-session-facet address w)
|
|
(on-start (log-syndicate/broker-info "Connected to ~v" address))
|
|
(on-stop (log-syndicate/broker-info "Disconnected from ~v" address))
|
|
(assert (broker-connected address))
|
|
|
|
(define next-ep
|
|
(let ((counter 0))
|
|
(lambda ()
|
|
(begin0 counter
|
|
(set! counter (+ counter 1))))))
|
|
|
|
(during (to-broker address $a)
|
|
(define ep (next-ep))
|
|
(on-start (w (Assert ep a)))
|
|
(on-stop (w (Clear ep))))
|
|
|
|
(on (message (to-broker address $a))
|
|
(w (Message a)))
|
|
|
|
(on (message (broker-packet address (Ping)))
|
|
(w (Pong)))
|
|
|
|
(during (observe (from-broker address $spec))
|
|
(define ep (next-ep))
|
|
(on-start (w (Assert ep (observe spec))))
|
|
(on-stop (w (Clear ep)))
|
|
(on (message (broker-packet address (Add ep $vs)))
|
|
(react (assert (instantiate-term->value (from-broker address spec) vs))
|
|
(stop-when (message (broker-packet address (Del ep vs))))))
|
|
(on (message (broker-packet address (Msg ep $vs)))
|
|
(send! (instantiate-term->value (from-broker address spec) vs)))))
|