RPC: rebind 'complete' for blocks and operations.

This commit is contained in:
Grégoire Henry 2017-03-30 17:19:59 +02:00
parent deec250be7
commit ffc8fa0383
4 changed files with 60 additions and 19 deletions

View File

@ -12,8 +12,6 @@ open Store_sigs
type t = Raw_store.t
type global_store = t
let init = Raw_store.init
(**************************************************************************
* Net store under "net/"
**************************************************************************)
@ -184,6 +182,7 @@ module Make_data_store
Store_helpers.Make_indexed_substore
(Store_helpers.Make_substore (S) (struct let name = ["data"] end))
(I)
module Discovery_time =
Indexed_store.Make_map
(struct let name = ["discovery_time"] end)
@ -213,6 +212,7 @@ module Make_data_store
(Indexed_store.Store)
(struct let name = ["validation_time"] end)
(Store_helpers.Make_value(Time))
end
@ -270,6 +270,16 @@ module Operation = struct
(Value)
(Operation_hash.Set)
let register s =
Base58.register_resolver Operation_hash.b58check_encoding begin fun str ->
let pstr = Operation_hash.prefix_path str in
Net.Indexed_store.fold_indexes s ~init:[]
~f:begin fun net acc ->
Indexed_store.resolve_index (s, net) pstr >>= fun l ->
Lwt.return (List.rev_append l acc)
end
end
end
@ -381,6 +391,16 @@ module Block_header = struct
let encoding = Operation_list_list_hash.path_encoding
end))
let register s =
Base58.register_resolver Block_hash.b58check_encoding begin fun str ->
let pstr = Block_hash.prefix_path str in
Net.Indexed_store.fold_indexes s ~init:[]
~f:begin fun net acc ->
Indexed_store.resolve_index (s, net) pstr >>= fun l ->
Lwt.return (List.rev_append l acc)
end
end
end
@ -458,5 +478,19 @@ module Protocol = struct
(Store_helpers.Make_value(Tezos_compiler.Protocol))
(Protocol_hash.Set)
let register s =
Base58.register_resolver Protocol_hash.b58check_encoding begin fun str ->
let pstr = Protocol_hash.prefix_path str in
Indexed_store.resolve_index s pstr
end
end
let init dir =
Raw_store.init dir >>=? fun s ->
Block_header.register s ;
Operation.register s ;
Protocol.register s ;
return s

View File

@ -119,7 +119,7 @@ module Make_indexed_substore (S : STORE) (I : INDEX) = struct
let list t k = S.fold t k ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc))
let resolve_index t prefix =
let rec loop i prefix = function
| [] when i >= I.path_length -> begin
| [] when i = I.path_length -> begin
match I.of_path prefix with
| None -> assert false
| Some path -> Lwt.return [path]
@ -129,7 +129,7 @@ module Make_indexed_substore (S : STORE) (I : INDEX) = struct
Lwt_list.map_p (function
| `Key prefix | `Dir prefix -> loop (i+1) prefix []) prefixes
>|= List.flatten
| [d] ->
| [d] when i = I.path_length - 1 ->
if (i >= I.path_length) then invalid_arg "IO.resolve" ;
list t prefix >>= fun prefixes ->
Lwt_list.map_p (function
@ -139,6 +139,11 @@ module Make_indexed_substore (S : STORE) (I : INDEX) = struct
| Some _ -> loop (i+1) prefix [])
prefixes
>|= List.flatten
| "" :: ds ->
list t prefix >>= fun prefixes ->
Lwt_list.map_p (function
| `Key prefix | `Dir prefix -> loop (i+1) prefix ds) prefixes
>|= List.flatten
| d :: ds ->
if (i >= I.path_length) then invalid_arg "IO.resolve" ;
S.known_dir t (prefix @ [d]) >>= function

View File

@ -253,19 +253,19 @@ module MakeResolvers(R: sig
partial_decode ?alphabet request encoding.encoded_length in
let len = String.length prefix in
let ignored = String.length encoding.prefix in
if len <= ignored then
Lwt.return_nil
else begin
assert (String.sub prefix 0 ignored = encoding.prefix) ;
let msg = String.sub prefix ignored (len - ignored) in
resolver context msg >|= fun msgs ->
filter_map
(fun msg ->
let res = simple_encode encoding ?alphabet msg in
Utils.remove_prefix ~prefix:request res |>
Utils.map_option ~f:(fun _ -> res))
msgs
end in
let msg =
if len <= ignored then ""
else begin
assert (String.sub prefix 0 ignored = encoding.prefix) ;
String.sub prefix ignored (len - ignored)
end in
resolver context msg >|= fun msgs ->
filter_map
(fun msg ->
let res = simple_encode encoding ?alphabet msg in
Utils.remove_prefix ~prefix:request res |>
Utils.map_option ~f:(fun _ -> res))
msgs in
find request !resolvers
end

View File

@ -146,7 +146,9 @@ let test_expand s =
Base58.complete (Block_hash.to_short_b58check bh2) >>= fun res ->
Assert.equal_string_list ~msg:__LOC__ res [Block_hash.to_b58check bh2] ;
Base58.complete (Block_hash.to_short_b58check bh3) >>= fun res ->
Assert.equal_string_list ~msg:__LOC__ res [Block_hash.to_b58check bh3] ;
Assert.equal_string_list ~msg:__LOC__
(List.sort String.compare res)
[Block_hash.to_b58check bh3' ; Block_hash.to_b58check bh3] ;
Lwt.return_unit
@ -431,7 +433,7 @@ let tests_raw : (string * (Raw_store.t -> unit Lwt.t)) list = [
let tests : (string * (Store.t -> unit Lwt.t)) list = [
(* "expand", test_expand ; *) (* FIXME GRGR *)
"expand", test_expand ;
"operation", test_operation ;
"block", test_block ;
]