From 5092cff96b9a7f348e29715c943a4282d858ed3a Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Wed, 21 May 2014 23:22:21 -0400 Subject: [PATCH] Update websocket driver and examples --- minimart/drivers/websocket.rkt | 34 ++++++++++++++---------------- minimart/examples/ws-hello-ssl.rkt | 25 ++++++++++------------ minimart/examples/ws-hello.rkt | 25 ++++++++++------------ 3 files changed, 38 insertions(+), 46 deletions(-) diff --git a/minimart/drivers/websocket.rkt b/minimart/drivers/websocket.rkt index 4061796..61af07e 100644 --- a/minimart/drivers/websocket.rkt +++ b/minimart/drivers/websocket.rkt @@ -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)))) diff --git a/minimart/examples/ws-hello-ssl.rkt b/minimart/examples/ws-hello-ssl.rkt index 471a312..95b1def 100644 --- a/minimart/examples/ws-hello-ssl.rkt +++ b/minimart/examples/ws-hello-ssl.rkt @@ -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) + '())) diff --git a/minimart/examples/ws-hello.rkt b/minimart/examples/ws-hello.rkt index 1633c7d..035d8b5 100644 --- a/minimart/examples/ws-hello.rkt +++ b/minimart/examples/ws-hello.rkt @@ -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) + '()))