; SPDX-License-Identifier: LGPL-3.0-or-later
; Copyright (C) 2010-2021 Tony Garnock-Jones <tonygarnockjones@gmail.com>

#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)
  (preserves:bytes->preserve bs))

(define (encode v)
  (preserves:preserve->bytes 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 p (open-input-bytes (buffer)))
    (let read-more ()
      (define start-pos (file-position p))
      (match (preserves:read-preserve/binary p #:on-short (lambda () eof))
        [(? eof-object?)
         (when (positive? start-pos)
           (buffer (subbytes (buffer) start-pos)))]
        [packet
         (handle-packet! packet)
         (read-more)])))
  (lambda (chunk)
    (buffer (bytes-append (buffer) chunk))))