Merge branch 'mnichols-multisig-rpc' into 'master'

multisig via rpc

See merge request !33

src/lib/interactive_mini_network.ml

@@ -176,8 +176,8 @@ let run_wait_level protocol state nodes opt lvl =
 
 let run state ~protocol ~size ~base_port ~clear_root ~no_daemons_for ?hard_fork
     ~genesis_block_choice ?external_peer_ports ~nodes_history_mode_edits
-    ~with_baking ?generate_kiln_config node_exec client_exec baker_exec
-    endorser_exec accuser_exec test_kind () =
+    ?generate_kiln_config node_exec client_exec baker_exec endorser_exec
+    accuser_exec test_kind () =
   ( if clear_root then
     Console.say state EF.(wf "Clearing root: `%s`" (Paths.root state))
     >>= fun () -> Helpers.clear_root state
@@ -189,7 +189,8 @@ let run state ~protocol ~size ~base_port ~clear_root ~no_daemons_for ?hard_fork
   Helpers.System_dependencies.precheck state `Or_fail
     ~executables:
       ( [node_exec; client_exec]
-      @ (if with_baking then [baker_exec; endorser_exec; accuser_exec] else [])
+      @ ( if state#test_baking then [baker_exec; endorser_exec; accuser_exec]
+        else [] )
       @ Option.value_map hard_fork ~default:[] ~f:Hard_fork.executables )
   >>= fun () ->
   Console.say state EF.(wf "Starting up the network.")
@@ -263,7 +264,7 @@ let run state ~protocol ~size ~base_port ~clear_root ~no_daemons_for ?hard_fork
       [ generate_traffic_command state
           ~clients:(List.map keys_and_daemons ~f:(fun (_, _, kc, _) -> kc))
           ~nodes ] ;
-  ( if with_baking then
+  ( if state#test_baking then
     let accusers =
       List.map nodes ~f:(fun node ->
           let client = Tezos_client.of_node node ~exec:client_exec in
@@ -330,12 +331,12 @@ let run state ~protocol ~size ~base_port ~clear_root ~no_daemons_for ?hard_fork
       @ arbitrary_commands_for_each_and_all_clients state ~clients) ;
   match test_kind with
   | `Interactive ->
-      Interactive_test.Pauser.generic ~force:true state
+      Interactive_test.Pauser.generic state ~force:true
         EF.[haf "Sandbox is READY \\o/"]
   | `Dsl_traffic (`Dsl_command dsl_command, `After `Interactive) ->
       run_dsl_cmd state keyed_clients nodes dsl_command
       >>= fun () ->
-      Interactive_test.Pauser.generic ~force:true state
+      Interactive_test.Pauser.generic state ~force:true
         EF.[haf "Sandbox is READY \\o/"]
   | `Dsl_traffic (`Dsl_command dsl_command, `After (`Until lvl)) ->
       run_dsl_cmd state keyed_clients nodes dsl_command
@@ -366,7 +367,6 @@ let cmd () =
            base_port
            (`External_peers external_peer_ports)
            (`No_daemons_for no_daemons_for)
-           (`With_baking with_baking)
            protocol
            bnod
            bcli
@@ -381,7 +381,7 @@ let cmd () =
            ->
         let actual_test =
           run state ~size ~base_port ~protocol bnod bcli bak endo accu
-            ?hard_fork ~clear_root ~nodes_history_mode_edits ~with_baking
+            ?hard_fork ~clear_root ~nodes_history_mode_edits
             ?generate_kiln_config ~external_peer_ports ~no_daemons_for
             ~genesis_block_choice test_kind in
         Test_command_line.Run_command.or_hard_fail state ~pp_error
@@ -459,14 +459,6 @@ let cmd () =
             (opt_all string []
                (info ["no-daemons-for"] ~docv:"ACCOUNT-NAME" ~docs
                   ~doc:"Do not start daemons for $(docv).")))
-    $ Arg.(
-        pure (fun x -> `With_baking (not x))
-        $ value
-            (flag
-               (info ["no-baking"] ~docs
-                  ~doc:
-                    "Completely disable baking/endorsing/accusing (you need \
-                     to bake manually to make the chain advance).")))
     $ Tezos_protocol.cli_term base_state
     $ Tezos_executable.cli_term base_state `Node "tezos"
     $ Tezos_executable.cli_term base_state `Client "tezos"

src/lib/interactive_test.ml

@@ -36,7 +36,7 @@ module Commands = struct
         let all = flag "all" sxp in
         Console.say state (Running_processes.ef ~all state))
 
-  let curl_rpc state ~port ~path =
+  let curl_rpc_cmd state ~port ~path =
     Running_processes.run_cmdf state "curl http://localhost:%d/%s" port path
     >>= fun curl_res ->
     Console.display_errors_of_command state curl_res ~should_output:true
@@ -82,7 +82,7 @@ module Commands = struct
         >>= fun port ->
         get_pp_json state sexps
         >>= fun pp_json ->
-        curl_rpc state ~port ~path
+        curl_rpc_cmd state ~port ~path
         >>= fun json_opt ->
         do_jq ~msg:doc state json_opt ~f:jq
         >>= fun processed_json ->
@@ -202,11 +202,12 @@ module Commands = struct
       (fun sexps ->
         Sexp_options.port_number state sexps ~default_port
         >>= fun port ->
-        curl_rpc state ~port ~path:"/chains/main/blocks/head/context/contracts"
+        curl_rpc_cmd state ~port
+          ~path:"/chains/main/blocks/head/context/contracts"
         >>= fun json_opt ->
         do_jq state ~msg:"Getting contract list" ~f:Jqo.get_strings json_opt
         >>= fun contracts ->
-        curl_rpc state ~port ~path:"/chains/main/checkpoint"
+        curl_rpc_cmd state ~port ~path:"/chains/main/checkpoint"
         >>= fun chkpto ->
         do_jq state chkpto ~msg:"Getting checkpoint"
           ~f:
@@ -222,7 +223,7 @@ module Commands = struct
           let path =
             sprintf "/chains/main/blocks/%s/context/contracts/%s/balance" block
               contract in
-          curl_rpc state ~port ~path
+          curl_rpc_cmd state ~port ~path
           >>= fun jo ->
           do_jq state jo ~msg:"Getting balance" ~f:(fun j ->
               Jqo.get_string j |> Int.of_string) in
@@ -257,7 +258,8 @@ module Commands = struct
       (fun sexps ->
         Sexp_options.port_number state sexps ~default_port
         >>= fun port ->
-        curl_rpc state ~port ~path:"/chains/main/blocks/head/context/contracts"
+        curl_rpc_cmd state ~port
+          ~path:"/chains/main/blocks/head/context/contracts"
         >>= fun json_opt ->
         do_jq state ~msg:"Getting contract list" ~f:Jqo.get_strings json_opt
         >>= fun contracts ->
@@ -493,7 +495,7 @@ module Commands = struct
           | _ -> Fmt.kstrf failwith "Wrong command line: %a" pp (List sexps)
         in
         protect_with_keyed_client "manual-forge" ~client ~f:(fun () ->
-            Traffic_generation.Commands.branch state client
+            Traffic_generation.branch state client
             >>= fun branch ->
             Tezos_client.get_account state ~client:client.client
               ~name:client.key_name
@@ -597,7 +599,7 @@ module Commands = struct
                       cut ppf () ;
                       Sexp_options.pp_options options ppf ()) in
                 fun ppf () ->
-                  pf ppf "Generating traffic: TODO" ;
+                  pf ppf "Generating traffic:" ;
                   cmd ppf "batch"
                     (const text "Make a batch operation (simple transfers).")
                     [counter_option; size_option; fee_option] ;
@@ -619,7 +621,7 @@ module Commands = struct
                     [level_option])
         | Atom "endorsement" :: more_args ->
             protect_with_keyed_client "forge-and-inject" ~client ~f:(fun () ->
-                branch state client
+                Traffic_generation.branch state client
                 >>= fun branch ->
                 Sexp_options.get level_option more_args
                   ~f:Sexp_options.get_int_exn ~default:(fun () -> return 42)
@@ -630,19 +632,13 @@ module Commands = struct
                 Console.sayf state
                   More_fmt.(fun ppf () -> json ppf json_result))
         | Atom "batch" :: more_args ->
-            Tezos_client.get_account state ~client:client.client
-              ~name:client.key_name
-            >>= fun acct ->
-            ( match acct with
-            | Some a -> get_batch_args state ~client all_opts a more_args
-            | None -> Fmt.kstr failwith "to_action - failed to parse account."
-            )
+            get_batch_args state ~client all_opts more_args
             >>= fun ba ->
-            run_actions state ~client ~nodes ~actions:[ba] ~counter:1
+            run_actions state ~client ~nodes ~actions:[ba] ~rep_counter:1
         | Atom "multisig-batch" :: more_args ->
             get_multisig_args state ~client all_opts more_args
             >>= fun ma ->
-            run_actions state ~client ~nodes ~actions:[ma] ~counter:1
+            run_actions state ~client ~nodes ~actions:[ma] ~rep_counter:1
         | Atom "dsl" :: dsl_sexp ->
             Traffic_generation.Dsl.process_dsl state ~client ~nodes all_opts
               (Sexp.List dsl_sexp)

src/lib/interactive_test.mli

@@ -34,7 +34,7 @@ module Commands : sig
        ; .. >
     -> Console.Prompt.item
 
-  val curl_rpc :
+  val curl_rpc_cmd :
        < application_name: string
        ; console: Console.t
        ; paths: Paths.t
@@ -211,6 +211,7 @@ module Commands : sig
        ; env_config: Environment_configuration.t
        ; paths: Paths.t
        ; runner: Running_processes.State.t
+       ; test_baking: bool
        ; .. >
     -> clients:Tezos_client.Keyed.t list
     -> nodes:Tezos_node.t list
@@ -230,6 +231,7 @@ end
 
 (** Configurable (through {!Cmdliner.Term.t}) interactivity of
     test-scenarios. *)
+
 module Interactivity : sig
   type t = [`Full | `None | `On_error | `At_end]
 
@@ -272,6 +274,7 @@ module Pauser : sig
        ; pauser: t
        ; runner: Running_processes.State.t
        ; test_interactivity: Interactivity.t
+       ; test_baking: bool
        ; .. >
     -> (unit -> (unit, ([> System_error.t] as 'errors)) Asynchronous_result.t)
     -> pp_error:(Caml.Format.formatter -> 'errors -> unit)

src/lib/internal_pervasives.ml

@@ -311,6 +311,13 @@ module Asynchronous_result = struct
         | n when n <= 0 -> return ()
         | n -> f (1 + times - n) >>= fun () -> loop (n - 1) in
       loop times
+
+    let n_times_fold times initial_arg f =
+      let rec loop n arg =
+        match n with
+        | n when n <= 0 -> return ()
+        | n -> f (1 + times - n) arg >>= fun x -> loop (n - 1) x in
+      loop times initial_arg
   end
 
   module Stream = struct
@@ -556,10 +563,31 @@ module Jqo = struct
   let to_string j = Ezjsonm.(to_string (wrap j))
   let of_lines l = Ezjsonm.value_from_string (String.concat ~sep:"\n" l)
 
+  let to_string_hum (json : Ezjsonm.value) =
+    match json with `String s -> s | _ -> to_string json
+
+  let field_from_list ~k json_list =
+    match json_list with
+    | `A val_list ->
+        let foldf acc x =
+          match x with
+          | `O obj -> (
+            match List.Assoc.find obj ~equal:String.equal k with
+            | Some z -> z :: acc
+            | None -> acc )
+          | _ -> acc
+          (*expecting an object here*) in
+        List.fold val_list ~init:[] ~f:foldf
+    | _ -> []
+
   let field ~k = function
     | `O l -> List.Assoc.find_exn l ~equal:String.equal k
     | other -> ksprintf failwith "Jqo.field (%S) in %s" k (to_string other)
 
+  let field_opt ~k = function
+    | `O l -> List.Assoc.find l ~equal:String.equal k
+    | other -> ksprintf failwith "Jqo.field_opt (%S) in %s" k (to_string other)
+
   let list_find ~f = function
     | `O l ->
         List.find_map_exn ~f:(fun (_, j) -> if f j then Some j else None) l
@@ -576,8 +604,45 @@ module Jqo = struct
         ksprintf failwith "Jqo.remove_field %S: No an object: %s" name
           (to_string other)
 
+  let match_in_array match_key match_val target_key json_arr =
+    let foldf match_k match_v target_k (x : Ezjsonm.value)
+        (r : Ezjsonm.value list) : Ezjsonm.value list =
+      match field_opt ~k:match_k x with
+      | None -> r
+      | Some (`String s) ->
+          if String.equal s match_v then
+            let target_val = field ~k:target_k x in
+            target_val :: r
+          else r
+      | Some _ -> r in
+    match json_arr with
+    | `A l ->
+        List.fold_right l ~init:[] ~f:(foldf match_key match_val target_key)
+    | _ -> []
+
+  let match_in_array_first (match_key : string) (match_val : string)
+      (target_key : string) (json_arr : Ezjsonm.value) : Ezjsonm.value =
+    let xs = match_in_array match_key match_val target_key json_arr in
+    match xs with
+    | [] ->
+        ksprintf failwith
+          "Jqo.match_in_array_first - empty result list for match_key:%s, \
+           match_val:%s, target_key:%s"
+          match_key match_val target_key
+    | x :: _ -> x
+
   let get_string = Ezjsonm.get_string
   let get_strings = Ezjsonm.get_strings
   let get_int = Ezjsonm.get_int
   let get_list = Ezjsonm.get_list (fun e -> e)
+
+  let get_list_element v index =
+    match v with
+    | `A l ->
+        if List.length l < index then
+          ksprintf failwith "Jqo.get_list_element - invalid index: %d" index
+        else List.nth_exn l index
+    | other ->
+        ksprintf failwith "Jqo.get_list_element - Not a list: %s"
+          (to_string other)
 end

src/lib/test_command_line.ml

@@ -88,7 +88,7 @@ module Full_default_state = struct
     let default_root = sprintf "/tmp/%s-test" base_state#command_name in
     let pauser = Interactive_test.Pauser.make [] in
     let ops = Log_recorder.Operations.make () in
-    let state console paths interactivity =
+    let state console paths interactivity (`With_baking baking) =
       object
         method paths = paths
 
@@ -100,6 +100,8 @@ module Full_default_state = struct
 
         method test_interactivity = interactivity
 
+        method test_baking = baking
+
         method pauser = pauser
 
         method operations_log = ops
@@ -107,14 +109,22 @@ module Full_default_state = struct
         method env_config = base_state#env_config
       end in
     let open Cmdliner in
+    let docs = Manpage_builder.section_test_scenario base_state in
     Term.(
       pure state $ Console.cli_term ()
       $ Paths.cli_term ~default_root ()
-      $
-      if disable_interactivity then pure `None
-      else
-        Interactive_test.Interactivity.cli_term ?default:default_interactivity
-          ())
+      $ ( if disable_interactivity then pure `None
+        else
+          Interactive_test.Interactivity.cli_term
+            ?default:default_interactivity () )
+      $ Arg.(
+          pure (fun x -> `With_baking (not x))
+          $ value
+              (flag
+                 (info ["no-baking"] ~docs
+                    ~doc:
+                      "Completely disable baking/endorsing/accusing (you need \
+                       to bake manually to make the chain advance)."))))
 end
 
 let cli_state ?default_interactivity ?disable_interactivity ~name () =

src/lib/test_command_line.mli

@@ -34,6 +34,8 @@ module Command_making_state : sig
        ; command_name: string
        ; env_config: Environment_configuration.t
        ; manpager: Manpage_builder.State.t >
+
+  (* ; test_baking: bool > *)
 end
 
 (** Make {!Cmdliner} commands from {!Asynchronous_result} functions. *)
@@ -66,7 +68,8 @@ module Full_default_state : sig
        ; paths: Paths.t
        ; pauser: Interactive_test.Pauser.t
        ; runner: Running_processes.State.t
-       ; test_interactivity: Interactive_test.Interactivity.t >
+       ; test_interactivity: Interactive_test.Interactivity.t
+       ; test_baking: bool >
        Cmdliner.Term.t
 end
 
@@ -83,6 +86,7 @@ val cli_state :
      ; paths: Paths.t
      ; pauser: Interactive_test.Pauser.t
      ; runner: Running_processes.State.t
-     ; test_interactivity: Interactive_test.Interactivity.t >
+     ; test_interactivity: Interactive_test.Interactivity.t
+     ; test_baking: bool >
      Cmdliner.Term.t
 (** Create a full [state] value for test-scenarios. *)

src/lib/tezos_client.ml

@@ -266,34 +266,71 @@ let show_known_contract state client ~name =
   successful_client_cmd state ~client ["show"; "known"; "contract"; name]
   >>= fun res -> return (String.concat res#out)
 
-let deploy_multisig state client ~name ~amt ~from_acct ~threshold ~signer_names
-    ~burn_cap =
+let deploy_multisig ?counter state client ~name ~amt ~from_acct ~threshold
+    ~signer_names ~burn_cap =
+  let counter_args =
+    match counter with Some c -> ["--counter"; Int.to_string c] | None -> []
+  in
   client_cmd state ~client
     (List.concat
        [ [ "deploy"; "multisig"; name; "transferring"; sprintf "%f" amt; "from"
          ; from_acct; "with"; "threshold"; Int.to_string threshold; "on"
          ; "public"; "keys" ]
        ; signer_names
-       ; ["--burn-cap"; sprintf "%f" burn_cap; "--force"] ])
+       ; ["--burn-cap"; sprintf "%f" burn_cap; "--force"]
+       ; counter_args ])
   >>= fun _ -> return ()
 
-let sign_multisig state client ~name ~amt ~to_acct ~signer_name =
-  client_cmd state ~client
-    [ "sign"; "multisig"; "transaction"; "on"; name; "transferring"
+let sign_multisig state client ~contract ~amt ~to_acct ~signer_name =
+  let params =
+    [ "sign"; "multisig"; "transaction"; "on"; contract; "transferring"
     ; sprintf "%f" amt; "to"; to_acct; "using"; "secret"; "key"; signer_name ]
+  in
+  client_cmd state ~client params
   >>= fun (_, sign_res) -> return (String.concat ~sep:"" sign_res#out)
 
-let transfer_from_multisig state client ~name ~amt ~to_acct ~on_behalf_acct
-    ~signatures ~burn_cap =
+let transfer_from_multisig ?counter state client ~name ~amt ~to_acct
+    ~on_behalf_acct ~signatures ~burn_cap =
+  let counter_args =
+    match counter with Some c -> ["--counter"; Int.to_string c] | None -> []
+  in
   client_cmd state ~client
     (List.concat
        [ [ "from"; "multisig"; "contract"; name; "transfer"; sprintf "%f" amt
          ; "to"; to_acct; "on"; "behalf"; "of"; on_behalf_acct; "with"
          ; "signatures" ]
        ; signatures
-       ; ["--burn-cap"; sprintf "%f" burn_cap] ])
+       ; ["--burn-cap"; sprintf "%f" burn_cap]
+       ; counter_args ])
   >>= fun _ -> return ()
 
+let hash_data state ?gas client ~data_to_hash ~data_type =
+  let the_list = ["hash"; "data"; data_to_hash; "of"; "type"; data_type] in
+  let the_list' =
+    match gas with
+    | None -> the_list
+    | Some g -> the_list @ ["--gas"; Int.to_string g] in
+  successful_client_cmd state ~client the_list'
+  >>= fun res ->
+  let res_out = List.hd_exn res#out in
+  let cleaned =
+    match String.chop_prefix res_out ~prefix:"Raw packed data: " with
+    | Some s -> s
+    | None -> res_out in
+  return cleaned
+
+let multisig_storage_counter state client contract_id =
+  let path =
+    sprintf "/chains/main/blocks/head/context/contracts/%s/storage" contract_id
+  in
+  rpc state ~client `Get ~path
+  >>= fun sto ->
+  let args_array = Jqo.field ~k:"args" sto in
+  let fst_arg = Jqo.get_list_element args_array 0 in
+  let counter_val = Jqo.field ~k:"int" fst_arg in
+  try return (Int.of_string (Jqo.get_string counter_val))
+  with e -> System_error.fail_fatalf "Exception getting counter: %a" Exn.pp e
+
 module Ledger = struct
   type hwm = {main: int; test: int; chain: Tezos_crypto.Chain_id.t option}
 
@@ -427,21 +464,25 @@ module Keyed = struct
       ["generate"; "nonce"; "hash"; "for"; key_name; "from"; data]
     >>= fun res -> return (List.hd_exn res#out)
 
-  let forge_and_inject state {client; key_name; _} ~json =
-    rpc state ~client ~path:"/chains/main/blocks/head/helpers/forge/operations"
+  let sign_bytes state client ~bytes ~key_name =
+    successful_client_cmd state ~client:client.client
+      ["sign"; "bytes"; bytes; "for"; key_name]
+    >>= fun sign_res -> return (List.hd_exn sign_res#out)
+
+  let forge_and_inject state keyed_client ~json =
+    rpc state ~client:keyed_client.client
+      ~path:"/chains/main/blocks/head/helpers/forge/operations"
       (`Post (Ezjsonm.value_to_string json))
     >>= fun res ->
     let operation_bytes = match res with `String s -> s | _ -> assert false in
     let bytes_to_sign = "0x03" ^ operation_bytes in
-    successful_client_cmd state ~client
-      ["sign"; "bytes"; bytes_to_sign; "for"; key_name]
+    sign_bytes state keyed_client ~bytes:bytes_to_sign (*operation_bytes*)
+      ~key_name:keyed_client.key_name
     >>= fun sign_res ->
     let to_decode =
-      List.hd_exn sign_res#out
-      |> String.chop_prefix_exn ~prefix:"Signature:"
-      |> String.strip in
-    say state EF.(desc (shout "TO DECODE:") (af "%S" to_decode))
-    >>= fun () ->
+      String.chop_prefix_exn ~prefix:"Signature:" sign_res |> String.strip
+    in
+    Dbg.e EF.(af "To Decode: %s" to_decode) ;
     let decoded =
       Option.value_exn ~message:"base58 dec"
         (Tezos_crypto.Base58.safe_decode to_decode)
@@ -460,6 +501,84 @@ module Keyed = struct
               (af "%d: %S" (String.length actual_signature) actual_signature)
           ])
     >>= fun () ->
-    rpc state ~client ~path:"/injection/operation?chain=main"
+    rpc state ~client:keyed_client.client
+      ~path:"/injection/operation?chain=main"
       (`Post (sprintf "\"%s%s\"" operation_bytes actual_signature))
+
+  let find_mempool_counter_exn (json : Ezjsonm.value) hash_key : int =
+    match json with
+    | `O _ -> (
+        let z = Jqo.field ~k:"applied" json in
+        match z with
+        | `A trans_list ->
+            let foldf acc x =
+              let contents_list = Jqo.field ~k:"contents" x in
+              let more_counters =
+                Jqo.match_in_array "source" hash_key "counter" contents_list
+              in
+              more_counters @ acc in
+            let to_ints (strs : string list) : int list =
+              List.map strs ~f:(fun s -> Int.of_string s) in
+            let to_max_int (ints : int list) : int =
+              List.fold ints ~init:0 ~f:(fun acc x -> Int.max acc x) in
+            let counters = List.fold trans_list ~init:[] ~f:foldf in
+            let counter_strs =
+              List.map ~f:(fun v -> Jqo.get_string v) counters in
+            let max_int = to_max_int (to_ints counter_strs) in
+            max_int
+        | _ -> 0 )
+    | _ -> 0
+
+  let operations_from_chain state keyed_client =
+    rpc state ~client:keyed_client.client `Get
+      ~path:(Fmt.str "/chains/main/blocks/head/operations")
+    >>= fun ops_json -> return ops_json
+
+  let find_contract_id_exn (json : Ezjsonm.value) (orig_hash : string) =
+    let ops = Jqo.get_list_element json 3 in
+    let op = Jqo.match_in_array_first "hash" orig_hash "contents" ops in
+    let meta = Jqo.match_in_array_first "kind" "origination" "metadata" op in
+    let res = Jqo.field ~k:"operation_result" meta in
+    let orig_list = Jqo.field ~k:"originated_contracts" res in
+    Jqo.get_string (Jqo.get_list_element orig_list 0)
+
+  let get_contract_id state client origination_hash =
+    operations_from_chain state client
+    >>= fun ops_json ->
+    try return (find_contract_id_exn ops_json origination_hash)
+    with e ->
+      System_error.fail_fatalf "Exception getting contract_id: %a" Exn.pp e
+
+  let counter_from_chain state keyed_client =
+    get_account state ~client:keyed_client.client ~name:keyed_client.key_name
+    >>= fun acct ->
+    match acct with
+    | None ->
+        System_error.fail_fatalf
+          "counter_from_chain - failed to parse account."
+    | Some a ->
+        let src = Tezos_protocol.Account.pubkey_hash a in
+        rpc state ~client:keyed_client.client `Get
+          ~path:
+            (Fmt.str "/chains/main/blocks/head/context/contracts/%s/counter"
+               src)
+        >>= fun counter_json ->
+        return (Jqo.get_string counter_json |> Int.of_string)
+
+  let update_counter ?current_counter_override state client _dbg_str =
+    let the_match =
+      match current_counter_override with
+      | None -> counter_from_chain state client
+      | Some c -> return (Int.max (c - 1) 0) in
+    the_match
+    >>= fun current_counter ->
+    rpc state ~client:client.client `Get
+      ~path:"/chains/main/mempool/pending_operations"
+    >>= fun json ->
+    let pubkey_hash = Tezos_protocol.Key.Of_name.pubkey_hash client.key_name in
+    let new_counter =
+      try find_mempool_counter_exn json pubkey_hash with _ -> current_counter
+    in
+    let max = Int.max current_counter new_counter + 1 in
+    return max
 end

src/lib/tezos_client.mli

@@ -227,7 +227,8 @@ val show_known_contract :
      Asynchronous_result.t
 
 val deploy_multisig :
-     < application_name: string
+     ?counter:int
+  -> < application_name: string
      ; console: Console.t
      ; paths: Paths.t
      ; env_config: Environment_configuration.t
@@ -252,7 +253,7 @@ val sign_multisig :
      ; runner: Running_processes.State.t
      ; .. >