;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2010-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

#lang syndicate

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

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

(require syndicate/protocol/credit)

(require/activate syndicate/drivers/web)
(require/activate syndicate/distributed/server)

(define (server-facet/websocket id)
  (assert (http-accepted id))
  (assert (http-response-websocket id))
  (assert (server-poa id))
  (stop-when (retracted (server-poa-ready 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"))
      (send! (message-poa->server id packet)))
  (on (message (message-server->poa id $p))
      (send! (websocket-out id (encode p)))
      (when (Err? p) (stop-current-facet))))

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