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

(require (only-in sha bytes->hex-string))

(require racket/tcp)
(require (only-in racket/list append-map))

(require syndicate/relay)
(require syndicate/sturdy)
(require syndicate/schemas/gen/gatekeeper)
(require syndicate/sturdy)
(require syndicate/driver-support)

(define (read-bytes-avail input-port #:limit [limit 65536])
  (define buffer (make-bytes limit))
  (match (read-bytes-avail! buffer input-port)
    [(? number? count) (subbytes buffer 0 count)]
    [other other]))

(module+ main
  (actor-system/dataspace (ds)
    (define ds-oid "syndicate")
    (define ds-key (make-bytes KEY_LENGTH))
    (at ds (assert (Bind ds-oid ds-key ds)))

    (define root-cap (mint ds-oid ds-key))
    (write-preserve/text (SturdyRef->preserves root-cap) #:indent 4 #:commas? #f)
    (newline)
    (displayln (bytes->hex-string (sturdy-encode (SturdyRef->preserves root-cap))))

    (define spawn-connection
      (action (connection-custodian i o)
        (define name-base (call-with-values (lambda () (tcp-addresses i #t)) list))
        (spawn-relay
         this-turn
         #:name name-base
         #:packet-writer (lambda (bs) (write-bytes bs o))
         #:setup-inputs (action (tr)

                          (on-stop (close-input-port i)
                                   (close-output-port o))

                          (linked-thread
                           #:name (cons 'input-thread name-base)
                           #:custodian connection-custodian
                           this-turn
                           (ref (entity #:name (cons 'socket-monitor name-base)
                                        #:retract (action (_handle) (stop-current-facet))))
                           (lambda ()
                             (let loop ()
                               (define bs (read-bytes-avail i))
                               (when (bytes? bs)
                                 (accept-bytes tr bs)
                                 (loop))))))
         #:initial-ref
         (ref (during* #:name (cons 'gatekeeper name-base)
                       (action (assertion)
                         (match (parse-Resolve assertion)
                           [(? eof-object?) (void)]
                           [(Resolve unvalidated-sturdyref observer)
                            (at ds
                              (during (Bind (SturdyRef-oid unvalidated-sturdyref) $key $target)
                                (define sturdyref (validate unvalidated-sturdyref key))
                                (define attenuation
                                  (append-map values (reverse (SturdyRef-caveatChain sturdyref))))
                                (define attenuated-target
                                  (apply attenuate-entity-ref target attenuation))
                                (at observer (assert (embedded attenuated-target)))))])))))))

    (spawn
      #:name 'tcp-server
      (linked-thread
       #:name 'tcp-server
       this-turn
       (ref (entity #:name 'listen-monitor #:retract (action (_handle) (stop-current-facet))))
       (lambda ()
         (define listener (tcp-listen 5999 512 #t "0.0.0.0"))
         (let loop ()
           (define connection-custodian (make-custodian))
           (define-values (i o) (parameterize ((current-custodian connection-custodian))
                                  (tcp-accept listener)))
           (turn-freshen this-turn (action () (spawn-connection this-turn connection-custodian i o)))
           (loop)))))))