Skip to content

Commit 2634f8d

Browse files
committed
introduce separate modules for genesis ledger and runtime config
1 parent db303e6 commit 2634f8d

File tree

2 files changed

+244
-0
lines changed

2 files changed

+244
-0
lines changed
Lines changed: 92 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,92 @@
1+
open Core
2+
open Currency
3+
open Signature_lib
4+
5+
let runtime_timing_of_timing = function
6+
| Mina_base.Account.Timing.Untimed ->
7+
None
8+
| Timed t ->
9+
Some
10+
{ Runtime_config.Accounts.Single.Timed.initial_minimum_balance =
11+
t.initial_minimum_balance
12+
; cliff_time = t.cliff_time
13+
; cliff_amount = t.cliff_amount
14+
; vesting_period = t.vesting_period
15+
; vesting_increment = t.vesting_increment
16+
}
17+
18+
type t =
19+
{ accounts : (string * Runtime_config.Accounts.single) list
20+
; keypairs :
21+
(Network_keypair.t Core.String.Map.t
22+
[@to_yojson
23+
fun map ->
24+
`Assoc
25+
(Core.Map.fold_right ~init:[]
26+
~f:(fun ~key:k ~data:v accum ->
27+
(k, Network_keypair.to_yojson v) :: accum )
28+
map )] )
29+
}
30+
31+
let create (config : Test_config.Test_account.t list) =
32+
let key_names_list = List.map config ~f:(fun acct -> acct.account_name) in
33+
if List.contains_dup ~compare:String.compare key_names_list then
34+
failwith
35+
"All accounts in genesis ledger must have unique names. Check to make \
36+
sure you are not using the same account_name more than once" ;
37+
let keypairs =
38+
List.take
39+
(* the first keypair is the genesis winner and is assumed to be untimed.
40+
Therefore dropping it, and not assigning it to any block producer *)
41+
(List.tl_exn
42+
(Array.to_list (Lazy.force Key_gen.Sample_keypairs.keypairs)) )
43+
(List.length config)
44+
in
45+
let add_accounts accounts_and_keypairs =
46+
List.map accounts_and_keypairs
47+
~f:(fun
48+
( { Test_config.Test_account.balance
49+
; account_name
50+
; timing
51+
; permissions
52+
; zkapp
53+
}
54+
, (pk, sk) )
55+
->
56+
let timing = runtime_timing_of_timing timing in
57+
let default = Runtime_config.Accounts.Single.default in
58+
let account =
59+
{ default with
60+
pk = Public_key.Compressed.to_string pk
61+
; sk = Some (Private_key.to_base58_check sk)
62+
; balance =
63+
Balance.of_mina_string_exn balance
64+
(* delegation currently unsupported *)
65+
; delegate = None
66+
; timing
67+
; permissions =
68+
Option.map
69+
~f:Runtime_config.Accounts.Single.Permissions.of_permissions
70+
permissions
71+
; zkapp =
72+
Option.map
73+
~f:Runtime_config.Accounts.Single.Zkapp_account.of_zkapp zkapp
74+
}
75+
in
76+
(account_name, account) )
77+
in
78+
let genesis_accounts_and_keys = List.zip_exn config keypairs in
79+
let mk_net_keypair keypair_name (pk, sk) =
80+
let keypair =
81+
{ Keypair.public_key = Public_key.decompress_exn pk; private_key = sk }
82+
in
83+
Network_keypair.create_network_keypair ~keypair_name ~keypair
84+
in
85+
let genesis_keypairs =
86+
List.fold genesis_accounts_and_keys ~init:String.Map.empty
87+
~f:(fun map ({ account_name; _ }, (pk, sk)) ->
88+
let keypair = mk_net_keypair account_name (pk, sk) in
89+
String.Map.add_exn map ~key:account_name ~data:keypair )
90+
in
91+
let genesis_ledger_accounts = add_accounts genesis_accounts_and_keys in
92+
{ accounts = genesis_ledger_accounts; keypairs = genesis_keypairs }
Lines changed: 152 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,152 @@
1+
open Core
2+
open Currency
3+
open Genesis_ledger
4+
5+
let ledger_is_prefix ledger1 ledger2 =
6+
List.is_prefix ledger2 ~prefix:ledger1
7+
~equal:(fun
8+
({ account_name = name1; _ } : Test_config.Test_account.t)
9+
({ account_name = name2; _ } : Test_config.Test_account.t)
10+
-> String.equal name1 name2 )
11+
12+
let create ~(test_config : Test_config.t) ~(genesis_ledger : Genesis_ledger.t) =
13+
{ Runtime_config.daemon =
14+
Some
15+
{ txpool_max_size = Some test_config.txpool_max_size
16+
; peer_list_url = None
17+
; zkapp_proof_update_cost = None
18+
; zkapp_signed_single_update_cost = None
19+
; zkapp_signed_pair_update_cost = None
20+
; zkapp_transaction_cost_limit = None
21+
; max_event_elements = None
22+
; max_action_elements = None
23+
; zkapp_cmd_limit_hardcap = None
24+
; slot_tx_end = test_config.slot_tx_end
25+
; slot_chain_end = test_config.slot_chain_end
26+
; hard_fork_genesis_slot_delta =
27+
test_config.hard_fork_genesis_slot_delta
28+
; minimum_user_command_fee = None
29+
; network_id = test_config.network_id
30+
; sync_ledger_max_subtree_depth = None
31+
; sync_ledger_default_subtree_depth = None
32+
}
33+
; genesis =
34+
Some
35+
{ k = Some test_config.k
36+
; delta = Some test_config.delta
37+
; slots_per_epoch = Some test_config.slots_per_epoch
38+
; slots_per_sub_window = Some test_config.slots_per_sub_window
39+
; grace_period_slots = Some test_config.grace_period_slots
40+
; genesis_state_timestamp =
41+
Some Core.Time.(to_string_abs ~zone:Zone.utc (now ()))
42+
}
43+
; proof =
44+
Some test_config.proof_config (* TODO: prebake ledger and only set hash *)
45+
; ledger =
46+
Some
47+
{ base =
48+
Accounts
49+
(List.map genesis_ledger.accounts ~f:(fun (_name, acct) -> acct))
50+
; add_genesis_winner = None
51+
; num_accounts = None
52+
; balances = []
53+
; hash = None
54+
; s3_data_hash = None
55+
; name = None
56+
}
57+
; epoch_data =
58+
(* each staking epoch ledger account must also be a genesis ledger account, though
59+
the balance may be different; the converse is not necessarily true, since
60+
an account may have been added after the last epoch ledger was taken
61+
62+
each staking epoch ledger account must also be in the next epoch ledger, if provided
63+
64+
if provided, each next_epoch_ledger account must be in the genesis ledger
65+
66+
in all ledgers, the accounts must be in the same order, so that accounts will
67+
be in the same leaf order
68+
*)
69+
Option.map test_config.epoch_data
70+
~f:(fun { staking = staking_ledger; next } ->
71+
let genesis_winner_account : Runtime_config.Accounts.single =
72+
Runtime_config.Accounts.Single.of_account
73+
Mina_state.Consensus_state_hooks.genesis_winner_account
74+
|> Or_error.ok_exn
75+
in
76+
let ledger_of_epoch_accounts
77+
(epoch_accounts : Test_config.Test_account.t list) =
78+
let epoch_ledger_accounts =
79+
List.map epoch_accounts
80+
~f:(fun { account_name; balance; timing; permissions; zkapp } ->
81+
let balance = Balance.of_mina_string_exn balance in
82+
let timing = runtime_timing_of_timing timing in
83+
let genesis_account =
84+
match
85+
List.Assoc.find genesis_ledger.accounts account_name
86+
~equal:String.equal
87+
with
88+
| Some acct ->
89+
acct
90+
| None ->
91+
failwithf
92+
"Epoch ledger account %s not in genesis ledger"
93+
account_name ()
94+
in
95+
{ genesis_account with
96+
balance
97+
; timing
98+
; permissions =
99+
Option.map
100+
~f:
101+
Runtime_config.Accounts.Single.Permissions
102+
.of_permissions permissions
103+
; zkapp =
104+
Option.map
105+
~f:Runtime_config.Accounts.Single.Zkapp_account.of_zkapp
106+
zkapp
107+
} )
108+
in
109+
(* because we run integration tests with Proof_level = Full, the winner account
110+
gets added to the genesis ledger
111+
there isn't a corresponding mechanism to add the winner account to epoch
112+
ledgers, so we add it explicitly here
113+
`add_genesis_winner` in the record below has no effect, it's ignored in
114+
Runtime_config.Epoch_data.to_yojson, which is used to create the config file
115+
*)
116+
( { base = Accounts (genesis_winner_account :: epoch_ledger_accounts)
117+
; add_genesis_winner = None (* no effect *)
118+
; num_accounts = None
119+
; balances = []
120+
; hash = None
121+
; s3_data_hash = None
122+
; name = None
123+
}
124+
: Runtime_config.Ledger.t )
125+
in
126+
let staking =
127+
let ({ epoch_ledger; epoch_seed } : Test_config.Epoch_data.Data.t) =
128+
staking_ledger
129+
in
130+
if not (ledger_is_prefix epoch_ledger test_config.genesis_ledger)
131+
then failwith "Staking epoch ledger not a prefix of genesis ledger" ;
132+
let ledger = ledger_of_epoch_accounts epoch_ledger in
133+
let seed = epoch_seed in
134+
({ ledger; seed } : Runtime_config.Epoch_data.Data.t)
135+
in
136+
let next =
137+
Option.map next ~f:(fun { epoch_ledger; epoch_seed } ->
138+
if
139+
not
140+
(ledger_is_prefix staking_ledger.epoch_ledger epoch_ledger)
141+
then
142+
failwith
143+
"Staking epoch ledger not a prefix of next epoch ledger" ;
144+
if
145+
not (ledger_is_prefix epoch_ledger test_config.genesis_ledger)
146+
then failwith "Next epoch ledger not a prefix of genesis ledger" ;
147+
let ledger = ledger_of_epoch_accounts epoch_ledger in
148+
let seed = epoch_seed in
149+
({ ledger; seed } : Runtime_config.Epoch_data.Data.t) )
150+
in
151+
({ staking; next } : Runtime_config.Epoch_data.t) )
152+
}

0 commit comments

Comments
 (0)