Refactor module structure
This commit is contained in:
parent
91246c1471
commit
2335a64633
|
@ -0,0 +1,40 @@
|
|||
#lang racket/base
|
||||
;; Generic protocol for WebSockets/TCP/etc-based participation in a network.
|
||||
|
||||
(provide drop-json-action
|
||||
lift-json-event
|
||||
lift-json-action
|
||||
drop-json-event
|
||||
ping-interval)
|
||||
|
||||
(require net/rfc6455)
|
||||
(require racket/set)
|
||||
(require racket/match)
|
||||
(require "../main.rkt")
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Wire protocol representation of events and actions
|
||||
|
||||
(define (drop j)
|
||||
(match j
|
||||
["ping" 'ping]
|
||||
["pong" 'pong]
|
||||
[`("routes" ,gj) (routing-update (jsexpr->gestalt gj (lambda (v) (set 'peer))))]
|
||||
[`("message" ,body ,meta-level ,feedback?) (message body meta-level feedback?)]))
|
||||
|
||||
(define (lift j)
|
||||
(match j
|
||||
['ping "ping"]
|
||||
['pong "pong"]
|
||||
[(routing-update g) `("routes" ,(gestalt->jsexpr g (lambda (v) #t)))]
|
||||
[(message body meta-level feedback?) `("message" ,body ,meta-level ,feedback?)]))
|
||||
|
||||
(define drop-json-action drop)
|
||||
(define lift-json-event lift)
|
||||
(define lift-json-action lift)
|
||||
(define drop-json-event drop)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Connections
|
||||
|
||||
(define (ping-interval) (* 1000 (max (- (ws-idle-timeout) 10) (* (ws-idle-timeout) 0.8))))
|
|
@ -1,49 +1,25 @@
|
|||
#lang racket/base
|
||||
;; Generic relay for WebSockets/TCP/etc-based participation in a network.
|
||||
|
||||
(provide spawn-websocket-relay)
|
||||
(provide spawn-broker-server)
|
||||
|
||||
(require racket/set)
|
||||
(require racket/match)
|
||||
(require net/rfc6455)
|
||||
(require "main.rkt")
|
||||
(require "demand-matcher.rkt")
|
||||
(require "drivers/timer.rkt")
|
||||
(require "drivers/websocket.rkt")
|
||||
(require "../main.rkt")
|
||||
(require "../demand-matcher.rkt")
|
||||
(require "../drivers/timer.rkt")
|
||||
(require "../drivers/websocket.rkt")
|
||||
(require json)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Main: start WebSocket server
|
||||
(require "protocol.rkt")
|
||||
|
||||
;; Depends on timer driver and websocket driver running at metalevel 1.
|
||||
(define (spawn-websocket-relay port [ssl-options #f])
|
||||
(define (spawn-broker-server port [ssl-options #f])
|
||||
(define server-id (websocket-local-server port ssl-options))
|
||||
(spawn-demand-matcher (websocket-message (?! (websocket-remote-client ?)) server-id ?)
|
||||
#:meta-level 1
|
||||
(lambda (c) (spawn-connection-handler c server-id))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Wire protocol representation of events and actions
|
||||
|
||||
(define (drop-json-action j)
|
||||
(match j
|
||||
["ping" 'ping]
|
||||
["pong" 'pong]
|
||||
[`("routes" ,gj) (routing-update (jsexpr->gestalt gj (lambda (v) (set 'peer))))]
|
||||
[`("message" ,body ,meta-level ,feedback?) (message body meta-level feedback?)]))
|
||||
|
||||
(define (lift-json-event j)
|
||||
(match j
|
||||
['ping "ping"]
|
||||
['pong "pong"]
|
||||
[(routing-update g) `("routes" ,(gestalt->jsexpr g (lambda (v) #t)))]
|
||||
[(message body meta-level feedback?) `("message" ,body ,meta-level ,feedback?)]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Connections
|
||||
|
||||
(define (ping-interval) (* 1000 (max (- (ws-idle-timeout) 10) (* (ws-idle-timeout) 0.8))))
|
||||
|
||||
(define (spawn-connection-handler c server-id)
|
||||
(actor #:name relay
|
||||
#:state [tunnelled-gestalt (gestalt-empty)]
|
|
@ -3,10 +3,10 @@
|
|||
|
||||
(require minimart/drivers/timer)
|
||||
(require minimart/drivers/websocket)
|
||||
(require minimart/relay)
|
||||
(require minimart/broker/server)
|
||||
|
||||
(spawn-timer-driver)
|
||||
(spawn-websocket-driver)
|
||||
(spawn-world
|
||||
(spawn-websocket-relay 8000)
|
||||
(spawn-websocket-relay 8443 (websocket-ssl-options "server-cert.pem" "private-key.pem")))
|
||||
(spawn-broker-server 8000)
|
||||
(spawn-broker-server 8443 (websocket-ssl-options "server-cert.pem" "private-key.pem")))
|
||||
|
|
Loading…
Reference in New Issue