68 lines
2.3 KiB
Racket
68 lines
2.3 KiB
Racket
#lang imperative-syndicate
|
|
|
|
(provide (all-defined-out))
|
|
|
|
(require (prefix-in preserves: preserves))
|
|
(require bitsyntax)
|
|
(require (only-in net/rfc6455 ws-idle-timeout))
|
|
|
|
;; Enrolment
|
|
(message-struct Connect (scope)) ;; Client --> Server
|
|
|
|
;; Transactions
|
|
(message-struct Turn (items)) ;; Bidirectional
|
|
;; Items:
|
|
;; Actions; Client --> Server (and Peer --> Peer, except for Message)
|
|
(message-struct Assert (endpoint-name assertion))
|
|
(message-struct Clear (endpoint-name))
|
|
(message-struct Message (body))
|
|
;; Events; Server --> Client (and Peer --> Peer)
|
|
(message-struct Add (endpoint-name captures))
|
|
(message-struct Del (endpoint-name captures))
|
|
(message-struct Msg (endpoint-name captures))
|
|
(message-struct End (endpoint-name))
|
|
|
|
;; Errors
|
|
(message-struct Err (detail context)) ;; Server --> Client (and Peer --> Peer)
|
|
|
|
;; Transport-related; Bidirectional
|
|
(message-struct Ping ())
|
|
(message-struct Pong ())
|
|
|
|
;; In peer mode, *actions* and *events* travel in *both* directions,
|
|
;; but `Message`s do not appear and (for now) `Assert` is only used to
|
|
;; establish `observe`s, i.e. subscriptions.
|
|
|
|
(define (decode bs)
|
|
(parameterize ((preserves:short-form-labels '#(discard capture observe)))
|
|
(bit-string-case bs
|
|
#:on-short (lambda (fail) (values #f bs))
|
|
([ (v :: (preserves:wire-value)) (rest :: binary) ] (values v (bit-string->bytes rest)))
|
|
(else (error 'decode "Invalid wire message")))))
|
|
|
|
(define (encode v)
|
|
(parameterize ((preserves:short-form-labels '#(discard capture observe)))
|
|
(preserves:encode v)))
|
|
|
|
(define (ping-interval)
|
|
(* 1000 (min 60 ;; reasonable default?
|
|
;;
|
|
;; TODO: disable the net/rfc6455 ws-idle-timeout, when we can.
|
|
;;
|
|
;; The net/rfc6455 ws-idle-timeout has to be paid attention to here because it
|
|
;; can't be disabled, because the built-in webserver (which net/rfc6455
|
|
;; interoperates with) has a per-connection timer that also can't be disabled.
|
|
;;
|
|
(max (- (ws-idle-timeout) 10)
|
|
(* (ws-idle-timeout) 0.8)))))
|
|
|
|
(define (packet-accumulator handle-packet!)
|
|
(field [buffer #""])
|
|
(begin/dataflow
|
|
(define-values (packet remainder) (decode (buffer)))
|
|
(when packet
|
|
(buffer remainder)
|
|
(handle-packet! packet)))
|
|
(lambda (chunk)
|
|
(buffer (bytes-append (buffer) chunk))))
|