Client/Alpha: simplify Client_proto_context

src/client/embedded/alpha/client_proto_context.ml

@@ -14,41 +14,134 @@ open Client_keys
 open Client_commands
 module Ed25519 = Environment.Ed25519
 
-let check_contract cctxt neu =
+let get_balance cctxt block contract =
-  RawContractAlias.mem cctxt neu >>=? function
+  Client_proto_rpcs.Context.Contract.balance cctxt block contract
-  | true ->
-      failwith "contract '%s' already exists" neu
-  | false ->
-      return ()
 
-let get_delegate_pkh cctxt = function
+let transfer rpc_config
-  | None ->
+    block ?force
-      return None
+    ~source ~src_pk ~src_sk ~destination ?arg ~amount ~fee () =
-  | Some delegate ->
+  let open Cli_entries in
-      Public_key_hash.find_opt cctxt delegate
+  Client_node_rpcs.Blocks.net rpc_config block >>=? fun net ->
+  begin match arg with
+    | Some arg ->
+        Client_proto_programs.parse_data arg >>=? fun arg ->
+        return (Some arg)
+    | None -> return None
+  end >>=? fun parameters ->
+  Client_proto_rpcs.Context.Contract.counter
+    rpc_config block source >>=? fun pcounter ->
+  let counter = Int32.succ pcounter in
+  Client_proto_rpcs.Helpers.Forge.Manager.transaction
+    rpc_config block
+    ~net ~source ~sourcePubKey:src_pk ~counter ~amount
+    ~destination ?parameters ~fee () >>=? fun bytes ->
+  Client_node_rpcs.Blocks.predecessor rpc_config block >>=? fun predecessor ->
+  let signature = Ed25519.sign src_sk bytes in
+  let signed_bytes = MBytes.concat bytes signature in
+  let oph = Operation_hash.hash_bytes [ signed_bytes ] in
+  Client_proto_rpcs.Helpers.apply_operation rpc_config block
+    predecessor oph bytes (Some signature) >>=? fun contracts ->
+  Client_node_rpcs.inject_operation
+    rpc_config ?force signed_bytes >>=? fun injected_oph ->
+  assert (Operation_hash.equal oph injected_oph) ;
+  return (oph, contracts)
 
-let get_timestamp cctxt block =
+let originate rpc_config ?force ~block ?signature bytes =
-  Client_node_rpcs.Blocks.timestamp cctxt.rpc_config block >>=? fun v ->
+  let signed_bytes =
-  cctxt.message "%s" (Time.to_notation v) >>= fun () ->
+    match signature with
-  return ()
+    | None -> bytes
+    | Some signature -> MBytes.concat bytes signature in
+  Client_node_rpcs.Blocks.predecessor rpc_config block >>=? fun predecessor ->
+  let oph = Operation_hash.hash_bytes [ signed_bytes ] in
+  Client_proto_rpcs.Helpers.apply_operation rpc_config block
+    predecessor oph bytes signature >>=? function
+  | [ contract ] ->
+      Client_node_rpcs.inject_operation
+        rpc_config ?force signed_bytes >>=? fun injected_oph ->
+      assert (Operation_hash.equal oph injected_oph) ;
+      return (oph, contract)
+  | contracts ->
+      failwith
+        "The origination introduced %d contracts instead of one."
+        (List.length contracts)
 
-let list_contracts cctxt block =
+let originate_account rpc_config
-  Client_proto_rpcs.Context.Contract.list cctxt.rpc_config block >>=? fun contracts ->
+    block ?force
-  map_s (fun h ->
+    ~source ~src_pk ~src_sk ~manager_pkh
-      begin match Contract.is_default h with
+    ?delegatable ?spendable ?delegate ~balance ~fee () =
-        | Some m -> begin
+  Client_node_rpcs.Blocks.net rpc_config block >>=? fun net ->
-            Public_key_hash.rev_find cctxt m >>=? function
+  Client_proto_rpcs.Context.Contract.counter
-            | None -> return ""
+    rpc_config block source >>=? fun pcounter ->
-            | Some nm -> return nm
+  let counter = Int32.succ pcounter in
-          end
+  Client_proto_rpcs.Helpers.Forge.Manager.origination rpc_config block
-        | None -> begin
+    ~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
-            RawContractAlias.rev_find cctxt h >>=? function
+    ~counter ~balance ?spendable
-            | None -> return ""
+    ?delegatable ?delegatePubKey:delegate ~fee () >>=? fun bytes ->
-            | Some nm -> return nm
+  let signature = Ed25519.sign src_sk bytes in
-          end
+  originate rpc_config ?force ~block ~signature bytes
-      end >>=? fun alias ->
+
-      return (alias, h, Contract.is_default h))
+let originate_contract rpc_config
-    contracts
+    block ?force
+    ~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey
+    ~(code:Script.code) ~init ~fee () =
+  Client_proto_programs.parse_data init >>=? fun storage ->
+  let storage = Script.{ storage ; storage_type = code.storage_type } in
+  Client_proto_rpcs.Context.Contract.counter
+    rpc_config block source >>=? fun pcounter ->
+  let counter = Int32.succ pcounter in
+  Client_node_rpcs.Blocks.net rpc_config block >>=? fun net ->
+  Client_proto_rpcs.Helpers.Forge.Manager.origination rpc_config block
+    ~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
+    ~counter ~balance ~spendable:!spendable
+    ?delegatable ?delegatePubKey
+    ~script:{ code ; storage } ~fee () >>=? fun bytes ->
+  let signature = Ed25519.sign src_sk bytes in
+  originate rpc_config ?force ~block ~signature bytes
+
+let faucet rpc_config block ?force ~manager_pkh () =
+  Client_node_rpcs.Blocks.net rpc_config block >>=? fun net ->
+  Client_proto_rpcs.Helpers.Forge.Anonymous.faucet
+    rpc_config block ~net ~id:manager_pkh () >>=? fun bytes ->
+  originate rpc_config ?force ~block bytes
+
+let delegate_contract rpc_config
+    block ?force
+    ~source ?src_pk ~manager_sk
+    ~fee delegate_opt =
+  Client_node_rpcs.Blocks.net rpc_config block >>=? fun net ->
+  Client_proto_rpcs.Context.Contract.counter
+    rpc_config block source >>=? fun pcounter ->
+  let counter = Int32.succ pcounter in
+  Client_proto_rpcs.Helpers.Forge.Manager.delegation rpc_config block
+    ~net ~source ?sourcePubKey:src_pk ~counter ~fee delegate_opt
+  >>=? fun bytes ->
+  Client_node_rpcs.Blocks.predecessor rpc_config block >>=? fun predecessor ->
+  let signature = Environment.Ed25519.sign manager_sk bytes in
+  let signed_bytes = MBytes.concat bytes signature in
+  let oph = Operation_hash.hash_bytes [ signed_bytes ] in
+  Client_proto_rpcs.Helpers.apply_operation rpc_config block
+    predecessor oph bytes (Some signature) >>=? function
+  | [] ->
+      Client_node_rpcs.inject_operation
+        rpc_config ?force signed_bytes >>=? fun injected_oph ->
+      assert (Operation_hash.equal oph injected_oph) ;
+      return oph
+  | contracts ->
+      failwith
+        "The origination introduced %d contracts instead of one."
+        (List.length contracts)
+
+let dictate rpc_config block command seckey =
+  Client_node_rpcs.Blocks.net rpc_config block >>=? fun net ->
+  Client_proto_rpcs.Helpers.Forge.Dictator.operation
+    rpc_config block ~net command >>=? fun bytes ->
+  let signature = Ed25519.sign seckey bytes in
+  let signed_bytes = MBytes.concat bytes signature in
+  let oph = Operation_hash.hash_bytes [ signed_bytes ] in
+  Client_node_rpcs.inject_operation
+    rpc_config signed_bytes >>=? fun injected_oph ->
+  assert (Operation_hash.equal oph injected_oph) ;
+  return oph
 
 let list_contract_labels cctxt block =
   Client_proto_rpcs.Context.Contract.list
@@ -76,140 +169,44 @@ let list_contract_labels cctxt block =
       return (nm, h_b58, kind))
     contracts
 
-let get_balance cctxt block contract =
+let message_injection cctxt ~force ?(contracts = []) oph =
-  Client_proto_rpcs.Context.Contract.balance cctxt block contract
+  begin
-
+    if not force then
-let transfer cctxt
+      cctxt.message "Operation successfully injected in the node."
-    block ?force
+    else
-    ~source ~src_pk ~src_sk ~destination ?arg ~amount ~fee () =
+      Lwt.return_unit
-  let open Cli_entries in
+  end >>= fun () ->
-  Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
-  begin match arg with
-    | Some arg ->
-        Client_proto_programs.parse_data arg >>=? fun arg ->
-        return (Some arg)
-    | None -> return None
-  end >>=? fun parameters ->
-  Client_proto_rpcs.Context.Contract.counter cctxt.rpc_config block source >>=? fun pcounter ->
-  let counter = Int32.succ pcounter in
-  cctxt.message "Acquired the source's sequence counter (%ld -> %ld)."
-    pcounter counter >>= fun () ->
-  Client_proto_rpcs.Helpers.Forge.Manager.transaction cctxt.rpc_config block
-    ~net ~source ~sourcePubKey:src_pk ~counter ~amount
-    ~destination ?parameters ~fee () >>=? fun bytes ->
-  cctxt.Client_commands.message "Forged the raw origination frame." >>= fun () ->
-  Client_node_rpcs.Blocks.predecessor cctxt.rpc_config block >>=? fun predecessor ->
-  let signature = Ed25519.sign src_sk bytes in
-  let signed_bytes = MBytes.concat bytes signature in
-  let oph = Operation_hash.hash_bytes [ signed_bytes ] in
-  Client_proto_rpcs.Helpers.apply_operation cctxt.rpc_config block
-    predecessor oph bytes (Some signature) >>=? fun contracts ->
-  Client_node_rpcs.inject_operation cctxt.rpc_config ?force signed_bytes >>=? fun injected_oph ->
-  assert (Operation_hash.equal oph injected_oph) ;
-  cctxt.message "Operation successfully injected in the node." >>= fun () ->
   cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
-  return contracts
+  Lwt_list.iter_s
+    (fun c ->
+       cctxt.message
+         "New contract %a originated from a smart contract."
+         Contract.pp c)
+    contracts >>= fun () ->
+  Lwt.return_unit
 
-let originate cctxt ?force ~block ?signature bytes =
+let message_added_contract cctxt name =
-  cctxt.Client_commands.message "Forged the raw origination frame." >>= fun () ->
+  cctxt.message "Contract memorized as %s." name
-  let signed_bytes =
-    match signature with
-    | None -> bytes
-    | Some signature -> MBytes.concat bytes signature in
-  Client_node_rpcs.Blocks.predecessor cctxt.rpc_config block >>=? fun predecessor ->
-  let oph = Operation_hash.hash_bytes [ signed_bytes ] in
-  Client_proto_rpcs.Helpers.apply_operation cctxt.rpc_config block
-    predecessor oph bytes signature >>=? function
-  | [ contract ] ->
-      Client_node_rpcs.inject_operation cctxt.rpc_config ?force signed_bytes >>=? fun injected_oph ->
-      assert (Operation_hash.equal oph injected_oph) ;
-      cctxt.message "Operation successfully injected in the node." >>= fun () ->
-      cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
-      return contract
-  | contracts ->
-      cctxt.error "The origination introduced %d contracts instead of one." (List.length contracts)
 
-let originate_account cctxt
+let check_contract cctxt neu =
-    block ?force
+  RawContractAlias.mem cctxt neu >>=? function
-    ~source ~src_pk ~src_sk ~manager_pkh ?delegatable ?spendable ?delegate ~balance ~fee () =
+  | true ->
-  Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
+      failwith "contract '%s' already exists" neu
-  Client_proto_rpcs.Context.Contract.counter cctxt.rpc_config block source >>=? fun pcounter ->
+  | false ->
-  let counter = Int32.succ pcounter in
-  cctxt.message "Acquired the source's sequence counter (%ld -> %ld)."
-    pcounter counter >>= fun () ->
-  Client_proto_rpcs.Helpers.Forge.Manager.origination cctxt.rpc_config block
-    ~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
-    ~counter ~balance ?spendable
-    ?delegatable ?delegatePubKey:delegate ~fee () >>=? fun bytes ->
-  let signature = Ed25519.sign src_sk bytes in
-  originate cctxt ?force ~block ~signature bytes
-
-let originate_contract cctxt
-    block ?force
-    ~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey
-    ~(code:Script.code) ~init ~fee () =
-  Client_proto_programs.parse_data init >>=? fun storage ->
-  let storage = Script.{ storage ; storage_type = code.storage_type } in
-  Client_proto_rpcs.Context.Contract.counter cctxt.rpc_config block source >>=? fun pcounter ->
-  let counter = Int32.succ pcounter in
-  cctxt.message "Acquired the source's sequence counter (%ld -> %ld)."
-    pcounter counter >>= fun () ->
-  Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
-  Client_proto_rpcs.Helpers.Forge.Manager.origination cctxt.rpc_config block
-    ~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
-    ~counter ~balance ~spendable:!spendable
-    ?delegatable ?delegatePubKey
-    ~script:{ code ; storage } ~fee () >>=? fun bytes ->
-  let signature = Ed25519.sign src_sk bytes in
-  originate cctxt ?force ~block ~signature bytes
-
-let faucet cctxt block ?force ~manager_pkh () =
-  Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
-  Client_proto_rpcs.Helpers.Forge.Anonymous.faucet cctxt.rpc_config block
-    ~net ~id:manager_pkh () >>=? fun bytes ->
-  originate cctxt ?force ~block bytes
-
-let delegate_contract cctxt
-    block ?force
-    ~source ?src_pk ~manager_sk
-    ~fee delegate_opt =
-  Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
-  Client_proto_rpcs.Context.Contract.counter cctxt.rpc_config block source
-  >>=? fun pcounter ->
-  let counter = Int32.succ pcounter in
-  cctxt.message "Acquired the source's sequence counter (%ld -> %ld)."
-    pcounter counter >>= fun () ->
-  Client_proto_rpcs.Helpers.Forge.Manager.delegation cctxt.rpc_config block
-    ~net ~source ?sourcePubKey:src_pk ~counter ~fee delegate_opt
-  >>=? fun bytes ->
-  cctxt.Client_commands.message "Forged the raw origination frame." >>= fun () ->
-  Client_node_rpcs.Blocks.predecessor cctxt.rpc_config block >>=? fun predecessor ->
-  let signature = Environment.Ed25519.sign manager_sk bytes in
-  let signed_bytes = MBytes.concat bytes signature in
-  let oph = Operation_hash.hash_bytes [ signed_bytes ] in
-  Client_proto_rpcs.Helpers.apply_operation cctxt.rpc_config block
-    predecessor oph bytes (Some signature) >>=? function
-  | [] ->
-      Client_node_rpcs.inject_operation cctxt.rpc_config ?force signed_bytes >>=? fun injected_oph ->
-      assert (Operation_hash.equal oph injected_oph) ;
-      cctxt.message "Operation successfully injected in the node." >>= fun () ->
-      cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
       return ()
-  | contracts ->
-      cctxt.error "The origination introduced %d contracts instead of one." (List.length contracts)
 
-let dictate cctxt block command seckey =
+let get_delegate_pkh cctxt = function
-  Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
+  | None ->
-  Client_proto_rpcs.Helpers.Forge.Dictator.operation
+      return None
-    cctxt.rpc_config block ~net command >>=? fun bytes ->
+  | Some delegate ->
-  let signature = Ed25519.sign seckey bytes in
+      Public_key_hash.find_opt cctxt delegate
-  let signed_bytes = MBytes.concat bytes signature in
+
-  let oph = Operation_hash.hash_bytes [ signed_bytes ] in
+let get_manager cctxt source =
-  Client_node_rpcs.inject_operation cctxt.rpc_config signed_bytes >>=? fun injected_oph ->
+  Client_proto_contracts.get_manager
-  assert (Operation_hash.equal oph injected_oph) ;
+    cctxt.rpc_config cctxt.config.block source >>=? fun src_pkh ->
-  cctxt.message "Operation successfully injected in the node." >>= fun () ->
+  Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) ->
-  cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
+  cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () ->
-  return ()
+  return (src_name, src_pkh, src_pk, src_sk)
 
 let group =
   { Cli_entries.name = "context" ;
@@ -220,44 +217,53 @@ let commands () =
   let open Client_commands in
   [
 
-    command ~group ~desc: "access the timestamp of the block"
+    command ~group ~desc: "access the timestamp of the block" begin
-      (fixed [ "get" ; "timestamp" ])
+      fixed [ "get" ; "timestamp" ]
-      (fun cctxt -> get_timestamp cctxt cctxt.config.block) ;
+    end begin fun cctxt ->
+      Client_node_rpcs.Blocks.timestamp
+        cctxt.rpc_config cctxt.config.block >>=? fun v ->
+      cctxt.message "%s" (Time.to_notation v) >>= fun () ->
+      return ()
+    end ;
 
-    command ~group ~desc: "lists all non empty contracts of the block"
+    command ~group ~desc: "lists all non empty contracts of the block" begin
-      (fixed [ "list" ; "contracts" ])
+      fixed [ "list" ; "contracts" ]
-      (fun cctxt ->
+    end begin fun cctxt ->
       list_contract_labels cctxt cctxt.config.block >>=? fun contracts ->
       Lwt_list.iter_s
         (fun (alias, hash, kind) -> cctxt.message "%s%s%s" hash kind alias)
         contracts >>= fun () ->
-         return ()) ;
+      return ()
+    end ;
 
-    command ~group ~desc: "get the balance of a contract"
+    command ~group ~desc: "get the balance of a contract" begin
-      (prefixes [ "get" ; "balance" ]
+      prefixes [ "get" ; "balance" ]
       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
-       @@ stop)
+      @@ stop
-      (fun (_, contract) cctxt ->
+    end begin fun (_, contract) cctxt ->
       get_balance cctxt.rpc_config cctxt.config.block contract >>=? fun amount ->
       cctxt.answer "%a %s" Tez.pp amount tez_sym >>= fun () ->
-         return ()) ;
+      return ()
+    end ;
 
-    command ~group ~desc: "get the manager of a block"
+    command ~group ~desc: "get the manager of a block" begin
-      (prefixes [ "get" ; "manager" ]
+      prefixes [ "get" ; "manager" ]
       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
-       @@ stop)
+      @@ stop
-      (fun (_, contract) cctxt ->
+    end begin fun (_, contract) cctxt ->
-         Client_proto_rpcs.Context.Contract.manager cctxt.rpc_config cctxt.config.block contract >>=? fun manager ->
+      Client_proto_rpcs.Context.Contract.manager
+        cctxt.rpc_config cctxt.config.block contract >>=? fun manager ->
       Public_key_hash.rev_find cctxt manager >>=? fun mn ->
       Public_key_hash.to_source cctxt manager >>=? fun m ->
       cctxt.message "%s (%s)" m
         (match mn with None -> "unknown" | Some n -> "known as " ^ n) >>= fun () ->
-         return ());
+      return ()
+    end ;
 
     command ~group ~desc: "open a new account"
       ~args: ([ fee_arg ; delegate_arg ; force_arg ]
-              @ delegatable_args @ spendable_args)
+              @ delegatable_args @ spendable_args) begin
-      (prefixes [ "originate" ; "account" ]
+      prefixes [ "originate" ; "account" ]
       @@ RawContractAlias.fresh_alias_param
         ~name: "new" ~desc: "name of the new contract"
       @@ prefix "for"
@@ -269,24 +275,26 @@ let commands () =
       @@ prefix "from"
       @@ ContractAlias.alias_param
         ~name:"src" ~desc: "name of the source contract"
-       @@ stop)
+      @@ stop
-      (fun neu (_, manager) balance (_, source) cctxt ->
+    end begin fun neu (_, manager) balance (_, source) cctxt ->
       check_contract cctxt neu >>=? fun () ->
       get_delegate_pkh cctxt !delegate >>=? fun delegate ->
-         (Client_proto_contracts.get_manager cctxt.rpc_config cctxt.config.block source >>=? fun src_pkh ->
+      get_manager cctxt source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
-          Client_keys.get_key cctxt src_pkh
+      originate_account cctxt.rpc_config cctxt.config.block ~force:!force
-          >>=? fun (src_name, src_pk, src_sk) ->
-          cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () ->
-          originate_account cctxt cctxt.config.block ~force:!force
         ~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee:!fee
         ~delegatable:!delegatable ~spendable:!spendable ?delegate:delegate
-            ()) >>=? fun contract ->
+        () >>=? fun (oph, contract) ->
-         RawContractAlias.add cctxt neu contract) ;
+      message_injection cctxt
+        ~force:!force ~contracts:[contract] oph >>= fun () ->
+      RawContractAlias.add cctxt neu contract >>=? fun () ->
+      message_added_contract cctxt neu >>= fun () ->
+      return ()
+    end ;
 
     command ~group ~desc: "open a new scripted account"
       ~args: ([ fee_arg ; delegate_arg ; force_arg ] @
-              delegatable_args @ spendable_args @ [ init_arg ])
+              delegatable_args @ spendable_args @ [ init_arg ]) begin
-      (prefixes [ "originate" ; "contract" ]
+      prefixes [ "originate" ; "contract" ]
       @@ RawContractAlias.fresh_alias_param
         ~name: "new" ~desc: "name of the new contract"
       @@ prefix "for"
@@ -302,38 +310,46 @@ let commands () =
       @@ Program.source_param
         ~name:"prg" ~desc: "script of the account\n\
                             combine with -init if the storage type is not unit"
-       @@ stop)
+      @@ stop
-      (fun neu (_, manager) balance (_, source) code cctxt ->
+    end begin fun neu (_, manager) balance (_, source) code cctxt ->
       check_contract cctxt neu >>=? fun () ->
       get_delegate_pkh cctxt !delegate >>=? fun delegate ->
-         (Client_proto_contracts.get_manager cctxt.rpc_config cctxt.config.block source >>=? fun src_pkh ->
+      get_manager cctxt source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
-          Client_keys.get_key cctxt src_pkh
+      originate_contract cctxt.rpc_config cctxt.config.block ~force:!force
-          >>=? fun (src_name, src_pk, src_sk) ->
-          cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () ->
-          originate_contract cctxt cctxt.config.block ~force:!force
         ~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee:!fee
         ~delegatable:!delegatable ?delegatePubKey:delegate ~code ~init:!init
-            ()) >>=? fun contract ->
+        () >>=? fun (oph, contract) ->
-         RawContractAlias.add cctxt neu contract) ;
+      message_injection cctxt
+        ~force:!force ~contracts:[contract] oph >>= fun () ->
+      RawContractAlias.add cctxt neu contract >>=? fun () ->
+      message_added_contract cctxt neu >>= fun () ->
+      return ()
+    end ;
 
     command ~group ~desc: "open a new (free) account"
       ~args: ([ fee_arg ; delegate_arg ; force_arg ]
-              @ delegatable_args @ spendable_args)
+              @ delegatable_args @ spendable_args) begin
-      (prefixes [ "originate" ; "free" ; "account" ]
+      prefixes [ "originate" ; "free" ; "account" ]
       @@ RawContractAlias.fresh_alias_param
         ~name: "new" ~desc: "name of the new contract"
       @@ prefix "for"
       @@ Public_key_hash.alias_param
         ~name: "mgr" ~desc: "manager of the new contract"
-       @@ stop)
+      @@ stop end
-      (fun neu (_, manager) cctxt ->
+      begin fun neu (_, manager) cctxt ->
         check_contract cctxt neu >>=? fun () ->
-         faucet cctxt cctxt.config.block ~force:!force ~manager_pkh:manager () >>=? fun contract ->
+        faucet cctxt.rpc_config cctxt.config.block
-         RawContractAlias.add cctxt neu contract) ;
+          ~force:!force ~manager_pkh:manager () >>=? fun (oph, contract) ->
+        message_injection cctxt
+          ~force:!force ~contracts:[contract] oph >>= fun () ->
+        RawContractAlias.add cctxt neu contract >>=? fun () ->
+        message_added_contract cctxt neu >>= fun () ->
+        return ()
+      end;
 
     command ~group ~desc: "transfer tokens"
-      ~args: [ fee_arg ; arg_arg ; force_arg ]
+      ~args: [ fee_arg ; arg_arg ; force_arg ] begin
-      (prefixes [ "transfer" ]
+      prefixes [ "transfer" ]
       @@ tez_param
         ~name: "qty" ~desc: "amount taken from source"
       @@ prefix "from"
@@ -342,19 +358,15 @@ let commands () =
       @@ prefix "to"
       @@ ContractAlias.destination_param
         ~name: "dst" ~desc: "name/literal of the destination contract"
-       @@ stop)
+      @@ stop
-      (fun amount (_, source) (_, destination) cctxt ->
+    end begin fun amount (_, source) (_, destination) cctxt ->
-         (Client_proto_contracts.get_manager cctxt.rpc_config cctxt.config.block source >>=? fun src_pkh ->
+      get_manager cctxt source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
-          Client_keys.get_key cctxt src_pkh
+      transfer cctxt.rpc_config cctxt.config.block ~force:!force
-          >>=? fun (src_name, src_pk, src_sk) ->
+        ~source ~src_pk ~src_sk ~destination
-          cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () ->
+        ?arg:!arg ~amount ~fee:!fee () >>=? fun (oph, contracts) ->
-          (transfer cctxt cctxt.config.block ~force:!force
+      message_injection cctxt ~force:!force ~contracts oph >>= fun () ->
-             ~source ~src_pk ~src_sk ~destination ?arg:!arg ~amount ~fee:!fee ()) >>=? fun contracts ->
+      return ()
-          Lwt_list.iter_s
+    end;
-            (fun c -> cctxt.message "New contract %a originated from a smart contract."
-                Contract.pp c)
-            contracts >>= fun () ->
-          return ())) ;
 
     command ~desc: "Activate a protocol" begin
       prefixes [ "activate" ; "protocol" ] @@
@@ -363,9 +375,12 @@ let commands () =
       Environment.Ed25519.Secret_key.param
         ~name:"password" ~desc:"Dictator's key" @@
         stop
-    end
+    end begin fun hash seckey cctxt ->
-      (fun hash seckey cctxt ->
+      dictate cctxt.rpc_config cctxt.config.block
-         dictate cctxt cctxt.config.block (Activate hash) seckey) ;
+        (Activate hash) seckey >>=? fun oph ->
+      message_injection cctxt ~force:!force oph >>= fun () ->
+      return ()
+    end ;
 
     command ~desc: "Fork a test protocol" begin
       prefixes [ "fork" ; "test" ; "protocol" ] @@
@@ -374,8 +389,11 @@ let commands () =
       Environment.Ed25519.Secret_key.param
         ~name:"password" ~desc:"Dictator's key" @@
       stop
-    end
+    end begin fun hash seckey cctxt ->
-      (fun hash seckey cctxt ->
+      dictate cctxt.rpc_config cctxt.config.block
-         dictate cctxt cctxt.config.block (Activate_testnet hash) seckey) ;
+        (Activate_testnet hash) seckey >>=? fun oph ->
+      message_injection cctxt ~force:!force oph >>= fun () ->
+      return ()
+    end ;
 
   ]

src/client/embedded/alpha/client_proto_context.mli

@@ -7,11 +7,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-val list_contracts:
+open Environment
-  Client_commands.context ->
-  Client_proto_rpcs.block ->
-  (string * Contract.t * Environment.Ed25519.Public_key_hash.t option)
-    list tzresult Lwt.t
 
 val get_balance:
   Client_rpcs.config ->
@@ -20,7 +16,7 @@ val get_balance:
   Tez.t tzresult Lwt.t
 
 val transfer:
-  Client_commands.context ->
+  Client_rpcs.config ->
   Client_proto_rpcs.block ->
   ?force:bool ->
   source:Contract.t ->
@@ -30,10 +26,10 @@ val transfer:
   ?arg:string ->
   amount:Tez.t ->
   fee:Tez.t ->
-  unit -> Contract.t list tzresult Lwt.t
+  unit -> (Operation_hash.t * Contract.t list) tzresult Lwt.t
 
 val originate_account:
-  Client_commands.context ->
+  Client_rpcs.config ->
   Client_proto_rpcs.block ->
   ?force:bool ->
   source:Contract.t ->
@@ -45,10 +41,10 @@ val originate_account:
   ?delegate:public_key_hash ->
   balance:Tez.t ->
   fee:Tez.t ->
-  unit -> Contract.t tzresult Lwt.t
+  unit -> (Operation_hash.t * Contract.t) tzresult Lwt.t
 
 val originate_contract:
-  Client_commands.context ->
+  Client_rpcs.config ->
   Client_proto_rpcs.block ->
   ?force:bool ->
   source:Contract.t ->
@@ -61,10 +57,10 @@ val originate_contract:
   code:Script.code ->
   init:string ->
   fee:Tez.t ->
-  unit -> Contract.t tzresult Lwt.t
+  unit -> (Operation_hash.t * Contract.t) tzresult Lwt.t
 
 val delegate_contract:
-  Client_commands.context ->
+  Client_rpcs.config ->
   Client_proto_rpcs.block ->
   ?force:bool ->
   source:Contract.t ->
@@ -72,6 +68,6 @@ val delegate_contract:
   manager_sk:secret_key ->
   fee:Tez.t ->
   public_key_hash option ->
-  unit tzresult Lwt.t
+  Operation_hash.t tzresult Lwt.t
 
 val commands: unit -> Client_commands.command list

src/client/embedded/genesis/client_proto_main.ml

@@ -13,37 +13,28 @@ let protocol =
   Protocol_hash.of_b58check_exn
     "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im"
 
-let call_service1 cctxt s block a1 =
+let call_service1 rpc_config s block a1 =
-  Client_rpcs.call_service1 cctxt
+  Client_rpcs.call_service1 rpc_config
     (s Node_rpc_services.Blocks.proto_path) block a1
 
-let call_error_service1 cctxt s block a1 =
+let call_error_service1 rpc_config s block a1 =
-  call_service1 cctxt s block a1 >>= function
+  call_service1 rpc_config s block a1 >>= function
   | Ok (Error _ as err) -> Lwt.return (wrap_error err)
   | Ok (Ok v) -> return v
   | Error _ as err -> Lwt.return err
 
 let forge_block
-    cctxt block net_id ?(timestamp = Time.now ()) command fitness =
+    rpc_config block net_id ?(timestamp = Time.now ()) command fitness =
-  Client_blocks.get_block_hash cctxt block >>=? fun pred ->
+  Client_blocks.get_block_hash rpc_config block >>=? fun pred ->
-  call_service1 cctxt
+  call_service1 rpc_config
     Services.Forge.block block
     ((net_id, pred, timestamp, fitness), command)
 
-let mine cctxt ?timestamp block command fitness seckey =
+let mine rpc_config ?timestamp block command fitness seckey =
-  Client_blocks.get_block_info cctxt.rpc_config block >>=? fun bi ->
+  Client_blocks.get_block_info rpc_config block >>=? fun bi ->
-  forge_block cctxt.rpc_config ?timestamp block bi.net command fitness >>=? fun blk ->
+  forge_block rpc_config ?timestamp block bi.net command fitness >>=? fun blk ->
   let signed_blk = Environment.Ed25519.Signature.append seckey blk in
-  Client_node_rpcs.inject_block cctxt.rpc_config signed_blk [[]] >>=? fun hash ->
+  Client_node_rpcs.inject_block rpc_config signed_blk [[]]
-  cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
-  return ()
-
-let handle_error cctxt = function
-  | Ok res ->
-      Lwt.return res
-  | Error exns ->
-      pp_print_error Format.err_formatter exns ;
-      cctxt.Client_commands.error "%s" "cannot continue"
 
 let commands () =
   let timestamp = ref None in
@@ -71,8 +62,10 @@ let commands () =
          let timestamp = !timestamp in
          let fitness =
            Client_embedded_proto_alpha.Fitness_repr.from_int64 fitness in
-         mine cctxt ?timestamp cctxt.config.block
+         mine cctxt.rpc_config ?timestamp cctxt.config.block
-           (Activate hash) fitness seckey
+           (Activate hash) fitness seckey >>=? fun hash ->
+         cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
+         return ()
     end ;
 
     command ~args ~desc: "Fork a test protocol" begin
@@ -92,8 +85,10 @@ let commands () =
       let timestamp = !timestamp in
       let fitness =
         Client_embedded_proto_alpha.Fitness_repr.from_int64 fitness in
-      mine cctxt ?timestamp cctxt.config.block
+      mine cctxt.rpc_config ?timestamp cctxt.config.block
-        (Activate_testnet hash) fitness seckey
+        (Activate_testnet hash) fitness seckey >>=? fun hash ->
+      cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
+      return ()
     end ;
 
   ]

src/client/embedded/genesis/client_proto_main.mli

@@ -8,11 +8,11 @@
 (**************************************************************************)
 
 val mine:
-  Client_commands.context ->
+  Client_rpcs.config ->
   ?timestamp: Time.t ->
   Client_node_rpcs.Blocks.block ->
   Data.Command.t ->
   Fitness.fitness ->
   Environment.Ed25519.Secret_key.t ->
-  unit tzresult Lwt.t
+  Block_hash.t tzresult Lwt.t