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

#lang syndicate

(require "../client.rkt")
(require "../wire-protocol.rkt")
(require "../internal-protocol.rkt")
(require "../protocol.rkt")
(require syndicate/reassert)

(require/activate syndicate/drivers/tcp)

(spawn #:name 'tcp-client-factory
       (during/spawn (server-connection ($ address (server-tcp-connection $host $port $scope)))
         #:name address
         (define id (list (gensym 'client) host port))

         (reassert-on (tcp-connection id (tcp-address host port))
                      (retracted (tcp-accepted id))
                      (asserted (tcp-rejected id _))
                      (retracted (server-transport-connected address))
                      (retracted (server-session-connected address)))

         (during (tcp-accepted id)
           (on-start (issue-unbounded-credit! tcp-in id))
           (assert (server-transport-connected address))
           (define accumulate! (packet-accumulator (lambda (p) (send! (server-packet address p)))))
           (on (message (tcp-in id $bs)) (accumulate! bs)))

         (during (server-transport-connected address)
           ;; If we run generic-client-session-facet in the `tcp-accepted` handler above, then
           ;; unfortunately disconnection of the TCP socket on error overtakes the error report
           ;; itself, terminating the generic-client-session-facet before it has a chance to
           ;; handle the error report.
           ;;
           ;; Could timing errors like that be something a type system could help us with? The
           ;; conversation in `server-packet`s is sort-of "nested" inside the conversation in
           ;; `tcp-in`s; a single facet reacting to both conversations (in this instance, to
           ;; `server-packets` in an implicit frame, but explicitly to the frame of the
           ;; `tcp-in`s, namely `tcp-accepted`) is probably an error. Or rather, any situation
           ;; where pending "inner conversation" business could be obliterated by discarding a
           ;; facet based on "outer conversation" framing is probably an error.
           ;;
           (generic-client-session-facet address
                                         scope
                                         (lambda (x) (send! (tcp-out id (encode x))))))))