tests and some pointer for program on ephemeral

4 files changed, 316 insertions, 168 deletions

diff --git a/test/unit/evaluators/FOL.ml b/test/unit/evaluators/FOL.ml
index a0789aa..3254258 100644
--- a/test/unit/evaluators/FOL.ml
+++ b/test/unit/evaluators/FOL.ml
@@ -9,22 +9,25 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       attributes= BatMap.String.empty |> BatMap.String.add "name" (Concepts.Value.String "Alaric")
     }
 
-  let not_a_directory () =
-    Concepts.Condition.condition "not-a-directory"
-      "A handle was expected to carry the directory protocol and did not" Concepts.Condition.empty
-
-  let missing name =
-    Concepts.Condition.condition "missing" "A name was expected in the directory and was absent"
-      Concepts.Condition.("name" |=| Concepts.Value.String name)
-
   let employee name age =
     { Concepts.Tuple.type_= "employee";
       attributes=
         BatMap.String.of_list ["name", Concepts.Value.String name; "age", Concepts.Value.Integer age]
     }
 
-  (* a plan comes resolved, so it reads nothing through [within] *)
-  let nowhere = Kernel.Prototype.mixture []
+  let named name =
+    { Concepts.Tuple.type_= "employee";
+      attributes= BatMap.String.singleton "name" (Concepts.Value.String name) }
+
+  let employees = Rnt.Evaluators.FOL.Base Kernel.Path.("employee" @/ this)
+  let names = Rnt.Evaluators.FOL.Project (employees, BatFingerTree.singleton "name")
+  let heading = BatMap.String.singleton "name" {Protocols.Schematics.domain= "string"; provenance= []}
+  let directory entries = Kernel.Prototype.(mixture [Directory.of_properties entries])
+
+  let eval within term =
+    let open Utilities.Result in
+    let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
+    Protocols.Evaluator.eval evaluator (Rnt.Evaluators.FOL.Fol term) [] ~within
 
   let drain result =
     let open Utilities.Result in
@@ -36,26 +39,16 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     Protocols.Handle.release result;
     Ok (BatFingerTree.to_list tuples)
 
+  let bindings tuples =
+    List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes) tuples
+    |> List.sort compare
+
   let scan_a_base_relation conn =
     let scanned =
       begin
         let open Utilities.Result in
         let* employee = H.relation conn ["name"] [alaric] in
-        let root =
-          Kernel.Prototype.mixture
-            [ Kernel.Prototype.Directory.of_properties
-                ["employee", employee; "fol", Rnt.Evaluators.FOL.make ()] ]
-        in
-        let* directory =
-          Protocols.Directory.from root |> Option.to_result ~none:(not_a_directory ())
-        in
-        let* found = Protocols.Directory.find directory "fol" in
-        let* evaluator = Option.to_result ~none:(missing "fol") found in
-        let* evaluator = Protocols.Evaluator.require evaluator in
-        let* result =
-          Rnt.Evaluators.FOL.(program (Base employee))
-          |> Protocols.Evaluator.invoke evaluator ~within:nowhere
-        in
+        let* result = eval (directory ["employee", employee]) employees in
         drain result
       end
       |> Helpers.condition_as_failure
@@ -71,15 +64,11 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     let projected =
       begin
         let open Utilities.Result in
-        let* employees =
+        let* relation =
           H.relation conn ["name"; "age"]
             [employee "Alaric" 42; employee "Alaric" 30; employee "Brunhild" 42]
         in
-        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
-        let* result =
-          Rnt.Evaluators.FOL.(program (Project (Base employees, BatFingerTree.singleton "name")))
-          |> Protocols.Evaluator.invoke evaluator ~within:nowhere
-        in
+        let* result = eval (directory ["employee", relation]) names in
         drain result
       end
       |> Helpers.condition_as_failure
@@ -88,25 +77,15 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       (list (list (pair string Helpers.value)))
       "each name once, and nothing else"
       [["name", Concepts.Value.String "Alaric"]; ["name", Concepts.Value.String "Brunhild"]]
-      ( projected
-      |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes)
-      |> List.sort compare )
+      (bindings projected)
 
   let instantiate_a_program conn =
     let projected =
       begin
         let open Utilities.Result in
-        let* employees = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
-        let root = Kernel.Prototype.(mixture [Directory.of_properties ["employee", employees]]) in
-        let* plan =
-          Rnt.Evaluators.FOL.(
-            instantiate (Kernel.Path.lookup root)
-              (Project (Base Kernel.Path.("employee" @/ this), BatFingerTree.singleton "name")) )
-        in
-        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
-        let* result =
-          Rnt.Evaluators.FOL.program plan |> Protocols.Evaluator.invoke evaluator ~within:nowhere
-        in
+        let* relation = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
+        let* plan = Rnt.Evaluators.FOL.instantiate (directory ["employee", relation]) names in
+        let* result = Rnt.Evaluators.FOL.execute plan in
         drain result
       end
       |> Helpers.condition_as_failure
@@ -115,14 +94,11 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       (list (list (pair string Helpers.value)))
       "the program ran over the relation its path resolved to"
       [["name", Concepts.Value.String "Alaric"]]
-      (projected |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes))
+      (bindings projected)
 
   module E = Kernel.EphemeralRelation.Make (S)
 
-  let store conn term =
-    E.persist conn ~name:"view" ~evaluator:Rnt.Evaluators.FOL.name
-      ~code:(Rnt.Evaluators.FOL.encode term)
-      (BatMap.String.singleton "name" {Protocols.Schematics.domain= "string"; provenance= []})
+  let store conn term = E.persist conn ~name:"stored" (Rnt.Evaluators.FOL.program term) heading
 
   let namespace entries =
     let open Utilities.Result in
@@ -141,21 +117,13 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     let projected =
       begin
         let open Utilities.Result in
-        let* employees = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
-        let* view =
-          store conn
-            Rnt.Evaluators.FOL.(
-              Project (Base Kernel.Path.("employee" @/ this), BatFingerTree.singleton "name") )
-        in
-        let* root = namespace ["employee", employees; "view", view] in
+        let* relation = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
+        let* stored = store conn names in
+        let* root = namespace ["employee", relation; "stored", stored] in
         let* plan =
-          Rnt.Evaluators.FOL.(
-            instantiate (Kernel.Path.lookup root) (Base Kernel.Path.("view" @/ this)) )
-        in
-        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
-        let* result =
-          Rnt.Evaluators.FOL.program plan |> Protocols.Evaluator.invoke evaluator ~within:nowhere
+          Rnt.Evaluators.FOL.(instantiate root (Base Kernel.Path.("stored" @/ this)))
         in
+        let* result = Rnt.Evaluators.FOL.execute plan in
         drain result
       end
       |> Helpers.condition_as_failure
@@ -164,39 +132,36 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       (list (list (pair string Helpers.value)))
       "the stored program ran in place of its name"
       [["name", Concepts.Value.String "Alaric"]]
-      (projected |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes))
+      (bindings projected)
 
-  let run_a_stored_program_within conn =
+  let run_a_program_within_a_state conn =
     let projected =
       begin
         let open Utilities.Result in
-        let* employees = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
-        let* view =
-          store conn
-            Rnt.Evaluators.FOL.(
-              Project (Base Kernel.Path.("employee" @/ this), BatFingerTree.singleton "name") )
-        in
-        let* root = namespace ["employee", employees] in
-        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
-        let* result = Protocols.Evaluator.invoke evaluator view ~within:root in
-        drain result
+        let* relation = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
+        let* evaluators = namespace ["fol", Rnt.Evaluators.FOL.make ()] in
+        let* system = namespace ["evaluator", evaluators] in
+        let* root = namespace ["system", system] in
+        let* within = namespace ["employee", relation] in
+        Kernel.EphemeralRelation.of_program ~within heading (Rnt.Evaluators.FOL.program ~root names)
+        |> drain
       end
       |> Helpers.condition_as_failure
     in
     check
       (list (list (pair string Helpers.value)))
-      "the stored source read its relations where it was told to"
+      "the program found its evaluator under the root and read the state it was given"
       [["name", Concepts.Value.String "Alaric"]]
-      (projected |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes))
+      (bindings projected)
 
   let refuse_a_program_that_reads_itself conn =
     let expanded =
       begin
         let open Utilities.Result in
-        let* view = store conn Rnt.Evaluators.FOL.(Base Kernel.Path.("view" @/ this)) in
-        let* root = namespace ["view", view] in
-        Rnt.Evaluators.FOL.(
-          instantiate (Kernel.Path.lookup root) (Base Kernel.Path.("view" @/ this)) )
+        let stored_path = Kernel.Path.("stored" @/ this) in
+        let* stored = store conn (Rnt.Evaluators.FOL.Base stored_path) in
+        let* root = namespace ["stored", stored] in
+        Rnt.Evaluators.FOL.(instantiate root (Base stored_path))
       end
     in
     check bool "the expansion stopped at the cycle" true
@@ -205,8 +170,42 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
           BatString.starts_with (Concepts.Condition.to_string_hum condition) "cyclic-program"
       | Ok _ -> false )
 
-  let pull_one_tuple_at_a_time () =
-    let produced = ref 0 and closed = ref false in
+  let shape modes =
+    List.map
+      (fun {Concepts.Mode.bound; yields} ->
+        BatSet.String.elements bound, Concepts.Cardinality.to_string yields )
+      modes
+
+  let a_projection_keeps_the_modes_it_can_bind conn =
+    let ask term f =
+      begin
+        let open Utilities.Result in
+        let* relation =
+          H.relation conn ["name"; "age"] [employee "Alaric" 42; employee "Brunhild" 30]
+        in
+        let* result = eval (directory ["employee", relation]) term in
+        Protocols.Handle.releasing result (fun () ->
+            Result.bind (Protocols.Relation.require result) f )
+      end
+      |> Helpers.condition_as_failure
+    in
+    let modes term = shape (ask term Protocols.Relation.modes) in
+    let holds term tuple = ask term (fun r -> Protocols.Relation.contains r tuple) in
+    check
+      (list (pair (list string) string))
+      "a base relation keeps the lookup by hash"
+      [[], "finite"; ["age"; "name"], "bounded(1)"]
+      (modes employees);
+    check
+      (list (pair (list string) string))
+      "its projection keeps only what a projected tuple can bind"
+      [[], "finite"]
+      (modes names);
+    check bool "the base decides by its own test" true (holds employees (employee "Alaric" 42));
+    check bool "the projection decides by reading" true (holds names (named "Alaric"));
+    check bool "and refuses a stranger" false (holds names (named "Gunther"))
+
+  let counter ?(produced = ref 0) ?(closed = ref false) () =
     let description =
       BatMap.String.singleton "value" {Protocols.Schematics.domain= "integer"; provenance= []}
     in
@@ -217,19 +216,19 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
           attributes= BatMap.String.singleton "value" (Concepts.Value.Integer n) };
       count ~yield (n + 1)
     in
-    let source =
-      Kernel.EphemeralRelation.instantiate description
-        {Kernel.EphemeralRelation.name= None; schematics= `Temporary description; program= None}
-        (fun () -> Ok (Kernel.Generator.cursor_of ~finally:(fun () -> closed := true) (count 0)))
-    in
+    Kernel.EphemeralRelation.instantiate description
+      ~modes:(fun () -> Ok [Concepts.(Mode.mode [] Cardinality.Countable)])
+      {Kernel.EphemeralRelation.name= None; schematics= `Temporary description; pointer= None}
+      (fun () -> Ok (Kernel.Generator.cursor_of ~finally:(fun () -> closed := true) (count 0)))
+
+  let values source = Rnt.Evaluators.FOL.(execute (Project (Base source, BatFingerTree.singleton "value")))
+
+  let pull_one_tuple_at_a_time () =
+    let produced = ref 0 and closed = ref false in
     let first =
       begin
         let open Utilities.Result in
-        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
-        let* result =
-          Rnt.Evaluators.FOL.(program (Project (Base source, BatFingerTree.singleton "value")))
-          |> Protocols.Evaluator.invoke evaluator ~within:nowhere
-        in
+        let* result = values (counter ~produced ~closed ()) in
         let* enumerable = Protocols.Enumerable.require result in
         let* cursor = Protocols.Enumerable.enumerate enumerable in
         let* scan = Protocols.Cursor.require cursor in
@@ -242,6 +241,48 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     check int "the source produced only that tuple" 1 !produced;
     check bool "and was closed with its consumer" true !closed
 
+  let an_endless_projection_cannot_decide () =
+    let asked =
+      begin
+        let open Utilities.Result in
+        let* result = values (counter ()) in
+        let* relation = Protocols.Relation.require result in
+        Protocols.Relation.contains relation
+          { Concepts.Tuple.type_= "counter";
+            attributes= BatMap.String.singleton "value" (Concepts.Value.Integer 7) }
+      end
+    in
+    check bool "it fails as undecidable instead of reading without end" true
+      ( match asked with
+      | Error condition ->
+          BatString.starts_with (Concepts.Condition.to_string_hum condition)
+            "undecidable-membership"
+      | Ok _ -> false )
+
+  let a_result_owns_the_relations_of_its_plan () =
+    let released = ref false in
+    let tracker =
+      Protocols.Handle.make
+        object
+          method reference = true
+          method release = released := true
+          method is_managed = false
+          method hash = Concepts.Hash.hash_of_int 0
+          method to_string = "tracker"
+          method protocols : Protocols.Handle.protocol list = []
+        end
+    in
+    let relation =
+      Kernel.EphemeralRelation.instantiate ~inputs:[tracker] heading
+        ~modes:(fun () -> Ok [])
+        {Kernel.EphemeralRelation.name= None; schematics= `Temporary heading; pointer= None}
+        (fun () -> Ok (Kernel.Generator.cursor_of (fun ~yield:_ -> Ok ())))
+    in
+    let result = Rnt.Evaluators.FOL.(execute (Base relation)) |> Helpers.condition_as_failure in
+    check bool "the relation in the plan lives as long as the result" false !released;
+    Protocols.Handle.release result;
+    check bool "and is released with it" true !released
+
   let suite =
     ( "evaluators/fol",
       [ test_case "scan-a-base-relation" `Quick (H.with_connection scan_a_base_relation "fol-test");
@@ -251,11 +292,16 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
           (H.with_connection instantiate_a_program "fol-test");
         test_case "expand-a-stored-program" `Quick
           (H.with_connection expand_a_stored_program "fol-test");
-        test_case "run-a-stored-program-within" `Quick
-          (H.with_connection run_a_stored_program_within "fol-test");
+        test_case "run-a-program-within-a-state" `Quick
+          (H.with_connection run_a_program_within_a_state "fol-test");
         test_case "refuse-a-program-that-reads-itself" `Quick
           (H.with_connection refuse_a_program_that_reads_itself "fol-test");
-        test_case "pull-one-tuple-at-a-time" `Quick pull_one_tuple_at_a_time ] )
+        test_case "a-projection-keeps-the-modes-it-can-bind" `Quick
+          (H.with_connection a_projection_keeps_the_modes_it_can_bind "fol-test");
+        test_case "pull-one-tuple-at-a-time" `Quick pull_one_tuple_at_a_time;
+        test_case "an-endless-projection-cannot-decide" `Quick an_endless_projection_cannot_decide;
+        test_case "a-result-owns-the-relations-of-its-plan" `Quick
+          a_result_owns_the_relations_of_its_plan ] )
 end
 
 module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator)
diff --git a/test/unit/kernel/Branch.ml b/test/unit/kernel/Branch.ml
index ebce298..606d8b7 100644
--- a/test/unit/kernel/Branch.ml
+++ b/test/unit/kernel/Branch.ml
@@ -11,23 +11,19 @@ let shelf = K.Scope.path library "shelf"
 let s v = C.Value.String v
 let title = BatMap.String.singleton "title" {P.Schematics.domain= "string"; provenance= []}
 
-let books titles =
-  K.EphemeralRelation.literal title
-    (List.map
-       (fun t -> {C.Tuple.type_= "book"; attributes= BatMap.String.singleton "title" (s t)})
-       titles )
+let book t = {C.Tuple.type_= "book"; attributes= BatMap.String.singleton "title" (s t)}
+let books titles = K.EphemeralRelation.literal title (List.map book titles)
 
 let titles relation = ok (Helpers.titles relation)
 let read root path = titles (ok (K.Path.lookup root path))
 
 (* shelf is a stored FOL program reading book where it is stored *)
 let shelved =
-  K.Source.view ~language:"fol" ~heading:title
-    ( Rnt.Evaluators.FOL.(encode (Base (K.Scope.path library "book")))
-    |> C.Blob.bytes_of_blob
-    |> Bytes.to_string )
+  K.EphemeralRelation.of_program title
+    Rnt.Evaluators.FOL.(program (Base (K.Scope.path library "book")))
 
-let publish root changes = ok (K.Scope.publish root ~branch:"master" ~home:library changes)
+let publish ?denials root changes =
+  ok (K.Scope.publish ?denials root ~branch:"master" ~home:library changes)
 
 let fresh books' =
   let root = ok (Rnt.Scratch.root ()) in
@@ -113,55 +109,162 @@ let a_scope_reads_names_from_its_home () =
   check (option string) "but not another relation's" None
     (K.Scope.attribute library "book" "shelf:title")
 
-(* A toy language answers a stored relation with its own name, and a run
-   with the source it was given. *)
-let a_stored_relation_is_viewed_and_a_program_run () =
+type K.Program.kind += Title of string | Endless | Shout of K.Path.t
+
+let endless () =
+  K.EphemeralRelation.instantiate title
+    ~modes:(fun () -> Ok [C.(Mode.mode [] Cardinality.Countable)])
+    {K.EphemeralRelation.name= None; schematics= `Temporary title; pointer= None}
+    (fun () ->
+      Ok
+        (K.Generator.cursor_of (fun ~yield ->
+             let rec from n = yield (book (string_of_int n)); from (n + 1) in
+             from 0 ) ) )
+
+(* A toy language: "endless" answers titles without end, "shout r" the
+   titles of relation r in capitals, and anything else itself as a title. *)
+let parse source =
+  match String.split_on_char ' ' source with
+  | ["endless"] -> Endless
+  | ["shout"; name] -> Shout (K.Scope.path library name)
+  | _ -> Title source
+
+let shout within path =
+  let open Rnt.Utilities.Result in
+  let* relation = K.Path.lookup within path in
+  let* heard = P.Handle.releasing relation (fun () -> Helpers.titles relation) in
+  Ok
+    (books
+       (List.filter_map
+          (function C.Value.String t -> Some (String.uppercase_ascii t) | _ -> None)
+          heard ) )
+
+let toy ?(evaluations = ref 0) () =
+  P.Handle.make
+    object (self)
+      inherit K.Lifecycle.null
+      inherit K.Identity.of_id
+      method to_string = "toy-evaluator"
+      method parse source = Ok (parse source)
+
+      method eval kind _ ~within =
+        incr evaluations;
+        match kind with
+        | Title text -> Ok (books [text])
+        | Endless -> Ok (endless ())
+        | Shout path -> shout within path
+        | _ -> Error (C.Condition.condition "foreign-program" "Not a toy program" C.Condition.empty)
+
+      method protocols : P.Handle.protocol list = [P.Evaluator.make self]
+    end
+
+let with_toys ?evaluations root =
+  ignore (ok (K.Initialization.mount root "toys"));
+  ignore
+    (ok
+       (K.Path.update root K.Path.("toys" @/ "evaluator" @/ this) "toy" None
+          (Some (toy ?evaluations ())) ) )
+
+let toy_program ?root evaluator source = K.Program.make ?root ~evaluator ~source (parse source)
+
+let run root program =
+  Result.bind (P.Executable.require program) (fun executable ->
+      P.Executable.invoke executable [] ~within:root )
+
+let a_program_runs_through_the_evaluator_it_names () =
   let root = fresh ["Codd"] in
-  let answer text = Ok (books [text]) in
-  let toy =
-    K.Source.evaluator ~language:"toy"
-      ~view:(fun ~within:_ ~name source -> answer (name ^ " of " ^ source))
-      (fun ~within:_ source -> answer source)
-  in
-  let _ = ok (K.Initialization.mount root "toys") in
-  ok (K.Source.register root ~scope:"toys" ~language:"toy" toy);
-  publish root ["named", Some (K.Source.view ~language:"toys:toy" ~heading:title "this")];
-  check (list Helpers.value) "read from the branch, the view is asked for it by name"
-    [s "named of this"]
+  with_toys root;
+  publish root
+    ["named", Some (K.EphemeralRelation.of_program title (toy_program "toys:toy" "this"))];
+  check (list Helpers.value) "stored in a branch and read back, it runs"
+    [s "this"]
     (read root (under master (K.Scope.path library "named")));
-  check (list Helpers.value) "run, the program is just run"
+  check (list Helpers.value) "run directly, it runs"
     [s "that"]
-    (titles (ok (K.Source.run root ~language:"toys:toy" ~within:root "that")));
+    (titles (ok (run root (toy_program ~root "toys:toy" "that"))));
   check bool "an unqualified name is the system's" true
-    (Result.is_error (K.Source.run root ~language:"toy" ~within:root "that"))
+    (Result.is_error (run root (toy_program ~root "toy" "that")))
+
+(* shelf, from fresh, is a FOL program reading book *)
+let evaluators_read_each_other () =
+  let root = fresh ["Codd"] in
+  with_toys root;
+  let stored name program = name, Some (K.EphemeralRelation.of_program title program) in
+  publish root
+    [ stored "toy-shelf" (toy_program "toys:toy" "Date");
+      stored "fol-over-toy" Rnt.Evaluators.FOL.(program (Base (K.Scope.path library "toy-shelf")));
+      stored "toy-over-fol" (toy_program "toys:toy" "shout shelf") ];
+  check (list Helpers.value) "FOL reads the relation a toy program generates"
+    [s "Date"]
+    (read root (under master (K.Scope.path library "fol-over-toy")));
+  check (list Helpers.value) "a toy program shouts the relation a FOL program generates"
+    [s "CODD"]
+    (read root (under master (K.Scope.path library "toy-over-fol")))
 
 (* shelf, stored as a denial, says no book may be shelved *)
-let a_head_moves_only_to_a_valid_state () =
+let denied state = List.map fst (ok (P.Admission.check (ok (P.Admission.require state))))
+let no_books = "\\multigroup\\library\\denial\\no-books"
+
+let a_head_moves_only_to_an_admitted_state () =
   let root = fresh [] in
-  publish root ["denial:no-books", Some shelved];
+  publish root ~denials:["no-books", Some shelved] [];
   let head = ok (K.Path.lookup root master) in
+  check (list string) "the head is admitted" [] (denied head);
   let proposed =
-    ok
-      (K.Path.assoc_all head
-         [ ( K.Path.("multigroup" @/ "library" @/ "schema" @/ "default" @/ "relation" @/ this),
-             "book",
-             Some (books ["Codd"]) ) ] )
+    ok (K.Path.assoc_all head [K.Scope.relations library, "book", Some (books ["Codd"])])
   in
-  check bool "a state with a book is judged invalid without landing" true
-    (Result.is_error (K.Denial.check proposed));
+  check (list string) "a state with a book is not, and says by which denial" [no_books]
+    (denied proposed);
   check bool "publishing it is refused" true
     (Result.is_error
        (K.Scope.publish root ~branch:"master" ~home:library ["book", Some (books ["Codd"])]) );
   check bool "and the head stays" true
     (C.Hash.hash_equals (address head) (address (ok (K.Path.lookup root master))))
 
+(* a denial of multigroup audit reads library's books *)
+let a_rule_spans_multigroups () =
+  let root = fresh [] in
+  publish root ~denials:["audit:no-books", Some shelved] ["loan", Some (books ["Codd"])];
+  check bool "a commit to library is judged by audit" true
+    (Result.is_error
+       (K.Scope.publish root ~branch:"master" ~home:library ["book", Some (books ["Codd"])]) );
+  check (list Helpers.value) "one audit's denial does not mind lands"
+    [s "Codd"]
+    (read root (under master (K.Scope.path library "loan")))
+
+let a_denial_without_end_cannot_be_installed () =
+  let root = fresh [] in
+  with_toys root;
+  let endless = K.EphemeralRelation.of_program title (toy_program "toys:toy" "endless") in
+  match K.Scope.publish root ~branch:"master" ~home:library ~denials:["endless", Some endless] [] with
+  | Ok () -> fail "a denial without end was installed"
+  | Error condition ->
+      check bool "the state holding it cannot be judged" true
+        (BatString.starts_with (C.Condition.to_string_hum condition) "unjudgeable-denial")
+
+let a_denial_program_runs_once_per_judgement () =
+  let root = fresh [] in
+  let evaluations = ref 0 in
+  with_toys ~evaluations root;
+  let dated = K.EphemeralRelation.of_program title (toy_program "toys:toy" "Date") in
+  check bool "a denial holding a book refuses the commit" true
+    (Result.is_error
+       (K.Scope.publish root ~branch:"master" ~home:library ~denials:["dated", Some dated] []) );
+  check int "and its program ran once to judge it" 1 !evaluations
+
 let suites () =
   [ ( "kernel/branch",
       [ test_case "reads-as-of-each-state" `Quick reads_as_of_each_state;
         test_case "a-batch-is-one-successor" `Quick a_batch_is_one_successor;
         test_case "unbinding-removes-a-relation" `Quick unbinding_removes_a_relation;
         test_case "a-scope-reads-names-from-its-home" `Quick a_scope_reads_names_from_its_home;
-        test_case "a-stored-relation-is-viewed-and-a-program-run" `Quick
-          a_stored_relation_is_viewed_and_a_program_run;
-        test_case "a-head-moves-only-to-a-valid-state" `Quick a_head_moves_only_to_a_valid_state ] )
-  ]
+        test_case "a-program-runs-through-the-evaluator-it-names" `Quick
+          a_program_runs_through_the_evaluator_it_names;
+        test_case "evaluators-read-each-other" `Quick evaluators_read_each_other;
+        test_case "a-head-moves-only-to-an-admitted-state" `Quick
+          a_head_moves_only_to_an_admitted_state;
+        test_case "a-rule-spans-multigroups" `Quick a_rule_spans_multigroups;
+        test_case "a-denial-without-end-cannot-be-installed" `Quick
+          a_denial_without_end_cannot_be_installed;
+        test_case "a-denial-program-runs-once-per-judgement" `Quick
+          a_denial_program_runs_once_per_judgement ] ) ]
diff --git a/test/unit/kernel/EphemeralRelation.ml b/test/unit/kernel/EphemeralRelation.ml
index 7f113ef..c9742f0 100644
--- a/test/unit/kernel/EphemeralRelation.ml
+++ b/test/unit/kernel/EphemeralRelation.ml
@@ -12,11 +12,21 @@ let description =
     { Protocols.Schematics.domain= "integer";
       provenance= [{Protocols.Schematics.source= ["example"]; attribute= "value"}] }
 
-let temporary = {Ephemeral.name= None; schematics= `Temporary description; program= None}
+let temporary = {Ephemeral.name= None; schematics= `Temporary description; pointer= None}
 
 let over ?inputs ?(value = temporary) members =
-  Ephemeral.instantiate ?inputs description value (fun () ->
-      Ok (Rnt.Kernel.Generator.cursor_of (fun ~yield -> List.iter yield members; Ok ())) )
+  Ephemeral.instantiate ?inputs description value
+    ~modes:(fun () -> Ok [Concepts.(Mode.mode [] (Cardinality.bounded (List.length members)))])
+    (fun () -> Ok (Rnt.Kernel.Generator.cursor_of (fun ~yield -> List.iter yield members; Ok ())))
+
+let endless () =
+  Ephemeral.instantiate description temporary
+    ~modes:(fun () -> Ok [Concepts.(Mode.mode [] Cardinality.Countable)])
+    (fun () ->
+      Ok
+        (Rnt.Kernel.Generator.cursor_of (fun ~yield ->
+             let rec from n = yield (member n); from (n + 1) in
+             from 0 ) ) )
 
 let values tuples =
   BatFingerTree.to_list tuples
@@ -55,6 +65,17 @@ let decides_membership () =
   check bool "a member is held" true holds;
   check bool "a stranger is refused" false rejects
 
+let refuses_to_scan_without_end () =
+  match Protocols.Relation.require (endless ()) with
+  | Error condition -> fail (Concepts.Condition.to_string_hum condition)
+  | Ok relation -> (
+    match Protocols.Relation.contains relation (member 9) with
+    | Error condition ->
+        check bool "it fails as undecidable instead of scanning" true
+          (BatString.starts_with (Concepts.Condition.to_string_hum condition)
+             "undecidable-membership" )
+    | Ok _ -> fail "an endless relation with no test decided membership" )
+
 let describes_itself () =
   let described =
     begin
@@ -83,7 +104,7 @@ let addressed_once_persisted () =
   let persisted code =
     { Ephemeral.name= Some "example";
       schematics= `Persisted (Concepts.Hash.hash_of_int 1);
-      program= Some {Ephemeral.evaluator= "fol"; code= Concepts.Hash.hash_of_int code} }
+      pointer= Some {Ephemeral.evaluator= "fol"; code= Concepts.Hash.hash_of_int code} }
   in
   let address value =
     Protocols.Addressable.from (over ~value []) |> Option.map Protocols.Addressable.address
@@ -97,9 +118,9 @@ let releasing_releases_its_inputs () =
   let released = ref false in
   let input =
     object
-      method reference = true
-      method release = released := true
-      method hash = Concepts.Hash.hash_of_int 0
+      inherit Rnt.Kernel.Lifecycle.null
+      inherit Rnt.Kernel.Identity.of_id
+      method! release = released := true
       method to_string = "input"
       method protocols : Protocols.Handle.protocol list = []
     end
@@ -113,6 +134,7 @@ let suites () =
   [ ( "kernel/ephemeral-relation",
       [ test_case "enumerates-every-member" `Quick enumerates_every_member;
         test_case "decides-membership" `Quick decides_membership;
+        test_case "refuses-to-scan-without-end" `Quick refuses_to_scan_without_end;
         test_case "describes-itself" `Quick describes_itself;
         test_case "addressed-once-persisted" `Quick addressed_once_persisted;
         test_case "releasing-releases-its-inputs" `Quick releasing_releases_its_inputs ] ) ]
diff --git a/test/unit/kernel/Session.ml b/test/unit/kernel/Session.ml
index 79ad5a2..edb22c4 100644
--- a/test/unit/kernel/Session.ml
+++ b/test/unit/kernel/Session.ml
@@ -25,7 +25,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
         let* _ = update root ("system" @/ "branch" @/ this) "client" None (Some branch) in
         let* tip = address branch in
         let session = Session.make conn {Protocols.Session.snapshot= tip} in
-        let* _ = update root ("system" @/ "session" @/ this) "client" None (Some session) in
+        let* _ = update root ("system" @/ "session" @/ this) "client" None (Protocols.Handle.copy session) in
         let library =
           "system" @/ "session" @/ "client" @/ "branch" @/ "multigroup" @/ "library" @/ this
         in
@@ -55,32 +55,9 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     check bool "the session reconstructs the pinned branch" true pinned;
     check bool "the session refuses derivation through it" true refused
 
-  let single_handle conn =
-    let refused, reacquired =
-      begin
-        let open Utilities.Result in
-        let open Rnt.Kernel.Path in
-        let* root = I.initialize conn in
-        let* branch = B.make conn in
-        let* tip = address branch in
-        let session = Session.make conn {Protocols.Session.snapshot= tip} in
-        let* _ = update root ("system" @/ "session" @/ this) "client" None (Some session) in
-        let client = "system" @/ "session" @/ "client" @/ this in
-        let* _ = lookup root ("system" @/ "session" @/ "client" @/ "branch" @/ this) in
-        let* held = lookup root client in
-        let refused = finds root client in
-        Protocols.Handle.release held;
-        Ok (refused, finds root client)
-      end
-      |> Helpers.condition_as_failure
-    in
-    check bool "a second handle to the session is refused" false refused;
-    check bool "releasing the handle frees the session" true reacquired
-
   let suite =
     ( "kernel/session",
-      [ test_case "pin-and-follow" `Quick (H.with_connection pin_and_follow "session-test");
-        test_case "single-handle" `Quick (H.with_connection single_handle "session-single-test") ] )
+      [test_case "pin-and-follow" `Quick (H.with_connection pin_and_follow "session-test")] )
 end
 
 module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator)