Alpha: allow more constant parametrization

This commit is contained in:
Grégoire Henry 2018-04-09 15:39:13 +02:00
parent 90afe58372
commit 98f30a3e85
13 changed files with 265 additions and 128 deletions

View File

@ -480,12 +480,6 @@ module Baking = struct
~src_sk
()
let endorsement_reward block =
Alpha_services.priority !rpc_ctxt block >>=? fun prio ->
Baking.endorsement_reward ~block_priority:prio >|=
Alpha_environment.wrap_error >>|?
Tez.to_mutez
end
module Endorse = struct
@ -578,3 +572,6 @@ let display_level block =
Alpha_services.Context.level !rpc_ctxt block >>=? fun lvl ->
Format.eprintf "Level: %a@." Level.pp_full lvl ;
return ()
let endorsement_security_deposit block =
Constants_services.endorsement_security_deposit !rpc_ctxt block

View File

@ -106,9 +106,6 @@ module Baking : sig
Operation.raw list ->
Block_hash.t tzresult Lwt.t
val endorsement_reward:
Block_services.block -> int64 tzresult Lwt.t
end
module Endorse : sig
@ -210,3 +207,5 @@ module Assert : sig
end
val display_level: Block_services.block -> unit tzresult Lwt.t
val endorsement_security_deposit: Block_services.block -> Tez.t tzresult Lwt.t

View File

@ -107,7 +107,8 @@ let test_endorsement_rewards block0 =
done ;
return (!account, !cpt) in
let deposit = Tez.to_mutez Constants.endorsement_security_deposit in
Proto_alpha_helpers.endorsement_security_deposit block0 >>=? fun deposit ->
let deposit = Tez.to_mutez deposit in
(* Endorsement Rights *)
(* #1 endorse & inject in a block *)

View File

@ -250,24 +250,12 @@ module Constants : sig
proof_of_work_nonce_size : int ;
nonce_length : int ;
max_revelations_per_block : int ;
seed_nonce_revelation_tip : Tez.t ;
origination_burn : Tez.t ;
block_security_deposit : Tez.t ;
endorsement_security_deposit : Tez.t ;
block_reward : Tez.t ;
endorsement_reward : Tez.t ;
}
val fixed_encoding: fixed Data_encoding.t
val fixed: fixed
val proof_of_work_nonce_size: int
val block_reward: Tez.t
val endorsement_reward: Tez.t
val nonce_length: int
val seed_nonce_revelation_tip: Tez.t
val origination_burn: Tez.t
val block_security_deposit: Tez.t
val endorsement_security_deposit: Tez.t
val max_revelations_per_block: int
@ -287,6 +275,12 @@ module Constants : sig
max_operation_data_length: int ;
tokens_per_roll: Tez.t ;
michelson_maximum_type_size: int;
seed_nonce_revelation_tip: Tez.t ;
origination_burn: Tez.t ;
block_security_deposit: Tez.t ;
endorsement_security_deposit: Tez.t ;
block_reward: Tez.t ;
endorsement_reward: Tez.t ;
}
val parametric_encoding: parametric Data_encoding.t
val parametric: context -> parametric
@ -305,12 +299,19 @@ module Constants : sig
val max_operation_data_length: context -> int
val tokens_per_roll: context -> Tez.t
val michelson_maximum_type_size: context -> int
val block_reward: context -> Tez.t
val endorsement_reward: context -> Tez.t
val seed_nonce_revelation_tip: context -> Tez.t
val origination_burn: context -> Tez.t
val block_security_deposit: context -> Tez.t
val endorsement_security_deposit: context -> Tez.t
type t = {
fixed : fixed ;
parametric : parametric ;
}
val encoding: t Data_encoding.t
end
module Voting_period : sig

View File

@ -337,7 +337,7 @@ let apply_consensus_operation_content ctxt
let delegate = Ed25519.Public_key.hash delegate in
let ctxt = Fitness.increase ~gap:(List.length slots) ctxt in
Baking.freeze_endorsement_deposit ctxt delegate >>=? fun ctxt ->
Baking.endorsement_reward ~block_priority >>=? fun reward ->
Baking.endorsement_reward ctxt ~block_priority >>=? fun reward ->
Delegate.freeze_rewards ctxt delegate reward >>=? fun ctxt ->
return ctxt
@ -494,7 +494,9 @@ let apply_anonymous_operation ctxt _delegate origination_nonce kind =
| Seed_nonce_revelation { level ; nonce } ->
let level = Level.from_raw ctxt level in
Nonce.reveal ctxt level nonce >>=? fun ctxt ->
add_rewards ctxt Constants.seed_nonce_revelation_tip >>=? fun ctxt ->
let seed_nonce_revelation_tip =
Constants.seed_nonce_revelation_tip ctxt in
add_rewards ctxt seed_nonce_revelation_tip >>=? fun ctxt ->
return (ctxt, origination_nonce)
| Double_endorsement_evidence { op1 ; op2 } -> begin
match op1.contents, op2.contents with
@ -663,7 +665,8 @@ let begin_application ctxt block_header pred_timestamp =
return (ctxt, delegate_pk, deposit)
let finalize_application ctxt protocol_data delegate deposit =
add_rewards ctxt Constants.block_reward >>=? fun ctxt ->
let block_reward = Constants.block_reward ctxt in
add_rewards ctxt block_reward >>=? fun ctxt ->
(* end of level (from this point nothing should fail) *)
let fees = Alpha_context.get_fees ctxt in
Delegate.freeze_fees ctxt delegate fees >>=? fun ctxt ->

View File

@ -155,13 +155,13 @@ let freeze_baking_deposit ctxt { Block_header.priority ; _ } delegate =
if Compare.Int.(priority >= Constants.first_free_baking_slot ctxt)
then return (ctxt, Tez.zero)
else
let deposit = Constants.block_security_deposit in
let deposit = Constants.block_security_deposit ctxt in
Delegate.freeze_deposit ctxt delegate deposit
|> trace Cannot_freeze_baking_deposit >>=? fun ctxt ->
return (ctxt, deposit)
let freeze_endorsement_deposit ctxt delegate =
let deposit = Constants.endorsement_security_deposit in
let deposit = Constants.endorsement_security_deposit ctxt in
Delegate.freeze_deposit ctxt delegate deposit
|> trace Cannot_freeze_endorsement_deposit
@ -196,11 +196,11 @@ let paying_priorities c =
type error += Incorect_priority
let endorsement_reward ~block_priority:prio =
let endorsement_reward ctxt ~block_priority:prio =
if Compare.Int.(prio >= 0)
then
Lwt.return
Tez.(Constants.endorsement_reward /? (Int64.(succ (of_int prio))))
Tez.(Constants.endorsement_reward ctxt /? (Int64.(succ (of_int prio))))
else fail Incorect_priority
let baking_priorities c level =

View File

@ -69,7 +69,7 @@ val check_endorsements_rights:
context -> Level.t -> int list -> public_key tzresult Lwt.t
(** Returns the endorsement reward calculated w.r.t a given priotiry. *)
val endorsement_reward: block_priority:int -> Tez.t tzresult Lwt.t
val endorsement_reward: context -> block_priority:int -> Tez.t tzresult Lwt.t
(** [baking_priorities ctxt level] is the lazy list of contract's
public key hashes that are allowed to bake for [level]. *)

View File

@ -12,42 +12,10 @@ let proof_of_work_nonce_size = 8
let nonce_length = 32
let max_revelations_per_block = 32
(* 1/8 tez *)
let seed_nonce_revelation_tip =
match Tez_repr.(one /? 8L) with
| Ok c -> c
| Error _ -> assert false
(* 1 tez *)
let origination_burn =
Tez_repr.one
(* 512 tez *)
let block_security_deposit =
Tez_repr.(mul_exn one 512)
(* 64 tez *)
let endorsement_security_deposit =
Tez_repr.(mul_exn one 64)
(* 16 tez *)
let block_reward =
Tez_repr.(mul_exn one 16)
(* 2 tez *)
let endorsement_reward =
Tez_repr.(mul_exn one 2)
type fixed = {
proof_of_work_nonce_size : int ;
nonce_length : int ;
max_revelations_per_block : int ;
seed_nonce_revelation_tip : Tez_repr.t ;
origination_burn : Tez_repr.t ;
block_security_deposit : Tez_repr.t ;
endorsement_security_deposit : Tez_repr.t ;
block_reward : Tez_repr.t ;
endorsement_reward : Tez_repr.t ;
}
let fixed_encoding =
@ -56,53 +24,23 @@ let fixed_encoding =
(fun c ->
( c.proof_of_work_nonce_size,
c.nonce_length,
c.max_revelations_per_block,
c.seed_nonce_revelation_tip,
c.origination_burn,
c.block_security_deposit,
c.endorsement_security_deposit,
c.block_reward,
c.endorsement_reward ))
c.max_revelations_per_block ))
(fun ( proof_of_work_nonce_size,
nonce_length,
max_revelations_per_block,
seed_nonce_revelation_tip,
origination_burn,
block_security_deposit,
endorsement_security_deposit,
block_reward,
endorsement_reward) ->
max_revelations_per_block ) ->
{ proof_of_work_nonce_size ;
nonce_length ;
max_revelations_per_block ;
seed_nonce_revelation_tip ;
origination_burn ;
block_security_deposit ;
endorsement_security_deposit ;
block_reward ;
endorsement_reward ;
} )
(obj9
(obj3
(req "proof_of_work_nonce_size" uint8)
(req "nonce_length" uint8)
(req "max_revelations_per_block" uint8)
(req "seed_nonce_revelation_tip" Tez_repr.encoding)
(req "origination_burn" Tez_repr.encoding)
(req "block_security_deposit" Tez_repr.encoding)
(req "endorsement_security_deposit" Tez_repr.encoding)
(req "block_reward" Tez_repr.encoding)
(req "endorsement_reward" Tez_repr.encoding))
(req "max_revelations_per_block" uint8))
let fixed = {
proof_of_work_nonce_size ;
nonce_length ;
max_revelations_per_block ;
seed_nonce_revelation_tip ;
origination_burn ;
block_security_deposit ;
endorsement_security_deposit ;
block_reward ;
endorsement_reward ;
}
type parametric = {
@ -120,6 +58,12 @@ type parametric = {
max_operation_data_length: int ;
tokens_per_roll: Tez_repr.t ;
michelson_maximum_type_size: int;
seed_nonce_revelation_tip: Tez_repr.t ;
origination_burn: Tez_repr.t ;
block_security_deposit: Tez_repr.t ;
endorsement_security_deposit: Tez_repr.t ;
block_reward: Tez_repr.t ;
endorsement_reward: Tez_repr.t ;
}
let default = {
@ -143,12 +87,18 @@ let default = {
tokens_per_roll =
Tez_repr.(mul_exn one 10_000) ;
michelson_maximum_type_size = 1000 ;
seed_nonce_revelation_tip = begin
match Tez_repr.(one /? 8L) with
| Ok c -> c
| Error _ -> assert false
end ;
origination_burn = Tez_repr.one ;
block_security_deposit = Tez_repr.(mul_exn one 512) ;
endorsement_security_deposit = Tez_repr.(mul_exn one 64) ;
block_reward = Tez_repr.(mul_exn one 16) ;
endorsement_reward = Tez_repr.(mul_exn one 2) ;
}
let map_option f = function
| None -> None
| Some x -> Some (f x)
module CompareListInt = Compare.List (Compare.Int)
(* This encoding is used to read configuration files (e.g. sandbox.json)
@ -203,6 +153,24 @@ let sandbox_encoding =
and michelson_maximum_type_size =
opt Compare.Int.(=)
default.michelson_maximum_type_size c.michelson_maximum_type_size
and seed_nonce_revelation_tip =
opt Tez_repr.(=)
default.seed_nonce_revelation_tip c.seed_nonce_revelation_tip
and origination_burn =
opt Tez_repr.(=)
default.origination_burn c.origination_burn
and block_security_deposit =
opt Tez_repr.(=)
default.block_security_deposit c.block_security_deposit
and endorsement_security_deposit =
opt Tez_repr.(=)
default.endorsement_security_deposit c.endorsement_security_deposit
and block_reward =
opt Tez_repr.(=)
default.block_reward c.block_reward
and endorsement_reward =
opt Tez_repr.(=)
default.endorsement_reward c.endorsement_reward
in
((( preserved_cycles,
blocks_per_cycle,
@ -212,12 +180,18 @@ let sandbox_encoding =
time_between_blocks,
first_free_baking_slot,
endorsers_per_block,
max_gas),
( proof_of_work_threshold,
dictator_pubkey,
max_gas,
proof_of_work_threshold),
( dictator_pubkey,
max_operation_data_length,
tokens_per_roll,
michelson_maximum_type_size)), ()) )
michelson_maximum_type_size,
seed_nonce_revelation_tip,
origination_burn,
block_security_deposit,
endorsement_security_deposit,
block_reward,
endorsement_reward)), ()) )
(fun ((( preserved_cycles,
blocks_per_cycle,
blocks_per_commitment,
@ -226,12 +200,18 @@ let sandbox_encoding =
time_between_blocks,
first_free_baking_slot,
endorsers_per_block,
max_gas),
( proof_of_work_threshold,
dictator_pubkey,
max_gas,
proof_of_work_threshold),
( dictator_pubkey,
max_operation_data_length,
tokens_per_roll,
michelson_maximum_type_size)), ()) ->
michelson_maximum_type_size,
seed_nonce_revelation_tip,
origination_burn,
block_security_deposit,
endorsement_security_deposit,
block_reward,
endorsement_reward)), ()) ->
let unopt def = function None -> def | Some v -> v in
{ preserved_cycles =
unopt default.preserved_cycles preserved_cycles ;
@ -262,10 +242,22 @@ let sandbox_encoding =
unopt default.tokens_per_roll tokens_per_roll ;
michelson_maximum_type_size =
unopt default.michelson_maximum_type_size michelson_maximum_type_size ;
seed_nonce_revelation_tip =
unopt default.seed_nonce_revelation_tip seed_nonce_revelation_tip ;
origination_burn =
unopt default.origination_burn origination_burn ;
block_security_deposit =
unopt default.block_security_deposit block_security_deposit ;
endorsement_security_deposit =
unopt default.endorsement_security_deposit endorsement_security_deposit ;
block_reward =
unopt default.block_reward block_reward ;
endorsement_reward =
unopt default.endorsement_reward endorsement_reward ;
} )
(merge_objs
(merge_objs
(obj9
(obj10
(opt "preserved_cycles" uint8)
(opt "blocks_per_cycle" int32)
(opt "blocks_per_commitment" int32)
@ -274,14 +266,19 @@ let sandbox_encoding =
(opt "time_between_blocks" (list Period_repr.encoding))
(opt "first_free_baking_slot" uint16)
(opt "endorsers_per_block" uint16)
(opt "instructions_per_transaction" int31))
(obj5
(opt "proof_of_work_threshold" int64)
(opt "instructions_per_transaction" int31)
(opt "proof_of_work_threshold" int64))
(obj10
(opt "dictator_pubkey" Ed25519.Public_key.encoding)
(opt "max_operation_data_length" int31)
(opt "tokens_per_roll" Tez_repr.encoding)
(opt "michelson_maximum_type_size" uint16)
))
(opt "seed_nonce_revelation_tip" Tez_repr.encoding)
(opt "origination_burn" Tez_repr.encoding)
(opt "block_security_deposit" Tez_repr.encoding)
(opt "endorsement_security_deposit" Tez_repr.encoding)
(opt "block_reward" Tez_repr.encoding)
(opt "endorsement_reward" Tez_repr.encoding)))
unit)
let parametric_encoding =
@ -296,12 +293,18 @@ let parametric_encoding =
c.time_between_blocks,
c.first_free_baking_slot,
c.endorsers_per_block,
c.max_gas),
( c.proof_of_work_threshold,
c.dictator_pubkey,
c.max_gas,
c.proof_of_work_threshold ),
( c.dictator_pubkey,
c.max_operation_data_length,
c.tokens_per_roll,
c.michelson_maximum_type_size)) )
c.michelson_maximum_type_size,
c.seed_nonce_revelation_tip,
c.origination_burn,
c.block_security_deposit,
c.endorsement_security_deposit,
c.block_reward,
c.endorsement_reward)) )
(fun (( preserved_cycles,
blocks_per_cycle,
blocks_per_commitment,
@ -310,12 +313,18 @@ let parametric_encoding =
time_between_blocks,
first_free_baking_slot,
endorsers_per_block,
max_gas),
( proof_of_work_threshold,
dictator_pubkey,
max_gas,
proof_of_work_threshold ),
( dictator_pubkey,
max_operation_data_length,
tokens_per_roll,
michelson_maximum_type_size)) ->
michelson_maximum_type_size,
seed_nonce_revelation_tip,
origination_burn,
block_security_deposit,
endorsement_security_deposit,
block_reward,
endorsement_reward )) ->
{ preserved_cycles ;
blocks_per_cycle ;
blocks_per_commitment ;
@ -330,9 +339,15 @@ let parametric_encoding =
max_operation_data_length ;
tokens_per_roll ;
michelson_maximum_type_size ;
seed_nonce_revelation_tip ;
origination_burn ;
block_security_deposit ;
endorsement_security_deposit ;
block_reward ;
endorsement_reward ;
} )
(merge_objs
(obj9
(obj10
(req "preserved_cycles" uint8)
(req "blocks_per_cycle" int32)
(req "blocks_per_commitment" int32)
@ -341,13 +356,19 @@ let parametric_encoding =
(req "time_between_blocks" (list Period_repr.encoding))
(req "first_free_baking_slot" uint16)
(req "endorsers_per_block" uint16)
(req "instructions_per_transaction" int31))
(obj5
(req "proof_of_work_threshold" int64)
(req "instructions_per_transaction" int31)
(req "proof_of_work_threshold" int64))
(obj10
(req "dictator_pubkey" Ed25519.Public_key.encoding)
(req "max_operation_data_length" int31)
(req "tokens_per_roll" Tez_repr.encoding)
(req "michelson_maximum_type_size" uint16)))
(req "michelson_maximum_type_size" uint16)
(req "seed_nonce_revelation_tip" Tez_repr.encoding)
(req "origination_burn" Tez_repr.encoding)
(req "block_security_deposit" Tez_repr.encoding)
(req "endorsement_security_deposit" Tez_repr.encoding)
(req "block_reward" Tez_repr.encoding)
(req "endorsement_reward" Tez_repr.encoding)))
type t = {
fixed : fixed ;

View File

@ -96,6 +96,54 @@ module S = struct
~output: (obj1 (req "proof_of_work_threshold" int64))
RPC_path.(custom_root / "proof_of_work_threshold")
let seed_nonce_revelation_tip =
RPC_service.post_service
~description: "seed_nonce_revelation_tip"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "seed_nonce_revelation_tip" Tez.encoding))
RPC_path.(custom_root / "seed_nonce_revelation_tip")
let origination_burn =
RPC_service.post_service
~description: "origination_burn"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "origination_burn" Tez.encoding))
RPC_path.(custom_root / "origination_burn")
let block_security_deposit =
RPC_service.post_service
~description: "block_security_deposit"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "block_security_deposit" Tez.encoding))
RPC_path.(custom_root / "block_security_deposit")
let endorsement_security_deposit =
RPC_service.post_service
~description: "endorsement_security_deposit"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "endorsement_security_deposit" Tez.encoding))
RPC_path.(custom_root / "endorsement_security_deposit")
let block_reward =
RPC_service.post_service
~description: " block_reward"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req " block_reward" Tez.encoding))
RPC_path.(custom_root / " block_reward")
let endorsement_reward =
RPC_service.post_service
~description: " endorsement_reward"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req " endorsement_reward" Tez.encoding))
RPC_path.(custom_root / " endorsement_reward")
let errors =
RPC_service.post_service
~description: "Schema for all the RPC errors from this protocol version"
@ -147,6 +195,24 @@ let () =
register0 S.proof_of_work_threshold begin fun ctxt () () ->
return (Constants.proof_of_work_threshold ctxt)
end ;
register0 S.seed_nonce_revelation_tip begin fun ctxt () () ->
return (Constants.seed_nonce_revelation_tip ctxt)
end ;
register0 S.origination_burn begin fun ctxt () () ->
return (Constants.origination_burn ctxt)
end ;
register0 S.block_security_deposit begin fun ctxt () () ->
return (Constants.block_security_deposit ctxt)
end ;
register0 S.endorsement_security_deposit begin fun ctxt () () ->
return (Constants.endorsement_security_deposit ctxt)
end ;
register0 S.block_reward begin fun ctxt () () ->
return (Constants.block_reward ctxt)
end ;
register0 S.endorsement_reward begin fun ctxt () () ->
return (Constants.endorsement_reward ctxt)
end ;
register0_noctxt S.errors begin fun () () ->
return (Data_encoding.Json.(schema error_encoding))
end ;
@ -176,6 +242,18 @@ let max_gas ctxt block =
RPC_context.make_call0 S.max_gas ctxt block () ()
let proof_of_work_threshold ctxt block =
RPC_context.make_call0 S.proof_of_work_threshold ctxt block () ()
let seed_nonce_revelation_tip ctxt block =
RPC_context.make_call0 S.seed_nonce_revelation_tip ctxt block () ()
let origination_burn ctxt block =
RPC_context.make_call0 S.origination_burn ctxt block () ()
let block_security_deposit ctxt block =
RPC_context.make_call0 S.block_security_deposit ctxt block () ()
let endorsement_security_deposit ctxt block =
RPC_context.make_call0 S.endorsement_security_deposit ctxt block () ()
let block_reward ctxt block =
RPC_context.make_call0 S.block_reward ctxt block () ()
let endorsement_reward ctxt block =
RPC_context.make_call0 S.endorsement_reward ctxt block () ()
let errors ctxt block =
RPC_context.make_call0 S.errors ctxt block () ()
let all ctxt block =

View File

@ -39,6 +39,24 @@ val max_gas:
val proof_of_work_threshold:
'a #RPC_context.simple -> 'a -> Int64.t shell_tzresult Lwt.t
val seed_nonce_revelation_tip:
'a #RPC_context.simple -> 'a -> Tez.t shell_tzresult Lwt.t
val origination_burn:
'a #RPC_context.simple -> 'a -> Tez.t shell_tzresult Lwt.t
val block_security_deposit:
'a #RPC_context.simple -> 'a -> Tez.t shell_tzresult Lwt.t
val endorsement_security_deposit:
'a #RPC_context.simple -> 'a -> Tez.t shell_tzresult Lwt.t
val block_reward:
'a #RPC_context.simple -> 'a -> Tez.t shell_tzresult Lwt.t
val endorsement_reward:
'a #RPC_context.simple -> 'a -> Tez.t shell_tzresult Lwt.t
val errors:
'a #RPC_context.simple -> 'a -> Data_encoding.json_schema shell_tzresult Lwt.t

View File

@ -49,5 +49,23 @@ let tokens_per_roll c =
let michelson_maximum_type_size c =
let constants = Raw_context.constants c in
constants.michelson_maximum_type_size
let seed_nonce_revelation_tip c =
let constants = Raw_context.constants c in
constants.seed_nonce_revelation_tip
let origination_burn c =
let constants = Raw_context.constants c in
constants.origination_burn
let block_security_deposit c =
let constants = Raw_context.constants c in
constants.block_security_deposit
let endorsement_security_deposit c =
let constants = Raw_context.constants c in
constants.endorsement_security_deposit
let block_reward c =
let constants = Raw_context.constants c in
constants.block_reward
let endorsement_reward c =
let constants = Raw_context.constants c in
constants.endorsement_reward
let parametric c =
Raw_context.constants c

View File

@ -24,7 +24,8 @@ let () =
let origination_burn c ~source contract =
Contract.spend_from_script c source Constants.origination_burn >>=? fun c ->
let origination_burn = Constants.origination_burn c in
Contract.spend_from_script c source origination_burn >>=? fun c ->
Contract.code_and_storage_fee c contract >>=? fun storage_fee ->
Contract.spend_from_script c source storage_fee
|> trace Cannot_pay_storage_fee

View File

@ -721,7 +721,7 @@ let rec interp
let gas = Gas.consume gas Gas.Cost_of.create_account in
Gas.check gas >>=? fun () ->
Contract.spend_from_script ctxt source credit >>=? fun ctxt ->
Lwt.return Tez.(credit -? Constants.origination_burn) >>=? fun balance ->
Lwt.return Tez.(credit -? Constants.origination_burn ctxt) >>=? fun balance ->
Contract.originate ctxt
origination
~manager ~delegate ~balance