60 lines
1.9 KiB
Racket
60 lines
1.9 KiB
Racket
#lang imperative-syndicate
|
|
|
|
(provide generic-client-session-facet)
|
|
|
|
(require "wire-protocol.rkt")
|
|
(require "internal-protocol.rkt")
|
|
(require "protocol.rkt")
|
|
(require imperative-syndicate/term)
|
|
|
|
(define-logger syndicate/distributed)
|
|
|
|
(spawn #:name 'client-factory
|
|
(during (to-server $a _) (assert (server-connection a)))
|
|
(during (observe (from-server $a _)) (assert (server-connection a)))
|
|
(during (observe (server-connected $a)) (assert (server-connection a))))
|
|
|
|
(define (generic-client-session-facet address scope w)
|
|
(on-start (log-syndicate/distributed-info "Connected to ~v" address))
|
|
(on-stop (log-syndicate/distributed-info "Disconnected from ~v" address))
|
|
(assert (server-connected address))
|
|
|
|
(when (log-level? syndicate/distributed-logger 'debug)
|
|
(set! w (let ((w* w))
|
|
(lambda (p)
|
|
(log-syndicate/distributed-debug "C OUT ~v ~v" address p)
|
|
(w* p)))))
|
|
|
|
(on-start (w (Connect scope)))
|
|
|
|
(define next-ep
|
|
(let ((counter 0))
|
|
(lambda ()
|
|
(begin0 counter
|
|
(set! counter (+ counter 1))))))
|
|
|
|
(during (to-server address $a)
|
|
(define ep (next-ep))
|
|
(on-start (w (Assert ep a)))
|
|
(on-stop (w (Clear ep))))
|
|
|
|
(on (message (to-server address $a))
|
|
(w (Message a)))
|
|
|
|
(on (message (server-packet address (Ping)))
|
|
(w (Pong)))
|
|
|
|
(on (message (server-packet address (Err $detail)))
|
|
(log-syndicate/distributed-error "Error from ~a: ~v" address detail)
|
|
(stop-current-facet))
|
|
|
|
(during (observe ($ pat (from-server address $spec)))
|
|
(define ep (next-ep))
|
|
(on-start (w (Assert ep (observe spec))))
|
|
(on-stop (w (Clear ep)))
|
|
(on (message (server-packet address (Add ep $vs)))
|
|
(react (assert (instantiate-term->value pat vs))
|
|
(stop-when (message (server-packet address (Del ep vs))))))
|
|
(on (message (server-packet address (Msg ep $vs)))
|
|
(send! (instantiate-term->value pat vs)))))
|