#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 (only-in racket/list append-map))

(require syndicate/relay)
(require syndicate/rewrite)
(require syndicate/sturdy)
(require syndicate/schemas/gen/gatekeeper)
(require syndicate/sturdy)
(require syndicate/drivers/tcp)

(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 (->preserve root-cap) #:indent 4 #:commas? #f)
    (newline)
    (displayln (bytes->hex-string (sturdy-encode (->preserve root-cap))))

    (spawn-tcp-driver this-turn ds)
    (spawn #:name 'tcp-server
           (at ds
             (during/spawn (Connection $conn (TcpInbound "0.0.0.0" 5999))
               (define gatekeeper
                 (ref
                  (during* #:name (list conn 'gatekeeper)
                           (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 Attenuation-value
                                                  (reverse (SturdyRef-caveatChain sturdyref))))
                                    (define attenuated-target
                                      (apply attenuate-entity-ref target attenuation))
                                    (at observer (assert (embedded attenuated-target)))))])))))
               ((run-relay #:name conn
                           #:packet-writer (action (bs) (send-data this-turn conn bs))
                           #:setup-inputs
                           (action (tr)
                             (accept-connection this-turn conn
                                                #:on-data (action (bs) (accept-bytes tr bs))))
                           #:initial-ref
                           (action () gatekeeper))
                this-turn))))))