From 254d106c92dcabcdeb83a5d0141deca22ffb79de Mon Sep 17 00:00:00 2001
From: Marcos Magueta <maguetamarcos@gmail.com>
Date: Fri, 9 Oct 2026 01:16:35 -0300
Subject: admission protocol for multigroup denial checks

---
 lib/kernel/Branch.ml | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

(limited to 'lib/kernel/Branch.ml')

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",
-- 
cgit v1.2.3