#lang imperative-syndicate

(provide server-facet/websocket
         default-http-broker-port
         spawn-websocket-broker!)

(require "../wire-protocol.rkt")

(require/activate imperative-syndicate/drivers/web)
(require/activate imperative-syndicate/drivers/timer)
(require/activate imperative-syndicate/broker/server)

(define (server-facet/websocket id scope)
  (assert (http-accepted id))
  (assert (http-response-websocket id))
  (assert (server-connection id scope))

  (field [ping-time-deadline 0])
  (on (asserted (later-than (ping-time-deadline)))
      (ping-time-deadline (+ (current-inexact-milliseconds) (ping-interval)))
      (send! (server-outbound id (Ping))))

  (on (message (websocket-in id $body))
      (define-values (packet remainder) (decode body))
      (when (not (equal? remainder #""))
        (error 'server-facet/websocket "Multiple packets in a single websocket message"))
      (send! (server-inbound id packet)))
  (on (message (server-outbound id $p))
      (send! (websocket-out id (encode p)))))

(define default-http-broker-port 8000)

(define (spawn-websocket-broker! [port default-http-broker-port])
  (spawn #:name 'websocket-server-listener
         (during/spawn (http-request $id 'get (http-resource (http-server _ port #f)
                                                             `(,$scope ())) _ _ _)
           #:name `(server-connection ,scope ,id)
           (server-facet/websocket id scope))))
