aboutsummaryrefslogtreecommitdiffstats
path: root/lib/kernel/Storage.ml
blob: e6a84ba7528778fb5ef1aa4400ad8fee1a1b2c41 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
module Make (S : Abstract.Storage.STORAGE) = struct
  module Pointer = struct
    type 'a t = {
      addr : S.address;
      loader : S.transaction -> S.address -> ('a, Concepts.Condition.condition) result
    }

    let make addr loader = { addr; loader }
    let address_of { addr; _ } = addr
    let swap { loader; _ } addr = make addr loader
    let deref tx { addr; loader } = loader tx addr
  end

  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 (S.Hash address) blob in
    Ok address

end