#lang syndicate

(provide server-facet/tcp
         default-tcp-server-port
         spawn-tcp-server!)

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

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

(define (server-facet/tcp id)
  (assert (tcp-accepted id))
  (assert (server-poa id))
  (stop-when (retracted (server-poa-ready id)))
  (on-start (issue-credit! #:amount 32768 tcp-in id))
  (define accumulate! (packet-accumulator (lambda (p) (send! (message-poa->server id p)))))
  (on (message (tcp-in id $bs))
      (issue-credit! #:amount (bytes-length bs) tcp-in id)
      (accumulate! bs))
  (on (message (message-server->poa id $p))
      (send! (tcp-out id (encode p)))
      (when (Err? p) (stop-current-facet))))

(define default-tcp-server-port 21369)

(define (spawn-tcp-server! [port default-tcp-server-port])
  (spawn #:name 'tcp-server-listener
         (during/spawn (tcp-connection $id (tcp-listener port))
           #:name `(server-poa ,id)
           (on-start (issue-credit! (tcp-listener port)))
           (server-facet/tcp id))))