Alpha: add missing errors registrations

src/proto_alpha/lib_protocol/src/amendment.ml

@@ -101,13 +101,66 @@ let start_new_voting_cycle ctxt =
       Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt ->
       return ctxt
 
-type error +=
+type error += (* `Branch *)
   | Invalid_proposal
   | Unexpected_proposal
   | Unauthorized_proposal
   | Unexpected_ballot
   | Unauthorized_ballot
 
+let () =
+  let open Data_encoding in
+  (* Invalid proposal *)
+  register_error_kind
+    `Branch
+    ~id:"invalid_proposal"
+    ~title:"Invalid proposal"
+    ~description:"Ballot provided for a proposal that is not the current one."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid proposal")
+    empty
+    (function Invalid_proposal -> Some () | _ -> None)
+    (fun () -> Invalid_proposal) ;
+  (* Unexpected proposal *)
+  register_error_kind
+    `Branch
+    ~id:"unexpected_proposal"
+    ~title:"Unexpected proposal"
+    ~description:"Proposal recorded outside of a proposal period."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected proposal")
+    empty
+    (function Unexpected_proposal -> Some () | _ -> None)
+    (fun () -> Unexpected_proposal) ;
+  (* Unauthorized proposal *)
+  register_error_kind
+    `Branch
+    ~id:"unauthorized_proposal"
+    ~title:"Unauthorized proposal"
+    ~description:"The delegate provided for the proposal is not in the voting listings."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized proposal")
+    empty
+    (function Unauthorized_proposal -> Some () | _ -> None)
+    (fun () -> Unauthorized_proposal) ;
+  (* Unexpected ballot *)
+  register_error_kind
+    `Branch
+    ~id:"unexpected_ballot"
+    ~title:"Unexpected ballot"
+    ~description:"Ballot recorded outside of a voting period."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected ballot")
+    empty
+    (function Unexpected_ballot -> Some () | _ -> None)
+    (fun () -> Unexpected_ballot) ;
+  (* Unauthorized ballot *)
+  register_error_kind
+    `Branch
+    ~id:"unauthorized_ballot"
+    ~title:"Unauthorized ballot"
+    ~description:"The delegate provided for the ballot is not in the voting listings."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized ballot")
+    empty
+    (function Unauthorized_ballot -> Some () | _ -> None)
+    (fun () -> Unauthorized_ballot)
+
 let record_proposals ctxt delegate proposals =
   Vote.get_current_period_kind ctxt >>=? function
   | Proposal ->
@@ -146,4 +199,3 @@ let may_start_new_voting_cycle ctxt =
     start_new_voting_cycle ctxt
   else
     return ctxt
-

src/proto_alpha/lib_protocol/src/baking.ml

@@ -136,7 +136,19 @@ let check_baking_rights c { Block_header.priority ; _ }
   check_timestamp c priority pred_timestamp >>=? fun () ->
   return delegate
 
-type error += Incorrect_priority
+type error += Incorrect_priority (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"incorrect_priority"
+    ~title:"Incorrect priority"
+    ~description:"Block priority must be non-negative."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "The block priority must be non-negative.")
+    Data_encoding.unit
+    (function Incorrect_priority -> Some () | _ -> None)
+    (fun () -> Incorrect_priority)
 
 let endorsement_reward ctxt ~block_priority:prio n =
   if Compare.Int.(prio >= 0)

src/proto_alpha/lib_protocol/src/fitness_repr.ml

@@ -7,7 +7,18 @@
 (*                                                                        *)
 (**************************************************************************)
 
-type error += Invalid_fitness
+type error += Invalid_fitness (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"invalid_fitness"
+    ~title:"Invalid fitness"
+    ~description:"Fitness representation should be exactly 8 bytes long."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid fitness")
+    Data_encoding.empty
+    (function Invalid_fitness -> Some () | _ -> None)
+    (fun () -> Invalid_fitness)
 
 let int64_to_bytes i =
   let b = MBytes.create 8 in

src/proto_alpha/lib_protocol/src/period_repr.ml

@@ -14,10 +14,33 @@ let encoding = Data_encoding.int64
 
 let pp ppf v = Format.fprintf ppf "%Ld" v
 
-type error +=
+type error += (* `Permanent *)
   | Malformed_period
   | Invalid_arg
 
+let () =
+  let open Data_encoding in
+  (* Malformed period *)
+  register_error_kind
+    `Permanent
+    ~id:"malformed_period"
+    ~title:"Malformed period"
+    ~description:"Period is negative."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Malformed period")
+    empty
+    (function Malformed_period -> Some () | _ -> None)
+    (fun () -> Malformed_period) ;
+  (* Invalid arg *)
+  register_error_kind
+    `Permanent
+    ~id:"invalid_arg"
+    ~title:"Invalid arg"
+    ~description:"Negative multiple of periods are not allowed."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid arg")
+    empty
+    (function Invalid_arg -> Some () | _ -> None)
+    (fun () -> Invalid_arg)
+
 let of_seconds t =
   if Compare.Int64.(t >= 0L)
   then ok t

src/proto_alpha/lib_protocol/src/raw_level_repr.ml

@@ -40,7 +40,19 @@ let of_int32_exn l =
   then l
   else invalid_arg "Level_repr.of_int32"
 
-type error += Unexpected_level of Int32.t
+type error += Unexpected_level of Int32.t (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"unexpected_level"
+    ~title:"Unexpected level"
+    ~description:"Level must be non-negative."
+    ~pp:(fun ppf l ->
+        Format.fprintf ppf "The level is %s but should be non-negative." (Int32.to_string l))
+    Data_encoding.(obj1 (req "level" int32))
+    (function Unexpected_level l -> Some l | _ -> None)
+    (fun l -> Unexpected_level l)
 
 let of_int32 l =
   try Ok (of_int32_exn l)

src/proto_alpha/lib_protocol/src/roll_storage.ml

@@ -10,24 +10,59 @@
 open Misc
 
 type error +=
-  | Consume_roll_change
-  | No_roll_for_delegate
-  | No_roll_snapshot_for_cycle of Cycle_repr.t
+  | Consume_roll_change (* `Permanent *)
+  | No_roll_for_delegate (* `Permanent *)
+  | No_roll_snapshot_for_cycle of Cycle_repr.t (* `Permanent *)
   | Unregistered_delegate of Signature.Public_key_hash.t (* `Permanent *)
 
 let () =
+  let open Data_encoding in
+  (* Consume roll change *)
+  register_error_kind
+    `Permanent
+    ~id:"contract.manager.consume_roll_change"
+    ~title:"Consume roll change"
+    ~description:"Change is not enough to consume a roll."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "Not enough change to consume a roll.")
+    empty
+    (function Consume_roll_change -> Some () | _ -> None)
+    (fun () -> Consume_roll_change) ;
+  (* No roll for delegate *)
+  register_error_kind
+    `Permanent
+    ~id:"contract.manager.no_roll_for_delegate"
+    ~title:"No roll for delegate"
+    ~description:"Delegate has no roll."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Delegate has no roll.")
+    empty
+    (function No_roll_for_delegate -> Some () | _ -> None)
+    (fun () -> No_roll_for_delegate) ;
+  (* No roll snapshot for cycle *)
+  register_error_kind
+    `Permanent
+    ~id:"contract.manager.no_roll_snapshot_for_cycle"
+    ~title:"No roll snapshot for cycle"
+    ~description:"A snapshot of the rolls distribution does not exist for this cycle."
+    ~pp:(fun ppf c ->
+        Format.fprintf ppf
+          "A snapshot of the rolls distribution does not exist for cycle %a" Cycle_repr.pp c)
+    (obj1 (req "cycle" Cycle_repr.encoding))
+    (function No_roll_snapshot_for_cycle c-> Some c | _ -> None)
+    (fun c -> No_roll_snapshot_for_cycle c) ;
+  (* Unregistered delegate *)
   register_error_kind
     `Permanent
     ~id:"contract.manager.unregistered_delegate"
     ~title:"Unregistered delegate"
     ~description:"A contract cannot be delegated to an unregistered delegate"
-    ~pp:(fun ppf (k) ->
+    ~pp:(fun ppf k->
         Format.fprintf ppf "The provided public key (with hash %a) is \
                            \ not registered as valid delegate key."
           Signature.Public_key_hash.pp k)
-    Data_encoding.(obj1 (req "hash" Signature.Public_key_hash.encoding))
-    (function Unregistered_delegate (k) -> Some (k) | _ -> None)
-    (fun (k) -> Unregistered_delegate (k))
+    (obj1 (req "hash" Signature.Public_key_hash.encoding))
+    (function Unregistered_delegate k -> Some k | _ -> None)
+    (fun k -> Unregistered_delegate k)
 
 let get_contract_delegate c contract =
   Storage.Contract.Delegate.get_option c contract

src/proto_alpha/lib_protocol/src/seed_repr.ml

@@ -76,7 +76,20 @@ let take_int32 s bound =
     in
     loop s
 
-type error += Unexpected_nonce_length
+type error += Unexpected_nonce_length (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"unexpected_nonce_length"
+    ~title:"Unexpected nonce length"
+    ~description:"Nonce length is incorrect."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "Nonce length is not %i bytes long as it should."
+          Constants_repr.nonce_length)
+    Data_encoding.empty
+    (function Unexpected_nonce_length -> Some () | _ -> None)
+    (fun () -> Unexpected_nonce_length)
 
 let make_nonce nonce =
   if Compare.Int.(MBytes.length nonce <> Constants_repr.nonce_length)

src/proto_alpha/lib_protocol/src/time_repr.ml

@@ -10,7 +10,19 @@
 include Time
 type time = t
 
-type error += Timestamp_add of exn
+type error += Timestamp_add (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"timestamp_add"
+    ~title:"Timestamp add"
+    ~description:"Overflow when adding timestamps."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "Overflow when adding timestamps.")
+    Data_encoding.empty
+    (function Timestamp_add -> Some () | _ -> None)
+    (fun () -> Timestamp_add)
 
 let of_seconds s =
   try Some (of_seconds (Int64.of_string s))
@@ -23,5 +35,4 @@ let pp = pp_hum
 let (+?) x y =
   (* TODO check overflow *)
   try ok (add x (Period_repr.to_seconds y))
-  with exn -> Error [Timestamp_add exn]
-
+  with _exn -> Error [ Timestamp_add ]