39 lines
1.8 KiB
Racket
39 lines
1.8 KiB
Racket
#lang syndicate
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
;;; SPDX-FileCopyrightText: Copyright © 2021-2024 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
|
|
;; TODO: I'd like to write `(SturdyStepType)` instead of `(app parse-SturdyStepType
|
|
;; (SturdyStepType))` here, and likewise for `unvalidated-parameters`, but because
|
|
;; there are `any`s in those positions, it doesn't know it needs to carry on parsing.
|
|
[(Resolve (Step (app parse-SturdyStepType (SturdyStepType))
|
|
(app parse-Parameters unvalidated-parameters))
|
|
observer)
|
|
(at ds
|
|
(during
|
|
(Bind (Description
|
|
(SturdyStepType)
|
|
(SturdyDescriptionDetail $key (Parameters-oid unvalidated-parameters)))
|
|
$target
|
|
_)
|
|
(define sturdyref (validate (SturdyRef unvalidated-parameters) key))
|
|
(define attenuation (SturdyRef-caveatChain sturdyref))
|
|
(define attenuated-target (apply attenuate-entity-ref target attenuation))
|
|
(at observer (assert (Resolved-accepted attenuated-target)))))]))
|
|
|
|
(define (gatekeeper-resolve gatekeeper ref k)
|
|
(at gatekeeper
|
|
(assert (Resolve ref (object #:name (list 'gatekeeper-resolve gatekeeper ref)
|
|
[(Resolved-accepted a) (k a)]
|
|
[(Resolved-Rejected r) (error 'gatekeeper-resolve "Rejected: ~v" r)])))))
|