diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/kernel/Branch.ml | 16 |
1 files changed, 16 insertions, 0 deletions
diff --git a/lib/kernel/Branch.ml b/lib/kernel/Branch.ml index 936391c..70e0711 100644 --- a/lib/kernel/Branch.ml +++ b/lib/kernel/Branch.ml @@ -118,8 +118,24 @@ module Make (S : Abstract.Storage.STORAGE) = struct ~constructor:(fun node' -> MultigroupM.from node' |> make |> Result.ok ) ] ) in let open Utilities.Result in + let admits (m, multigroup) = + Protocols.Handle.releasing multigroup (fun () -> + let* admission = Protocols.Admission.require multigroup in + let* violations = Protocols.Admission.check admission in + Ok + (List.map + (fun (d, tuples) -> + Path.(to_string ("multigroup" @/ m @/ "denial" @/ d @/ this)), tuples ) + violations ) ) + in Protocols. [ Addressable.make self; + Admission.make + object + method check = + let* named = Prototype.Directory.children multigroups in + List.map admits named |> Utilities.List.sequence |> Result.map List.concat + end; Prototype.Associative.( of_properties [ ( "multigroup", |