#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)])))))