syndicate-lang
/
minimart-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Update websocket driver and examples

This commit is contained in:
Tony Garnock-Jones 2014-05-21 23:22:21 -04:00
parent d86c64f68a
commit 5092cff96b
3 changed files with 38 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
minimart/drivers/websocket.rkt
View File

@ -2,6 +2,7 @@
(require racket/match)
(require net/rfc6455)
(require (only-in net/rfc6455/conn-api ws-conn-base-ip))
(require "../main.rkt")
(require "../demand-matcher.rkt")
@ -28,12 +29,10 @@
;; Driver
(define (spawn-websocket-driver)
(spawn-demand-matcher (websocket-message ? (websocket-local-server ? ?) ?)
(spawn-demand-matcher (websocket-message ? (?! (websocket-local-server ? ?)) ?)
#:demand-level 1
#:supply-level 2
(match-lambda
[(route _ (websocket-message _ server-addr _) _ _)
(spawn-websocket-listener server-addr)])))
spawn-websocket-listener))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Listener
@ -42,13 +41,12 @@
(define (websocket-listener e state)
(match e
[(routing-update routes)
[(routing-update g)
(match-define (listener-state shutdown-procedure server-addr) state)
(define peer-listener-route (pub (websocket-message ? server-addr ?) #:level 2))
(if (for/or ((r routes)) (pair? (intersect-routes (list r) (list peer-listener-route))))
#f
(if (gestalt-empty? (gestalt-filter g (pub (websocket-message ? server-addr ?) #:level 2)))
(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)
(transition state
(spawn-connection (listener-state-server-addr state)
@ -80,8 +78,8 @@
(connection-handler ch)))
(spawn websocket-listener
(listener-state shutdown-procedure server-addr)
(list (pub (websocket-message ? server-addr ?) #:level 2)
(sub (event ch ?) #:meta-level 1))))
(gestalt-union (pub (websocket-message ? server-addr ?) #:level 2)
(sub (event ch ?) #:meta-level 1))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Connection
@ -111,11 +109,11 @@
[(message (websocket-message _ _ m) 0 #f)
(ws-send! (connection-state-c state) m)
#f]
[(routing-update routes)
[(routing-update g)
(cond
[(and (connection-state-seen-peer? state) (null? routes))
[(and (connection-state-seen-peer? state) (gestalt-empty? g))
(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]) '())]
[else
#f])]
@ -125,7 +123,7 @@
(define local-addr (websocket-remote-client (gensym 'ws)))
(spawn websocket-connection
(connection-state #f local-addr server-addr c shutdown-procedure)
(list (pub (websocket-message local-addr server-addr ?))
(sub (websocket-message server-addr local-addr ?))
(sub (websocket-message server-addr local-addr ?) #:level 1)
(sub (event c ?) #:meta-level 1))))
(gestalt-union (pub (websocket-message local-addr server-addr ?))
(sub (websocket-message server-addr local-addr ?))
(sub (websocket-message server-addr local-addr ?) #:level 1)
(sub (event (ws-conn-base-ip c) ?) #:meta-level 1))))

25
minimart/examples/ws-hello-ssl.rkt
View File

@ -9,28 +9,25 @@
(define server-id (websocket-local-server 8081 (websocket-ssl-options "server-cert.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)
(log-info "spawn-connection-handler ~v" c)
(define (connection-handler e n)
(when e (log-info "connection-handler ~v: ~v /// ~v" c e n))
(match e
[(routing-update '()) (transition n (quit))]
[(routing-update (? gestalt-empty?)) (transition n (quit))]
[_
(if (< n 20)
(transition (+ n 1) (send (websocket-message server-id c (format "msg ~v" n))))
#f)]))
(spawn connection-handler
0
(list (sub (websocket-message c server-id ?))
(sub (websocket-message c server-id ?) #:level 1)
(pub (websocket-message server-id c ?)))))
(gestalt-union (sub (websocket-message c server-id ?))
(sub (websocket-message c server-id ?) #:level 1)
(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)
'()))

25
minimart/examples/ws-hello.rkt
View File

@ -8,28 +8,25 @@
(define any-client (websocket-remote-client ?))
(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)
(log-info "spawn-connection-handler ~v" c)
(define (connection-handler e n)
(when e (log-info "connection-handler ~v: ~v /// ~v" c e n))
(match e
[(routing-update '()) (transition n (quit))]
[(routing-update (? gestalt-empty?)) (transition n (quit))]
[_
(if (< n 20)
(transition (+ n 1) (send (websocket-message server-id c (format "msg ~v" n))))
#f)]))
(spawn connection-handler
0
(list (sub (websocket-message c server-id ?))
(sub (websocket-message c server-id ?) #:level 1)
(pub (websocket-message server-id c ?)))))
(gestalt-union (sub (websocket-message c server-id ?))
(sub (websocket-message c server-id ?) #:level 1)
(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)
'()))