RPC: add a hash+N and a hash-N notations

src/lib_shell/block_directory.ml

@@ -339,12 +339,26 @@ let get_block chain_state = function
       Chain.genesis chain_state
   |  `Head n ->
       Chain.head chain_state >>= fun head ->
-      if n = 0 then
+      if n < 0 then
+        Lwt.fail Not_found
+      else if n = 0 then
         Lwt.return head
       else
         State.Block.read_exn chain_state ~pred:n (State.Block.hash head)
   | `Hash (hash, n) ->
-      State.Block.read_exn chain_state ~pred:n hash
+      if n < 0 then
+        State.Block.read_exn chain_state hash >>= fun block ->
+        Chain.head chain_state >>= fun head ->
+        let head_level = State.Block.level head in
+        let block_level = State.Block.level block in
+        let target =
+          Int32.(to_int (sub head_level (sub block_level (of_int n)))) in
+        if target < 0 then
+          Lwt.fail Not_found
+        else
+          State.Block.read_exn chain_state ~pred:target (State.Block.hash head)
+      else
+        State.Block.read_exn chain_state ~pred:n hash
   | `Level i ->
       Chain.head chain_state >>= fun head ->
       let target = Int32.(to_int (sub (State.Block.level head) i)) in

src/lib_shell_services/block_services.ml

@@ -61,12 +61,27 @@ type block = [
 ]
 
 let parse_block s =
+  let delims = ['~';'-';'+'] in
+  let count_delims s =
+    List.map
+      (fun d ->
+         (String.fold_left (fun i c -> if c = d then i+1 else i) 0 s), d)
+      delims in
+  let split_on_delim counts =
+    begin
+      match List.fold_left (fun i (v,_) -> i+v) 0 counts with
+      | 0 -> ([s], ' ')
+      | 1 -> let delim = List.assoc 1 counts in
+          (String.split delim s, delim)
+      | _ -> raise Exit
+    end in
   try
-    match String.split '~' s with
+    match split_on_delim (count_delims s) with
-    | ["genesis"] -> Ok `Genesis
+    | (["genesis"],_) -> Ok `Genesis
-    | ["head"] -> Ok (`Head 0)
+    | (["head"],_) -> Ok (`Head 0)
-    | ["head"; n] -> Ok (`Head (int_of_string n))
+    | (["head"; n],'~') -> Ok (`Head (int_of_string n))
-    | [hol] ->
+    | (["head"; n],'-') -> Ok (`Head (int_of_string n))
+    | ([hol],_) ->
         begin
           match Block_hash.of_b58check_opt hol with
             Some h -> Ok (`Hash (h , 0))
@@ -75,15 +90,19 @@ let parse_block s =
               if Int32.(compare l (of_int 0)) < 0 then raise Exit
               else Ok (`Level (Int32.of_string s))
         end
-    | [h ; n] -> Ok (`Hash (Block_hash.of_b58check_exn h, int_of_string n))
+    | ([h ; n],'~') -> Ok (`Hash (Block_hash.of_b58check_exn h, int_of_string n))
+    | ([h ; n],'-') -> Ok (`Hash (Block_hash.of_b58check_exn h, int_of_string n))
+    | ([h ; n],'+') -> Ok (`Hash (Block_hash.of_b58check_exn h, - int_of_string n))
     | _ -> raise Exit
   with _ -> Error "Cannot parse block identifier."
 
 let to_string = function
   | `Genesis -> "genesis"
   | `Head 0 -> "head"
+  | `Head n when n < 0 -> Printf.sprintf "head+%d" (-n)
   | `Head n -> Printf.sprintf "head~%d" n
   | `Hash (h, 0) -> Block_hash.to_b58check h
+  | `Hash (h, n) when n < 0 -> Printf.sprintf "%s+%d" (Block_hash.to_b58check h) (-n)
   | `Hash (h, n) -> Printf.sprintf "%s~%d" (Block_hash.to_b58check h) n
   | `Level i -> Printf.sprintf "%d" (Int32.to_int i)
 
@@ -93,8 +112,9 @@ let blocks_arg =
     "A block identifier. This is either a block hash in Base58Check notation, \
      one the predefined aliases: 'genesis', 'head' \
      or a block level (index in the chain). \
-     One might alse use 'head~N' or '<hash>~N' where N is an integer to \
+     One might also use 'head~N' or '<hash>~N' where N is an integer to \
-     denotes the Nth predecessors of the designated block." in
+     denotes the Nth predecessor of the designated block.\
+     Also, '<hash>+N' denotes the Nth successor of a block." in
   let construct = to_string in
   let destruct = parse_block in
   RPC_arg.make ~name ~descr ~construct ~destruct ()