Client: cosmetic or minor improvements

.gitlab-ci.yml

@@ -174,6 +174,11 @@ test:inject.sh:
   script:
     - dune build @src/bin_client/runtest_injection.sh
 
+test:voting.sh:
+  <<: *test_definition
+  script:
+    - dune build @src/bin_client/runtest_voting.sh
+
 test:proto:sandbox:
   <<: *test_definition
   script:

src/bin_client/test/dune

@@ -145,6 +145,7 @@
  (locks /tcp-port/18731
         /tcp-port/19731)
  (deps sandbox.json
+       protocol_parameters.json
        test_lib.inc.sh
        (glob_files demo/*))
  (action

src/bin_client/test/protocol_parameters.json

@@ -21,7 +21,7 @@
   "time_between_blocks" : [ "1", "0" ],
   "blocks_per_cycle" : 128,
   "blocks_per_roll_snapshot" : 32,
-  "blocks_per_voting_period" : 64,
+  "blocks_per_voting_period" : 256,
   "preserved_cycles" : 1,
   "proof_of_work_threshold": "-1"
 }

src/bin_client/test/test_voting.sh

@@ -66,7 +66,7 @@ cp -r demo $tempdir/proto3
 echo '(* 3 *)' >> $tempdir/proto3/main.ml
 $admin_client inject protocol $tempdir/proto3
 
-proto_str=`$admin_client list protocols | head -3` # assuming new protocols listed first
+proto_str=`$admin_client list protocols | grep "P" | head -3` # assuming new protocols listed first
 echo New protocols: $proto_str
 proto=($proto_str)
 
@@ -108,13 +108,13 @@ echo $res
     || { echo "strange listings" ; exit 1 ; }
 [ `echo $res | jq .current_proposal` = '"'${proto[1]}'"' ] \
     || { echo "strange current_proposal" ; exit 1 ; }
- 
+
 echo Ballots 1
 $client submit ballot for bootstrap1 ${proto[1]} yay
 $client submit ballot for bootstrap2 ${proto[1]} yay
 $client submit ballot for bootstrap3 ${proto[1]} yay
 $client submit ballot for bootstrap4 ${proto[1]} yay
- 
+
 bake # pos=1
 
 # They cannot change their mind.
@@ -126,9 +126,9 @@ bake # pos=2
 bake # pos=3
 
 $client show votes
- 
+
 bake # new period pos=0
- 
+
 echo Testing vote should be done
 res=`$client show votes`
 [ `echo $res | jq .voting_period_position` = '0' ] \
@@ -148,7 +148,7 @@ bake # pos=1
 bake # pos=2
 bake # pos=3
 bake # new period pos=0
- 
+
 echo Testing should be done
 res=`$client show votes`
 [ `echo $res | jq .voting_period_position` = '0' ] \
@@ -163,7 +163,7 @@ res=`$client show votes`
     || { echo "strange current_proposal" ; exit 1 ; }
 [ `echo $res | jq .ballot_list` = '[]' ] \
     || { echo "strange ballot_list" ; exit 1 ; }
- 
+
 $client submit ballot for bootstrap1 ${proto[1]} yay
 $client submit ballot for bootstrap2 ${proto[1]} yay
 $client submit ballot for bootstrap3 ${proto[1]} yay
@@ -176,7 +176,7 @@ bake # pos=3
 $client show votes
 
 bake # new period pos=0
- 
+
 echo 'Promotion vote should be over now negatively'
 res=`$client show votes`
 [ `echo $res | jq .voting_period_position` = '0' ] \

src/proto_alpha/lib_client/client_proto_context.ml

@@ -435,10 +435,10 @@ type vote_info = {
 }
 
 (* Should be moved to src/proto_alpha/lib_protocol/src/vote_storage.ml *)
-let ballot_list_encoding = 
+let ballot_list_encoding =
   Data_encoding.(list (obj2
                          (req "pkh" Signature.Public_key_hash.encoding)
-                         (req "balllot" Vote.ballot_encoding)))
+                         (req "ballot" Vote.ballot_encoding)))
 
 let vote_info_encoding =
   let open Data_encoding in
@@ -531,7 +531,7 @@ let submit_proposals
 let submit_ballot
     (cctxt : #Proto_alpha.full)
     ~chain ~block ?confirmations ~src_sk source proposal ballot =
-  (* The user must provide the proposal explicitly to make himself sure 
+  (* The user must provide the proposal explicitly to make himself sure
      for what he is voting.
   *)
   Alpha_services.Helpers.current_level cctxt ~offset:1l (chain, block) >>=? fun (level : Level.t) ->
@@ -547,8 +547,8 @@ let pp_operation formatter (a : Alpha_block_services.operation) =
       match Apply_results.kind_equal_list od.contents omd.contents
       with
       | Some Apply_results.Eq ->
-          Operation_result.pp_operation_result formatter 
+          Operation_result.pp_operation_result formatter
-            (od.contents, omd.contents) 
+            (od.contents, omd.contents)
       | None -> Pervasives.failwith "Unexpected result.")
   | _ -> Pervasives.failwith "Unexpected result."
 
@@ -558,16 +558,16 @@ let get_operation_from_block
     predecessors
     operation_hash =
   Client_confirmations.lookup_operation_in_previous_blocks
-    cctxt 
+    cctxt
-    ~chain 
+    ~chain
-    ~predecessors 
+    ~predecessors
     operation_hash
   >>=? function
   | None -> return_none
-  | Some (block, i, j) -> 
+  | Some (block, i, j) ->
       cctxt#message "Operation found in block: %a (pass: %d, offset: %d)"
         Block_hash.pp block i j >>= fun () ->
-      Proto_alpha.Alpha_block_services.Operations.operation cctxt 
+      Proto_alpha.Alpha_block_services.Operations.operation cctxt
         ~block:(`Hash (block, 0)) i j >>=? fun op' -> return_some op'
 
 let display_receipt_for_operation
@@ -576,10 +576,10 @@ let display_receipt_for_operation
     ?(predecessors = 10)
     operation_hash =
   get_operation_from_block cctxt ~chain predecessors operation_hash
-  >>=? function 
+  >>=? function
-  | None -> 
+  | None ->
-      cctxt#message "Couldn't find operation" >>= fun () -> 
+      cctxt#message "Couldn't find operation" >>= fun () ->
       return_unit
-  | Some op -> 
+  | Some op ->
       cctxt#message "%a" pp_operation op >>= fun () ->
       return_unit

src/proto_alpha/lib_client/client_proto_context.mli

@@ -222,7 +222,7 @@ type vote_info
 
 val vote_info_encoding : vote_info Data_encoding.t
 
-val get_vote_info : 
+val get_vote_info :
   #Proto_alpha.full ->
   chain:Shell_services.chain ->
   block:Shell_services.block ->
@@ -251,9 +251,9 @@ val submit_ballot:
 
 (** lookup an operation in [predecessors] previous blocks, and print the
     receipt if found *)
-val display_receipt_for_operation: 
+val display_receipt_for_operation:
   #Proto_alpha.full ->
   chain:Block_services.chain ->
-  ?predecessors:int -> 
+  ?predecessors:int ->
-  Operation_list_hash.elt -> 
+  Operation_list_hash.elt ->
   unit tzresult Lwt.t

src/proto_alpha/lib_client/operation_result.ml

@@ -396,12 +396,12 @@ let rec pp_contents_and_result_list :
            From: %a@,\
            Period: %a@,\
            Protocol: %a@,\
-           Vote: %s@]"
+           Vote: %a@]"
           Signature.Public_key_hash.pp source
           Voting_period.pp period
           Protocol_hash.pp proposal
-          (* FIXME We should use ballot_encoding? *)
+          Data_encoding.Json.pp
-          (match ballot with Yay -> "YAY" | Pass -> "PASS" | Nay -> "NAY")
+          (Data_encoding.Json.construct Vote.ballot_encoding ballot)
     | Single_and_result (Manager_operation _ as op,
                          (Manager_operation_result _ as res))->
         Format.fprintf ppf "%a"

src/proto_alpha/lib_client_commands/client_proto_context_commands.ml

@@ -67,11 +67,11 @@ let data_parameter =
       Lwt.return (Micheline_parser.no_parsing_error
                   @@ Michelson_v1_parser.parse_expression data))
 
-let non_negative_param = 
+let non_negative_param =
   Clic.parameter (fun _ s ->
       match int_of_string_opt s with
       | Some i when i >= 0 -> return i
-      | _ -> failwith "Parameter should be a non-negative integer literal") 
+      | _ -> failwith "Parameter should be a non-negative integer literal")
 
 let group =
   { Clic.name = "context" ;
@@ -645,49 +645,44 @@ let commands version () =
 
     command ~group ~desc: "Submit protocol proposals."
       no_options
-      (prefixes [ "submit" ; "proposals" ]
+      (prefixes [ "submit" ; "proposals" ; "for" ]
-       @@ prefix "for"
        @@ ContractAlias.destination_param
          ~name: "src" ~desc: "name of the source contract"
-       @@ seq_of_param (param
+       @@ seq_of_param
-                          ~name:"proposal"
+         (param
-                          ~desc:"Proposal to be submitted"
+            ~name:"proposal"
-                          (parameter
+            ~desc:"Proposal to be submitted"
-                             (fun _ x ->
+            (parameter
-                                match Protocol_hash.of_b58check_opt x with
+               (fun _ x ->
-                                | None -> Error_monad.failwith "Invalid proposal hash: '%s'" x
+                  match Protocol_hash.of_b58check_opt x with
-                                | Some hash -> return hash)))
+                  | None -> Error_monad.failwith "Invalid proposal hash: '%s'" x
-      )
+                  | Some hash -> return hash))))
-      (fun () (_name, source) proposals cctxt ->
+      begin fun () (_name, source) proposals (cctxt : Proto_alpha.full) ->
-         Shell_services.Protocol.list cctxt >>=? fun known_protos ->
+        Shell_services.Protocol.list cctxt >>=? fun known_protos ->
-         let check_proposals proposals =
+        let check_proposals proposals : unit tzresult Lwt.t =
-           let n = List.length proposals in
+          let n = List.length proposals in
-           if n = 0 then generic_error "Empty proposal"
+          if n = 0 then cctxt#error "Empty proposal"
-           else if n > Constants.fixed.max_proposals_per_delegate then
+          else if n > Constants.fixed.max_proposals_per_delegate then
-             generic_error "Too many proposals"
+            cctxt#error "Too many proposals"
-           else
+          else
-             (* Why we do not have Error_monad.iter ? *)
+            iter_s (fun p ->
-             let rec iter f = function
+                if List.mem p known_protos then
-               | [] -> ok ()
+                  cctxt#message "All proposals are valid" >>= fun () -> return_unit
-               | p::ps -> f p >>? fun () -> iter f ps
+                else cctxt#error "Protocol %a is not known by the node"
-             in
+                    Protocol_hash.pp p)
-             iter (fun p -> 
+              proposals
-                 if List.mem p known_protos then ok ()
+        in
-                 else generic_error "Protocol %a is not injected in the node" Protocol_hash.pp p)
+        check_proposals proposals >>=? fun () ->
-               proposals
+        Client_proto_context.get_manager
-         in
+          cctxt ~chain:`Main ~block:cctxt#block
-         Lwt.return (check_proposals proposals) >>=? fun () ->
+          source >>=? fun (_src_name, src_pkh, _src_pk, src_sk) ->
-         Client_proto_context.get_manager
+        submit_proposals cctxt ~chain:`Main ~block:cctxt#block ~src_sk src_pkh proposals >>=? fun _res ->
-           cctxt ~chain:`Main ~block:cctxt#block
+        return_unit
-           source >>=? fun (_src_name, src_pkh, _src_pk, src_sk) ->
+      end ;
-         submit_proposals cctxt ~chain:`Main ~block:cctxt#block ~src_sk src_pkh proposals >>=? fun _res ->
-         return_unit
-      );
 
     command ~group ~desc: "Submit a ballot."
       no_options
-      (prefixes [ "submit" ; "ballot" ]
+      (prefixes [ "submit" ; "ballot" ; "for" ]
-       @@ prefix "for"
        @@ ContractAlias.destination_param
          ~name: "src" ~desc: "name of the source contract"
        @@ param
@@ -696,36 +691,38 @@ let commands version () =
          (parameter
             (fun _ x ->
                match Protocol_hash.of_b58check_opt x with
-               | None -> Error_monad.failwith "Invalid proposal hash: '%s'" x
+               | None -> failwith "Invalid proposal hash: '%s'" x
                | Some hash -> return hash))
        @@ param
          ~name:"ballot"
          ~desc:"Ballot(yay/nay/pass)"
          (parameter
             (fun _ s ->
-               let fail () = Error_monad.failwith "Invalid ballot: '%s'" s in
+               let fail () = failwith "Invalid ballot: '%s'" s in
                match Data_encoding.Json.from_string ("\"" ^ s ^ "\"") with
                | Error _ -> fail ()
-               | Ok j -> 
+               | Ok j ->
                    match Data_encoding.Json.destruct Vote.ballot_encoding j with
                    | exception _ -> fail ()
                    | b -> return b))
-       @@ stop
+       @@ stop)
-      )
+      begin fun () (_name, source) proposal ballot (cctxt : Proto_alpha.full) ->
-      (fun () (_name, source) proposal ballot cctxt ->
+        Client_proto_context.get_manager
-         Client_proto_context.get_manager
+          cctxt ~chain:`Main ~block:cctxt#block
-           cctxt ~chain:`Main ~block:cctxt#block
+          source >>=? fun (_src_name, src_pkh, _src_pk, src_sk) ->
-           source >>=? fun (_src_name, src_pkh, _src_pk, src_sk) ->
+        submit_ballot cctxt ~chain:`Main ~block:cctxt#block ~src_sk src_pkh
-         submit_ballot cctxt ~chain:`Main ~block:cctxt#block ~src_sk src_pkh proposal ballot >>=? fun _res ->
+          proposal ballot >>=? fun _res ->
-         return_unit
+        return_unit
-      );
+      end ;
 
     command ~group ~desc: "Summarize the current voting information."
       no_options
       (fixed [ "show" ; "votes" ])
-      (fun () cctxt ->
+      begin fun () (cctxt : Proto_alpha.full) ->
-         get_vote_info ~chain:`Main ~block:cctxt#block cctxt >>=? fun vote_info ->
+        get_vote_info ~chain:`Main ~block:cctxt#block cctxt >>=? fun vote_info ->
-         cctxt#message "%a" (Json_repr.pp_any ()) (Json_repr.(to_any (Data_encoding.Json.construct vote_info_encoding vote_info))) >>= fun () ->
+        cctxt#message "%a" Data_encoding.Json.pp
-         return_unit
+          (Data_encoding.Json.construct vote_info_encoding vote_info) >>= fun () ->
-      )
+        return_unit
+      end ;
+
   ]