syndicate-rkt/syndicate/distributed/gatekeeper.rkt

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

(provide make-gatekeeper
         gatekeeper-resolve
         (all-from-out syndicate/schemas/gatekeeper))

(require (only-in racket/list append-map))
(require syndicate/rewrite)
(require syndicate/schemas/gatekeeper)
(require syndicate/sturdy)

(define (make-gatekeeper ds #:name [name 'gatekeeper])
  (object #:name name
          [(Resolve unvalidated-sturdyref observer)
           (at ds
               (during (Bind (SturdyRef-oid unvalidated-sturdyref) $key $target)
                 (define sturdyref (validate unvalidated-sturdyref key))
                 (define attenuation (SturdyRef-caveatChain sturdyref))
                 (define attenuated-target (apply attenuate-entity-ref target attenuation))
                 (at observer (assert (embedded attenuated-target)))))]))

(define (gatekeeper-resolve gatekeeper ref k)
  (at gatekeeper
    (assert (Resolve ref (object #:name (list 'gatekeeper-resolve gatekeeper ref)
                                 [(embedded a) (k a)])))))