;; lib/acl/schema.sx — ACL sorts and EDB predicate vocabulary.
;;
;; Datalog is untyped; this module is the schema-as-data layer. It declares
;; the subject/resource/action sorts and the arity of every EDB predicate the
;; ACL engine recognises, plus light validators. Facts that pass these checks
;; are well-formed inputs to lib/acl/engine.sx.

(define acl-subject-kinds (quote (user group role service)))
(define acl-resource-kinds (quote (page post thread peer)))

;; Actions are open-ended (a grant may name any action symbol), but these are
;; the platform's well-known verbs.
(define acl-actions (quote (read edit comment moderate federate)))

;; EDB predicate name -> arity.
;;   Phase 1: actor/resource/grant/deny.
;;   Phase 2: member_of (subject->group/role), child_of (resource->parent),
;;            role_grant (role->action,resource).
;;   Phase 4: peer (addr->kind), trust (peer->level),
;;            delegate (peer->subj,action,resource), level_covers (level->action).
(define acl-edb-arity {:role_grant 3 :child_of 2 :trust 2 :peer 2 :actor 2 :level_covers 2 :delegate 4 :member_of 2 :deny 3 :grant 3 :resource 2})

(define
  acl-member?
  (fn
    (x xs)
    (cond
      ((= (len xs) 0) false)
      ((= (first xs) x) true)
      (else (acl-member? x (rest xs))))))

(define acl-subject-kind? (fn (k) (acl-member? k acl-subject-kinds)))

(define acl-resource-kind? (fn (k) (acl-member? k acl-resource-kinds)))

(define acl-known-action? (fn (a) (acl-member? a acl-actions)))

;; A fact is a list whose head is a predicate symbol. Valid when the predicate
;; is known and the argument count matches the declared arity.
(define
  acl-fact-valid?
  (fn
    (f)
    (and
      (list? f)
      (> (len f) 0)
      (symbol? (first f))
      (let
        ((pred (symbol->string (first f))))
        (and
          (has-key? acl-edb-arity pred)
          (= (- (len f) 1) (get acl-edb-arity pred)))))))

;; Return the sublist of facts that fail acl-fact-valid?. Empty list means the
;; whole set is well-formed. acl-build-db stays lenient (Datalog accepts any
;; tuple, and custom action symbols are allowed); callers opt in to checking.
(define
  acl-validate-facts
  (fn
    (facts)
    (let
      ((bad (list)))
      (do
        (for-each
          (fn (f) (when (not (acl-fact-valid? f)) (append! bad f)))
          facts)
        bad))))

(define
  acl-facts-valid?
  (fn (facts) (= (len (acl-validate-facts facts)) 0)))