29 lines
1.2 KiB
Racket
29 lines
1.2 KiB
Racket
|
#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
|
||
|
(append-map Attenuation-value (reverse (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)])))))
|