Alphanet: never more than 5 faucet operations per block

src/proto/alpha/apply.ml

@@ -14,6 +14,8 @@ open Tezos_context
 type error += Wrong_voting_period of Voting_period.t * Voting_period.t (* `Temporary *)
 type error += Wrong_endorsement_predecessor of Block_hash.t * Block_hash.t (* `Temporary *)
 type error += Bad_contract_parameter of Contract.t * Script.expr option * Script.expr option (* `Permanent *)
+type error += Too_many_faucet
+
 
 let () =
   register_error_kind
@@ -57,7 +59,19 @@ let () =
                      (opt "providedArgument" Script.expr_encoding))
     (function Bad_contract_parameter (c, expected, supplied) ->
        Some (c, expected, supplied) | _ -> None)
-    (fun (c, expected, supplied) -> Bad_contract_parameter (c, expected, supplied))
+    (fun (c, expected, supplied) -> Bad_contract_parameter (c, expected, supplied)) ;
+  register_error_kind
+    `Temporary
+    ~id:"operation.too_many_faucet"
+    ~title:"Too many faucet"
+    ~description:"Trying to include a faucet operation in a block \
+                 \ with more than 5 faucet operations."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "Too many faucet operation.")
+    Data_encoding.unit
+    (function Too_many_faucet -> Some () | _ -> None)
+    (fun () -> Too_many_faucet)
+
 
 let apply_delegate_operation_content
     ctxt delegate pred_block block_priority = function
@@ -219,11 +233,15 @@ let apply_anonymous_operation ctxt baker_contract origination_nonce kind =
         | None -> return None
         | Some contract -> Contract.get_delegate_opt ctxt contract
       end >>=? fun delegate ->
+      if Compare.Int.(faucet_count ctxt < 5) then
+        let ctxt = incr_faucet_count ctxt in
         Contract.originate ctxt
           origination_nonce
           ~manager ~delegate ~balance:Constants.faucet_credit ?script:None
           ~spendable:true ~delegatable:true >>=? fun (ctxt, _, origination_nonce) ->
         return (ctxt, origination_nonce)
+      else
+        fail Too_many_faucet
 
 let apply_operation
     ctxt baker_contract pred_block block_prio operation =

src/proto/alpha/raw_context.ml

@@ -15,6 +15,7 @@ type t = {
   timestamp: Time.t ;
   fitness: Int64.t ;
   roll_value: Tez_repr.t ;
+  faucet_count: int;
 }
 type context = t
 type root_context = t
@@ -23,10 +24,12 @@ let current_level ctxt = ctxt.level
 let current_timestamp ctxt = ctxt.timestamp
 let current_fitness ctxt = ctxt.fitness
 let first_level ctxt = ctxt.first_level
+let faucet_count ctxt = ctxt.faucet_count
 let constants ctxt = ctxt.constants
 let roll_value ctxt = ctxt.roll_value
 let recover ctxt = ctxt.context
 
+let incr_faucet_count ctxt = { ctxt with faucet_count = ctxt.faucet_count + 1 }
 let set_current_fitness ctxt fitness = { ctxt with fitness }
 
 type storage_error =
@@ -225,6 +228,7 @@ let prepare ~level ~timestamp ~fitness ctxt =
       level in
   return ({ context = ctxt ; constants ; level ;
             timestamp ; fitness ; first_level ; roll_value ;
+            faucet_count = 0 ;
           },
           first_block)
 
@@ -252,6 +256,7 @@ let register_resolvers enc resolve =
       timestamp = Time.of_seconds 0L ;
       fitness = 0L ;
       roll_value = Tez_repr.zero ;
+      faucet_count = 0 ;
     } in
     resolve faked_context str in
   Context.register_resolver enc  resolve

src/proto/alpha/raw_context.mli

@@ -136,3 +136,5 @@ include T with type t := t and type context := context
 
 (** HACK alphanet *)
 val double_roll_value: context -> int -> context tzresult Lwt.t
+val faucet_count: context -> int
+val incr_faucet_count: context -> context

src/proto/alpha/tezos_context.ml

@@ -141,3 +141,6 @@ let configure_sandbox = Raw_context.configure_sandbox
 
 let activate = Raw_context.activate
 let fork_test_network = Raw_context.fork_test_network
+
+let faucet_count = Raw_context.faucet_count
+let incr_faucet_count = Raw_context.incr_faucet_count

src/proto/alpha/tezos_context.mli

@@ -723,3 +723,9 @@ val configure_sandbox:
 
 val activate: context -> Protocol_hash.t -> context Lwt.t
 val fork_test_network: context -> Protocol_hash.t -> Time.t -> context Lwt.t
+
+(**/**)
+
+(* HACK alphanet *)
+val faucet_count: context -> int
+val incr_faucet_count: context -> context