syndicate-rkt/syndicate/distributed/wire-protocol.rkt

#lang syndicate

(provide (all-defined-out))

(require (prefix-in preserves: preserves))
(require bitsyntax)
(require (only-in net/rfc6455 ws-idle-timeout))
(require (only-in racket/list index-of))

;; 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)
  (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)
  (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))))