diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/kernel/BranchManager.ml | 20 |
1 files changed, 18 insertions, 2 deletions
diff --git a/lib/kernel/BranchManager.ml b/lib/kernel/BranchManager.ml index 4d2fb1d..206aae9 100644 --- a/lib/kernel/BranchManager.ml +++ b/lib/kernel/BranchManager.ml @@ -6,8 +6,24 @@ module Error = struct "The root hash for the database state is missing from the backend. Either your storage is \ corrupted, or this is a bug in RNT!" ("hash" |=| Concepts.Value.String (Concepts.Hash.to_hum_string head)) + + let refused violations = + condition "refused" "The state is not admitted: a denial in it holds tuples" + (List.fold_left + (fun ps (path, tuples) -> + ps + & path + |=| Concepts.Value.String + (String.concat "; " (List.map Concepts.Tuple.to_string tuples)) ) + empty violations ) end +let admitted state = + let open Utilities.Result in + let* admission = Protocols.Admission.require state in + let* violations = Protocols.Admission.check admission in + if violations = [] then Ok () else Error (Error.refused violations) + module Make (S : Abstract.Storage.STORAGE) = struct module M = Merkle.Make (S) (Merkle.StringKey) module SI = Storage.Make (S) @@ -53,12 +69,12 @@ module Make (S : Abstract.Storage.STORAGE) = struct | None -> Ok None | Some head -> B.load ?root tx storage head |> Result.map Option.some ) - (* a head moves only to a valid state, judged before the head is + (* a head moves only to an admitted state, judged before the head is taken, since judging may run stored programs that read storage *) method update key reference value = let open Utilities.Result in let open Protocols in - let* () = Option.fold ~none:(Ok ()) ~some:Denial.check value in + let* () = Option.fold ~none:(Ok ()) ~some:admitted value in SI.with_transaction storage (fun tx -> match Utilities.Atomic.mswap head (fun head -> |