#lang imperative-syndicate

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

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

(require imperative-syndicate/protocol/credit)

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

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

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

  (define !! (make-flow-controlled-sender message-poa->server id))
  (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"))
      (!! (message-poa->server id packet)))
  (on (message (message-server->poa id $p))
      (send! (websocket-out id (encode p)))))

(define default-http-server-port 8000)

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