diff options
Diffstat (limited to 'lib/kernel')
| -rw-r--r-- | lib/kernel/Initialization.ml | 25 | ||||
| -rw-r--r-- | lib/kernel/Storage.ml | 22 | ||||
| -rw-r--r-- | lib/kernel/Storage.mli | 5 |
3 files changed, 30 insertions, 22 deletions
diff --git a/lib/kernel/Initialization.ml b/lib/kernel/Initialization.ml index 375070f..d84a29e 100644 --- a/lib/kernel/Initialization.ml +++ b/lib/kernel/Initialization.ml @@ -30,20 +30,7 @@ let address_of_blob blob = module Make (Store : Abstract.Storage.STORAGE) = struct module Branch_index = BranchIndex.Make (Store) - - let finish tx = function - | Ok value -> - let open Utilities.Result in - let* () = Store.commit tx in - Ok value - | Error condition -> - let _ = Store.abort tx in - Error condition - - let with_transaction connection body = - let open Utilities.Result in - let* tx = Store.start connection in - body tx |> finish tx + module S = Storage.Make (Store) let read_in_transaction tx = let open Utilities.Result in @@ -58,12 +45,6 @@ module Make (Store : Abstract.Storage.STORAGE) = struct | None -> Error (Error.missing_branch_index root) end - let store_blob tx blob = - let open Utilities.Result in - let address = Concepts.Hash.hash_of_blob blob in - let* () = Store.put tx address blob in - Ok address - let store_fixed_root tx root = Store.put tx fixed_label_address (address_to_blob root) let create_initial_branch_state tx = @@ -74,7 +55,7 @@ module Make (Store : Abstract.Storage.STORAGE) = struct let* empty_root = Branch_index.persist tx Branch_index.empty in Concepts.BranchState.make ~current:empty_root ~history:empty_root ~tip:None |> Concepts.BranchState.to_blob - |> store_blob tx + |> S.store_blob tx let ensure_default_branch tx root branch_index = let open Utilities.Result in @@ -101,7 +82,7 @@ module Make (Store : Abstract.Storage.STORAGE) = struct Ok root let initialize connection = - with_transaction connection (fun tx -> + S.with_transaction connection (fun tx -> let open Utilities.Result in let* current = read_in_transaction tx in match current with diff --git a/lib/kernel/Storage.ml b/lib/kernel/Storage.ml new file mode 100644 index 0000000..952b306 --- /dev/null +++ b/lib/kernel/Storage.ml @@ -0,0 +1,22 @@ +module Make (S : Abstract.Storage.STORAGE) = struct + let finish tx = function + | Ok value -> + let open Utilities.Result in + let* () = S.commit tx in + Ok value + | Error condition -> + let _ = S.abort tx in + Error condition + + let with_transaction connection body = + let open Utilities.Result in + let* tx = S.start connection in + body tx |> finish tx + + let store_blob tx blob = + let open Utilities.Result in + let address = Concepts.Hash.hash_of_blob blob in + let* () = S.put tx address blob in + Ok address + +end diff --git a/lib/kernel/Storage.mli b/lib/kernel/Storage.mli new file mode 100644 index 0000000..3ef1ffc --- /dev/null +++ b/lib/kernel/Storage.mli @@ -0,0 +1,5 @@ +module Make : functor (S : Abstract.Storage.STORAGE) -> sig + val finish : S.transaction -> ('a, Concepts.Condition.condition) result -> ('a, Concepts.Condition.condition) result + val with_transaction : S.connection -> (S.transaction -> ('a, Concepts.Condition.condition) result) -> ('a, Concepts.Condition.condition) result + val store_blob : S.transaction -> Concepts.Representation.blob -> (Concepts.Hash.hash, Concepts.Condition.condition) result +end |
