Update websocket driver and examples
This commit is contained in:
parent
d86c64f68a
commit
5092cff96b
|
@ -2,6 +2,7 @@
|
||||||
|
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
(require net/rfc6455)
|
(require net/rfc6455)
|
||||||
|
(require (only-in net/rfc6455/conn-api ws-conn-base-ip))
|
||||||
(require "../main.rkt")
|
(require "../main.rkt")
|
||||||
(require "../demand-matcher.rkt")
|
(require "../demand-matcher.rkt")
|
||||||
|
|
||||||
|
@ -28,12 +29,10 @@
|
||||||
;; Driver
|
;; Driver
|
||||||
|
|
||||||
(define (spawn-websocket-driver)
|
(define (spawn-websocket-driver)
|
||||||
(spawn-demand-matcher (websocket-message ? (websocket-local-server ? ?) ?)
|
(spawn-demand-matcher (websocket-message ? (?! (websocket-local-server ? ?)) ?)
|
||||||
#:demand-level 1
|
#:demand-level 1
|
||||||
#:supply-level 2
|
#:supply-level 2
|
||||||
(match-lambda
|
spawn-websocket-listener))
|
||||||
[(route _ (websocket-message _ server-addr _) _ _)
|
|
||||||
(spawn-websocket-listener server-addr)])))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Listener
|
;; Listener
|
||||||
|
@ -42,13 +41,12 @@
|
||||||
|
|
||||||
(define (websocket-listener e state)
|
(define (websocket-listener e state)
|
||||||
(match e
|
(match e
|
||||||
[(routing-update routes)
|
[(routing-update g)
|
||||||
(match-define (listener-state shutdown-procedure server-addr) state)
|
(match-define (listener-state shutdown-procedure server-addr) state)
|
||||||
(define peer-listener-route (pub (websocket-message ? server-addr ?) #:level 2))
|
(if (gestalt-empty? (gestalt-filter g (pub (websocket-message ? server-addr ?) #:level 2)))
|
||||||
(if (for/or ((r routes)) (pair? (intersect-routes (list r) (list peer-listener-route))))
|
|
||||||
#f
|
|
||||||
(begin (when shutdown-procedure (shutdown-procedure))
|
(begin (when shutdown-procedure (shutdown-procedure))
|
||||||
(transition (struct-copy listener-state state [shutdown-procedure #f]) (quit))))]
|
(transition (struct-copy listener-state state [shutdown-procedure #f]) (quit)))
|
||||||
|
#f)]
|
||||||
[(message (event _ (list (list c connection-shutdown-procedure))) 1 #f)
|
[(message (event _ (list (list c connection-shutdown-procedure))) 1 #f)
|
||||||
(transition state
|
(transition state
|
||||||
(spawn-connection (listener-state-server-addr state)
|
(spawn-connection (listener-state-server-addr state)
|
||||||
|
@ -80,8 +78,8 @@
|
||||||
(connection-handler ch)))
|
(connection-handler ch)))
|
||||||
(spawn websocket-listener
|
(spawn websocket-listener
|
||||||
(listener-state shutdown-procedure server-addr)
|
(listener-state shutdown-procedure server-addr)
|
||||||
(list (pub (websocket-message ? server-addr ?) #:level 2)
|
(gestalt-union (pub (websocket-message ? server-addr ?) #:level 2)
|
||||||
(sub (event ch ?) #:meta-level 1))))
|
(sub (event ch ?) #:meta-level 1))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Connection
|
;; Connection
|
||||||
|
@ -111,11 +109,11 @@
|
||||||
[(message (websocket-message _ _ m) 0 #f)
|
[(message (websocket-message _ _ m) 0 #f)
|
||||||
(ws-send! (connection-state-c state) m)
|
(ws-send! (connection-state-c state) m)
|
||||||
#f]
|
#f]
|
||||||
[(routing-update routes)
|
[(routing-update g)
|
||||||
(cond
|
(cond
|
||||||
[(and (connection-state-seen-peer? state) (null? routes))
|
[(and (connection-state-seen-peer? state) (gestalt-empty? g))
|
||||||
(shutdown-connection state)]
|
(shutdown-connection state)]
|
||||||
[(and (not (connection-state-seen-peer? state)) (pair? routes))
|
[(and (not (connection-state-seen-peer? state)) (not (gestalt-empty? g)))
|
||||||
(transition (struct-copy connection-state state [seen-peer? #t]) '())]
|
(transition (struct-copy connection-state state [seen-peer? #t]) '())]
|
||||||
[else
|
[else
|
||||||
#f])]
|
#f])]
|
||||||
|
@ -125,7 +123,7 @@
|
||||||
(define local-addr (websocket-remote-client (gensym 'ws)))
|
(define local-addr (websocket-remote-client (gensym 'ws)))
|
||||||
(spawn websocket-connection
|
(spawn websocket-connection
|
||||||
(connection-state #f local-addr server-addr c shutdown-procedure)
|
(connection-state #f local-addr server-addr c shutdown-procedure)
|
||||||
(list (pub (websocket-message local-addr server-addr ?))
|
(gestalt-union (pub (websocket-message local-addr server-addr ?))
|
||||||
(sub (websocket-message server-addr local-addr ?))
|
(sub (websocket-message server-addr local-addr ?))
|
||||||
(sub (websocket-message server-addr local-addr ?) #:level 1)
|
(sub (websocket-message server-addr local-addr ?) #:level 1)
|
||||||
(sub (event c ?) #:meta-level 1))))
|
(sub (event (ws-conn-base-ip c) ?) #:meta-level 1))))
|
||||||
|
|
|
@ -9,28 +9,25 @@
|
||||||
(define server-id (websocket-local-server 8081 (websocket-ssl-options "server-cert.pem"
|
(define server-id (websocket-local-server 8081 (websocket-ssl-options "server-cert.pem"
|
||||||
"private-key.pem")))
|
"private-key.pem")))
|
||||||
|
|
||||||
(spawn-demand-matcher (websocket-message any-client server-id ?)
|
|
||||||
#:demand-is-subscription? #f
|
|
||||||
(match-lambda ;; arrived-demand-route, i.e. new connection publisher
|
|
||||||
[(route _ (websocket-message c _ _) _ _)
|
|
||||||
(spawn-connection-handler c)]
|
|
||||||
[_ '()])
|
|
||||||
(lambda (departed-supply-route)
|
|
||||||
(log-info "Connection handler decided to exit")
|
|
||||||
'()))
|
|
||||||
|
|
||||||
(define (spawn-connection-handler c)
|
(define (spawn-connection-handler c)
|
||||||
(log-info "spawn-connection-handler ~v" c)
|
(log-info "spawn-connection-handler ~v" c)
|
||||||
(define (connection-handler e n)
|
(define (connection-handler e n)
|
||||||
(when e (log-info "connection-handler ~v: ~v /// ~v" c e n))
|
(when e (log-info "connection-handler ~v: ~v /// ~v" c e n))
|
||||||
(match e
|
(match e
|
||||||
[(routing-update '()) (transition n (quit))]
|
[(routing-update (? gestalt-empty?)) (transition n (quit))]
|
||||||
[_
|
[_
|
||||||
(if (< n 20)
|
(if (< n 20)
|
||||||
(transition (+ n 1) (send (websocket-message server-id c (format "msg ~v" n))))
|
(transition (+ n 1) (send (websocket-message server-id c (format "msg ~v" n))))
|
||||||
#f)]))
|
#f)]))
|
||||||
(spawn connection-handler
|
(spawn connection-handler
|
||||||
0
|
0
|
||||||
(list (sub (websocket-message c server-id ?))
|
(gestalt-union (sub (websocket-message c server-id ?))
|
||||||
(sub (websocket-message c server-id ?) #:level 1)
|
(sub (websocket-message c server-id ?) #:level 1)
|
||||||
(pub (websocket-message server-id c ?)))))
|
(pub (websocket-message server-id c ?)))))
|
||||||
|
|
||||||
|
(spawn-demand-matcher (websocket-message (?! any-client) server-id ?)
|
||||||
|
#:demand-is-subscription? #f
|
||||||
|
spawn-connection-handler
|
||||||
|
(lambda (c)
|
||||||
|
(log-info "Connection handler ~v decided to exit" c)
|
||||||
|
'()))
|
||||||
|
|
|
@ -8,28 +8,25 @@
|
||||||
(define any-client (websocket-remote-client ?))
|
(define any-client (websocket-remote-client ?))
|
||||||
(define server-id (websocket-local-server 8081 #f))
|
(define server-id (websocket-local-server 8081 #f))
|
||||||
|
|
||||||
(spawn-demand-matcher (websocket-message any-client server-id ?)
|
|
||||||
#:demand-is-subscription? #f
|
|
||||||
(match-lambda ;; arrived-demand-route, i.e. new connection publisher
|
|
||||||
[(route _ (websocket-message c _ _) _ _)
|
|
||||||
(spawn-connection-handler c)]
|
|
||||||
[_ '()])
|
|
||||||
(lambda (departed-supply-route)
|
|
||||||
(log-info "Connection handler decided to exit")
|
|
||||||
'()))
|
|
||||||
|
|
||||||
(define (spawn-connection-handler c)
|
(define (spawn-connection-handler c)
|
||||||
(log-info "spawn-connection-handler ~v" c)
|
(log-info "spawn-connection-handler ~v" c)
|
||||||
(define (connection-handler e n)
|
(define (connection-handler e n)
|
||||||
(when e (log-info "connection-handler ~v: ~v /// ~v" c e n))
|
(when e (log-info "connection-handler ~v: ~v /// ~v" c e n))
|
||||||
(match e
|
(match e
|
||||||
[(routing-update '()) (transition n (quit))]
|
[(routing-update (? gestalt-empty?)) (transition n (quit))]
|
||||||
[_
|
[_
|
||||||
(if (< n 20)
|
(if (< n 20)
|
||||||
(transition (+ n 1) (send (websocket-message server-id c (format "msg ~v" n))))
|
(transition (+ n 1) (send (websocket-message server-id c (format "msg ~v" n))))
|
||||||
#f)]))
|
#f)]))
|
||||||
(spawn connection-handler
|
(spawn connection-handler
|
||||||
0
|
0
|
||||||
(list (sub (websocket-message c server-id ?))
|
(gestalt-union (sub (websocket-message c server-id ?))
|
||||||
(sub (websocket-message c server-id ?) #:level 1)
|
(sub (websocket-message c server-id ?) #:level 1)
|
||||||
(pub (websocket-message server-id c ?)))))
|
(pub (websocket-message server-id c ?)))))
|
||||||
|
|
||||||
|
(spawn-demand-matcher (websocket-message (?! any-client) server-id ?)
|
||||||
|
#:demand-is-subscription? #f
|
||||||
|
spawn-connection-handler
|
||||||
|
(lambda (c)
|
||||||
|
(log-info "Connection handler ~v decided to exit" c)
|
||||||
|
'()))
|
||||||
|
|
Loading…
Reference in New Issue