diff --git a/src/lib/block_time/block_time.ml b/src/lib/block_time/block_time.ml index 8f92444b2b9..6783b880e94 100644 --- a/src/lib/block_time/block_time.ml +++ b/src/lib/block_time/block_time.ml @@ -26,6 +26,10 @@ module Time = struct end end] + let max_value = UInt64.max_int + + let zero = UInt64.zero + module Controller = struct [%%if time_offsets] diff --git a/src/lib/block_time/block_time.mli b/src/lib/block_time/block_time.mli index 8223c38213f..8b6b87d6750 100644 --- a/src/lib/block_time/block_time.mli +++ b/src/lib/block_time/block_time.mli @@ -6,6 +6,10 @@ open Snark_bits module Time : sig type t [@@deriving sexp, compare, yojson] + val zero : t + + val max_value : t + include Comparable.S with type t := t include Hashable.S with type t := t diff --git a/src/lib/coda_base/account.ml b/src/lib/coda_base/account.ml index c9c6cb5b003..39c1855fff7 100644 --- a/src/lib/coda_base/account.ml +++ b/src/lib/coda_base/account.ml @@ -18,6 +18,7 @@ module Coda_numbers = Coda_numbers_nonconsensus.Coda_numbers module Random_oracle = Random_oracle_nonconsensus.Random_oracle module Coda_compile_config = Coda_compile_config_nonconsensus.Coda_compile_config +open Snark_params_nonconsensus [%%endif] @@ -99,7 +100,8 @@ module Poly = struct , 'nonce , 'receipt_chain_hash , 'state_hash - , 'timing ) + , 'timing + , 'snapp_opt ) t = { public_key: 'pk ; token_id: 'tid @@ -109,7 +111,8 @@ module Poly = struct ; receipt_chain_hash: 'receipt_chain_hash ; delegate: 'pk ; voting_for: 'state_hash - ; timing: 'timing } + ; timing: 'timing + ; snapp: 'snapp_opt } [@@deriving sexp, eq, compare, hash, yojson, fields, hlist] end end] @@ -131,222 +134,19 @@ module Identifier = Account_id type key = Key.t [@@deriving sexp, eq, hash, compare, yojson] -module Timing = struct - module Poly = struct - [%%versioned - module Stable = struct - module V1 = struct - type ('slot, 'balance, 'amount) t = - | Untimed - | Timed of - { initial_minimum_balance: 'balance - ; cliff_time: 'slot - ; vesting_period: 'slot - ; vesting_increment: 'amount } - [@@deriving sexp, eq, hash, compare, yojson] - end - end] - end +module Timing = Account_timing +module Snapp_account = struct [%%versioned module Stable = struct module V1 = struct - type t = - ( Global_slot.Stable.V1.t - , Balance.Stable.V1.t - , Amount.Stable.V1.t ) - Poly.Stable.V1.t - [@@deriving sexp, eq, hash, compare, yojson] + type t = unit [@@deriving sexp, eq, hash, compare, yojson] let to_latest = Fn.id end end] - type ('slot, 'balance, 'amount) tt = ('slot, 'balance, 'amount) Poly.t = - | Untimed - | Timed of - { initial_minimum_balance: 'balance - ; cliff_time: 'slot - ; vesting_period: 'slot - ; vesting_increment: 'amount } - [@@deriving sexp, eq, hash, compare, yojson] - - module As_record = struct - type ('bool, 'slot, 'balance, 'amount) t = - { is_timed: 'bool - ; initial_minimum_balance: 'balance - ; cliff_time: 'slot - ; vesting_period: 'slot - ; vesting_increment: 'amount } - [@@deriving hlist] - end - - (* convert sum type to record format, useful for to_bits and typ *) - let to_record t = - match t with - | Untimed -> - let slot_unused = Global_slot.zero in - let slot_one = Global_slot.(succ zero) in - let balance_unused = Balance.zero in - let amount_unused = Amount.zero in - As_record. - { is_timed= false - ; initial_minimum_balance= balance_unused - ; cliff_time= slot_unused - ; vesting_period= slot_one (* avoid division by zero *) - ; vesting_increment= amount_unused } - | Timed - {initial_minimum_balance; cliff_time; vesting_period; vesting_increment} - -> - As_record. - { is_timed= true - ; initial_minimum_balance - ; cliff_time - ; vesting_period - ; vesting_increment } - - let to_bits t = - let As_record. - { is_timed - ; initial_minimum_balance - ; cliff_time - ; vesting_period - ; vesting_increment } = - to_record t - in - is_timed - :: ( Balance.to_bits initial_minimum_balance - @ Global_slot.to_bits cliff_time - @ Global_slot.to_bits vesting_period - @ Amount.to_bits vesting_increment ) - - [%%ifdef - consensus_mechanism] - - type var = - (Boolean.var, Global_slot.Checked.var, Balance.var, Amount.var) As_record.t - - let var_to_bits - As_record. - { is_timed - ; initial_minimum_balance - ; cliff_time - ; vesting_period - ; vesting_increment } = - let open Bitstring_lib.Bitstring.Lsb_first in - let initial_minimum_balance = - to_list @@ Balance.var_to_bits initial_minimum_balance - in - let cliff_time = to_list @@ Global_slot.var_to_bits cliff_time in - let vesting_period = to_list @@ Global_slot.var_to_bits vesting_period in - let vesting_increment = to_list @@ Amount.var_to_bits vesting_increment in - of_list - ( is_timed - :: ( initial_minimum_balance @ cliff_time @ vesting_period - @ vesting_increment ) ) - - let var_of_t (t : t) : var = - let As_record. - { is_timed - ; initial_minimum_balance - ; cliff_time - ; vesting_period - ; vesting_increment } = - to_record t - in - As_record. - { is_timed= Boolean.var_of_value is_timed - ; initial_minimum_balance= Balance.var_of_t initial_minimum_balance - ; cliff_time= Global_slot.Checked.constant cliff_time - ; vesting_period= Global_slot.Checked.constant vesting_period - ; vesting_increment= Amount.var_of_t vesting_increment } - - let untimed_var = var_of_t Untimed - - let typ : (var, t) Typ.t = - let spec = - let open Data_spec in - [Boolean.typ; Balance.typ; Global_slot.typ; Global_slot.typ; Amount.typ] - in - (* because we represent the types t (a sum type) and var (a record) differently, - we can't use the trick, used elsewhere, of polymorphic to_hlist and of_hlist - functions to handle both types - *) - let value_of_hlist : - ( unit - , Boolean.value - -> Balance.t - -> Global_slot.t - -> Global_slot.t - -> Amount.t - -> unit ) - H_list.t - -> t = - let open H_list in - fun [ is_timed - ; initial_minimum_balance - ; cliff_time - ; vesting_period - ; vesting_increment ] -> - if is_timed then - Timed - { initial_minimum_balance - ; cliff_time - ; vesting_period - ; vesting_increment } - else Untimed - in - let value_to_hlist (t : t) = - let As_record. - { is_timed - ; initial_minimum_balance - ; cliff_time - ; vesting_period - ; vesting_increment } = - to_record t - in - H_list. - [ is_timed - ; initial_minimum_balance - ; cliff_time - ; vesting_period - ; vesting_increment ] - in - let var_of_hlist = As_record.of_hlist in - let var_to_hlist = As_record.to_hlist in - Typ.of_hlistable spec ~var_to_hlist ~var_of_hlist ~value_to_hlist - ~value_of_hlist - - (* we can't use the generic if_ with the above typ, because Global_slot.typ doesn't work correctly with it - so we define a custom if_ - *) - let if_ b ~(then_ : var) ~(else_ : var) = - let%bind is_timed = - Boolean.if_ b ~then_:then_.is_timed ~else_:else_.is_timed - in - let%bind initial_minimum_balance = - Balance.Checked.if_ b ~then_:then_.initial_minimum_balance - ~else_:else_.initial_minimum_balance - in - let%bind cliff_time = - Global_slot.Checked.if_ b ~then_:then_.cliff_time ~else_:else_.cliff_time - in - let%bind vesting_period = - Global_slot.Checked.if_ b ~then_:then_.vesting_period - ~else_:else_.vesting_period - in - let%map vesting_increment = - Amount.Checked.if_ b ~then_:then_.vesting_increment - ~else_:else_.vesting_increment - in - As_record. - { is_timed - ; initial_minimum_balance - ; cliff_time - ; vesting_period - ; vesting_increment } - - [%%endif] + let to_input _ = assert false end [%%versioned @@ -360,7 +160,8 @@ module Stable = struct , Nonce.Stable.V1.t , Receipt.Chain_hash.Stable.V1.t , State_hash.Stable.V1.t - , Timing.Stable.V1.t ) + , Timing.Stable.V1.t + , Snapp_account.Stable.V1.t option ) Poly.Stable.V1.t [@@deriving sexp, eq, hash, compare, yojson] @@ -386,13 +187,14 @@ type value = , Nonce.t , Receipt.Chain_hash.t , State_hash.t - , Timing.t ) + , Timing.t + , Snapp_account.t option ) Poly.t [@@deriving sexp] let key_gen = Public_key.Compressed.gen -let initialize account_id : t = +let initialize ?snapp account_id : t = let public_key = Account_id.public_key account_id in let token_id = Account_id.token_id account_id in let delegate = @@ -408,7 +210,15 @@ let initialize account_id : t = ; receipt_chain_hash= Receipt.Chain_hash.empty ; delegate ; voting_for= State_hash.dummy - ; timing= Timing.Untimed } + ; timing= Timing.Untimed + ; snapp } + +let hash_snapp_account_opt = function + | None -> + Field.zero + | Some a -> + Random_oracle.hash ~init:Hash_prefix_states.snapp_account + (Random_oracle.pack_input (Snapp_account.to_input a)) let to_input (t : t) = let open Random_oracle.Input in @@ -422,6 +232,7 @@ let to_input (t : t) = ~receipt_chain_hash:(f Receipt.Chain_hash.to_input) ~delegate:(f Public_key.Compressed.to_input) ~voting_for:(f State_hash.to_input) ~timing:(bits Timing.to_bits) + ~snapp:(f (Fn.compose field hash_snapp_account_opt)) |> List.reduce_exn ~f:append let crypto_hash_prefix = Hash_prefix.account @@ -441,7 +252,8 @@ type var = , Nonce.Checked.t , Receipt.Chain_hash.var , State_hash.var - , Timing.var ) + , Timing.var + , Field.Var.t ) Poly.t let identifier_of_var ({public_key; token_id; _} : var) = @@ -458,7 +270,10 @@ let typ : (var, value) Typ.t = ; Receipt.Chain_hash.typ ; Public_key.Compressed.typ ; State_hash.typ - ; Timing.typ ] + ; Timing.typ + ; Typ.transport Field.typ ~there:hash_snapp_account_opt ~back:(fun fld -> + if Field.(equal zero) fld then None else failwith "unimplemented" + ) ] in Typ.of_hlistable spec ~var_to_hlist:Poly.to_hlist ~var_of_hlist:Poly.of_hlist ~value_to_hlist:Poly.to_hlist ~value_of_hlist:Poly.of_hlist @@ -472,7 +287,8 @@ let var_of_t ; receipt_chain_hash ; delegate ; voting_for - ; timing } : + ; timing + ; snapp } : value) = { Poly.public_key= Public_key.Compressed.var_of_t public_key ; token_id= Token_id.var_of_t token_id @@ -482,7 +298,8 @@ let var_of_t ; receipt_chain_hash= Receipt.Chain_hash.var_of_t receipt_chain_hash ; delegate= Public_key.Compressed.var_of_t delegate ; voting_for= State_hash.var_of_t voting_for - ; timing= Timing.var_of_t timing } + ; timing= Timing.var_of_t timing + ; snapp= Field.Var.constant (hash_snapp_account_opt snapp) } module Checked = struct let to_input (t : var) = @@ -495,7 +312,7 @@ module Checked = struct in make_checked (fun () -> List.reduce_exn ~f:append - (Poly.Fields.fold ~init:[] + (Poly.Fields.fold ~init:[] ~snapp:(f field) ~public_key:(f Public_key.Compressed.Checked.to_input) ~token_id: (* We use [run_checked] here to avoid routing the [Checked.t] @@ -530,7 +347,8 @@ let empty = ; receipt_chain_hash= Receipt.Chain_hash.empty ; delegate= Public_key.Compressed.empty ; voting_for= State_hash.dummy - ; timing= Timing.Untimed } + ; timing= Timing.Untimed + ; snapp= None } let empty_digest = digest empty @@ -550,7 +368,8 @@ let create account_id balance = ; receipt_chain_hash= Receipt.Chain_hash.empty ; delegate ; voting_for= State_hash.dummy - ; timing= Timing.Untimed } + ; timing= Timing.Untimed + ; snapp= None } let create_timed account_id balance ~initial_minimum_balance ~cliff_time ~vesting_period ~vesting_increment = @@ -578,6 +397,7 @@ let create_timed account_id balance ~initial_minimum_balance ~cliff_time ; receipt_chain_hash= Receipt.Chain_hash.empty ; delegate ; voting_for= State_hash.dummy + ; snapp= None ; timing= Timing.Timed { initial_minimum_balance diff --git a/src/lib/coda_base/account_timing.ml b/src/lib/coda_base/account_timing.ml new file mode 100644 index 00000000000..c682d4eeeb9 --- /dev/null +++ b/src/lib/coda_base/account_timing.ml @@ -0,0 +1,239 @@ +[%%import +"/src/config.mlh"] + +open Core_kernel + +[%%ifdef +consensus_mechanism] + +open Snark_params +open Tick + +[%%else] + +module Currency = Currency_nonconsensus.Currency +module Coda_numbers = Coda_numbers_nonconsensus.Coda_numbers +module Random_oracle = Random_oracle_nonconsensus.Random_oracle +module Coda_compile_config = + Coda_compile_config_nonconsensus.Coda_compile_config + +[%%endif] + +open Currency +open Coda_numbers + +module Poly = struct + [%%versioned + module Stable = struct + module V1 = struct + type ('slot, 'balance, 'amount) t = + | Untimed + | Timed of + { initial_minimum_balance: 'balance + ; cliff_time: 'slot + ; vesting_period: 'slot + ; vesting_increment: 'amount } + [@@deriving sexp, eq, hash, compare, yojson] + end + end] +end + +[%%versioned +module Stable = struct + module V1 = struct + type t = + ( Global_slot.Stable.V1.t + , Balance.Stable.V1.t + , Amount.Stable.V1.t ) + Poly.Stable.V1.t + [@@deriving sexp, eq, hash, compare, yojson] + + let to_latest = Fn.id + end +end] + +type ('slot, 'balance, 'amount) tt = ('slot, 'balance, 'amount) Poly.t = + | Untimed + | Timed of + { initial_minimum_balance: 'balance + ; cliff_time: 'slot + ; vesting_period: 'slot + ; vesting_increment: 'amount } +[@@deriving sexp, eq, hash, compare, yojson] + +module As_record = struct + type ('bool, 'slot, 'balance, 'amount) t = + { is_timed: 'bool + ; initial_minimum_balance: 'balance + ; cliff_time: 'slot + ; vesting_period: 'slot + ; vesting_increment: 'amount } + [@@deriving hlist] +end + +(* convert sum type to record format, useful for to_bits and typ *) +let to_record t = + match t with + | Untimed -> + let slot_unused = Global_slot.zero in + let slot_one = Global_slot.(succ zero) in + let balance_unused = Balance.zero in + let amount_unused = Amount.zero in + As_record. + { is_timed= false + ; initial_minimum_balance= balance_unused + ; cliff_time= slot_unused + ; vesting_period= slot_one (* avoid division by zero *) + ; vesting_increment= amount_unused } + | Timed + {initial_minimum_balance; cliff_time; vesting_period; vesting_increment} + -> + As_record. + { is_timed= true + ; initial_minimum_balance + ; cliff_time + ; vesting_period + ; vesting_increment } + +let to_bits t = + let As_record. + { is_timed + ; initial_minimum_balance + ; cliff_time + ; vesting_period + ; vesting_increment } = + to_record t + in + is_timed + :: ( Balance.to_bits initial_minimum_balance + @ Global_slot.to_bits cliff_time + @ Global_slot.to_bits vesting_period + @ Amount.to_bits vesting_increment ) + +[%%ifdef +consensus_mechanism] + +type var = + (Boolean.var, Global_slot.Checked.var, Balance.var, Amount.var) As_record.t + +let var_to_bits + As_record. + { is_timed + ; initial_minimum_balance + ; cliff_time + ; vesting_period + ; vesting_increment } = + let open Bitstring_lib.Bitstring.Lsb_first in + let initial_minimum_balance = + to_list @@ Balance.var_to_bits initial_minimum_balance + in + let cliff_time = to_list @@ Global_slot.var_to_bits cliff_time in + let vesting_period = to_list @@ Global_slot.var_to_bits vesting_period in + let vesting_increment = to_list @@ Amount.var_to_bits vesting_increment in + of_list + ( is_timed + :: ( initial_minimum_balance @ cliff_time @ vesting_period + @ vesting_increment ) ) + +let var_of_t (t : t) : var = + let As_record. + { is_timed + ; initial_minimum_balance + ; cliff_time + ; vesting_period + ; vesting_increment } = + to_record t + in + As_record. + { is_timed= Boolean.var_of_value is_timed + ; initial_minimum_balance= Balance.var_of_t initial_minimum_balance + ; cliff_time= Global_slot.Checked.constant cliff_time + ; vesting_period= Global_slot.Checked.constant vesting_period + ; vesting_increment= Amount.var_of_t vesting_increment } + +let untimed_var = var_of_t Untimed + +let typ : (var, t) Typ.t = + let spec = + let open Data_spec in + [Boolean.typ; Balance.typ; Global_slot.typ; Global_slot.typ; Amount.typ] + in + (* because we represent the types t (a sum type) and var (a record) differently, + we can't use the trick, used elsewhere, of polymorphic to_hlist and of_hlist + functions to handle both types + *) + let value_of_hlist : + ( unit + , Boolean.value + -> Balance.t + -> Global_slot.t + -> Global_slot.t + -> Amount.t + -> unit ) + H_list.t + -> t = + let open H_list in + fun [ is_timed + ; initial_minimum_balance + ; cliff_time + ; vesting_period + ; vesting_increment ] -> + if is_timed then + Timed + { initial_minimum_balance + ; cliff_time + ; vesting_period + ; vesting_increment } + else Untimed + in + let value_to_hlist (t : t) = + let As_record. + { is_timed + ; initial_minimum_balance + ; cliff_time + ; vesting_period + ; vesting_increment } = + to_record t + in + H_list. + [ is_timed + ; initial_minimum_balance + ; cliff_time + ; vesting_period + ; vesting_increment ] + in + let var_of_hlist = As_record.of_hlist in + let var_to_hlist = As_record.to_hlist in + Typ.of_hlistable spec ~var_to_hlist ~var_of_hlist ~value_to_hlist + ~value_of_hlist + +(* we can't use the generic if_ with the above typ, because Global_slot.typ doesn't work correctly with it + so we define a custom if_ +*) +let if_ b ~(then_ : var) ~(else_ : var) = + let%bind is_timed = + Boolean.if_ b ~then_:then_.is_timed ~else_:else_.is_timed + in + let%bind initial_minimum_balance = + Balance.Checked.if_ b ~then_:then_.initial_minimum_balance + ~else_:else_.initial_minimum_balance + in + let%bind cliff_time = + Global_slot.Checked.if_ b ~then_:then_.cliff_time ~else_:else_.cliff_time + in + let%bind vesting_period = + Global_slot.Checked.if_ b ~then_:then_.vesting_period + ~else_:else_.vesting_period + in + let%map vesting_increment = + Amount.Checked.if_ b ~then_:then_.vesting_increment + ~else_:else_.vesting_increment + in + As_record. + { is_timed + ; initial_minimum_balance + ; cliff_time + ; vesting_period + ; vesting_increment } + +[%%endif] diff --git a/src/lib/coda_base/epoch_ledger.ml b/src/lib/coda_base/epoch_ledger.ml new file mode 100644 index 00000000000..2070b575134 --- /dev/null +++ b/src/lib/coda_base/epoch_ledger.ml @@ -0,0 +1,59 @@ +open Core_kernel +open Currency +open Snark_params.Tick +open Bitstring_lib + +module Poly = struct + [%%versioned + module Stable = struct + module V1 = struct + type ('ledger_hash, 'amount) t = + {hash: 'ledger_hash; total_currency: 'amount} + [@@deriving sexp, eq, compare, hash, yojson, hlist] + end + end] +end + +module Value = struct + [%%versioned + module Stable = struct + module V1 = struct + type t = + (Frozen_ledger_hash0.Stable.V1.t, Amount.Stable.V1.t) Poly.Stable.V1.t + [@@deriving sexp, eq, compare, hash, to_yojson] + + let to_latest = Fn.id + end + end] +end + +let to_input ({hash; total_currency} : Value.t) = + let open Snark_params.Tick in + { Random_oracle.Input.field_elements= [|(hash :> Field.t)|] + ; bitstrings= [|Amount.to_bits total_currency|] } + +type var = (Frozen_ledger_hash0.var, Amount.var) Poly.t + +let data_spec = Data_spec.[Frozen_ledger_hash0.typ; Amount.typ] + +let typ : (var, Value.t) Typ.t = + Typ.of_hlistable data_spec ~var_to_hlist:Poly.to_hlist + ~var_of_hlist:Poly.of_hlist ~value_to_hlist:Poly.to_hlist + ~value_of_hlist:Poly.of_hlist + +let var_to_input ({Poly.hash; total_currency} : var) = + { Random_oracle.Input.field_elements= + [|Frozen_ledger_hash0.var_to_hash_packed hash|] + ; bitstrings= + [|Bitstring.Lsb_first.to_list (Amount.var_to_bits total_currency)|] } + +let if_ cond ~(then_ : (Frozen_ledger_hash0.var, Amount.var) Poly.t) + ~(else_ : (Frozen_ledger_hash0.var, Amount.var) Poly.t) = + let open Checked.Let_syntax in + let%map hash = + Frozen_ledger_hash0.if_ cond ~then_:then_.hash ~else_:else_.hash + and total_currency = + Amount.Checked.if_ cond ~then_:then_.total_currency + ~else_:else_.total_currency + in + {Poly.hash; total_currency} diff --git a/src/lib/coda_base/frozen_ledger_hash.mli b/src/lib/coda_base/frozen_ledger_hash.mli index f35bd3b6b14..d446a904270 100644 --- a/src/lib/coda_base/frozen_ledger_hash.mli +++ b/src/lib/coda_base/frozen_ledger_hash.mli @@ -1,4 +1,4 @@ -include Ledger_hash_intf.S +include Ledger_hash_intf.S with type var = Frozen_ledger_hash0.var val of_ledger_hash : Ledger_hash.t -> t diff --git a/src/lib/coda_base/frozen_ledger_hash0.ml b/src/lib/coda_base/frozen_ledger_hash0.ml new file mode 100644 index 00000000000..b2e5975f82f --- /dev/null +++ b/src/lib/coda_base/frozen_ledger_hash0.ml @@ -0,0 +1 @@ +include Ledger_hash0 diff --git a/src/lib/coda_base/import.ml b/src/lib/coda_base/import.ml index 1657cce7eb8..9cda10bd412 100644 --- a/src/lib/coda_base/import.ml +++ b/src/lib/coda_base/import.ml @@ -14,6 +14,7 @@ module Currency = Currency_nonconsensus.Currency module Random_oracle = Random_oracle_nonconsensus.Random_oracle module Coda_numbers = Coda_numbers_nonconsensus module Unsigned_extended = Unsigned_extended_nonconsensus.Unsigned_extended +module Hash_prefix_states = Hash_prefix_states_nonconsensus.Hash_prefix_states [%%endif] diff --git a/src/lib/coda_base/ledger_hash.ml b/src/lib/coda_base/ledger_hash.ml index eabf5c50b7d..bb5bcf46637 100644 --- a/src/lib/coda_base/ledger_hash.ml +++ b/src/lib/coda_base/ledger_hash.ml @@ -31,34 +31,7 @@ module Merkle_tree = let hash = Checked.digest end) -include Data_hash.Make_full_size (struct - let description = "Ledger hash" - - let version_byte = Base58_check.Version_bytes.ledger_hash -end) - -(* Data hash versioned boilerplate below *) - -[%%versioned -module Stable = struct - module V1 = struct - module T = struct - type t = Field.t [@@deriving sexp, compare, hash, version {asserted}] - end - - include T - - let to_latest = Core.Fn.id - - [%%define_from_scope - to_yojson, of_yojson] - - include Comparable.Make (T) - include Hashable.Make_binable (T) - end -end] - -type _unused = unit constraint t = Stable.Latest.t +include Ledger_hash0 (* End boilerplate *) let merge ~height (h1 : t) (h2 : t) = diff --git a/src/lib/coda_base/ledger_hash.mli b/src/lib/coda_base/ledger_hash.mli index a97b48cd33f..33dcaeaeef9 100644 --- a/src/lib/coda_base/ledger_hash.mli +++ b/src/lib/coda_base/ledger_hash.mli @@ -1 +1 @@ -include Ledger_hash_intf.S +include Ledger_hash_intf.S with type var = Ledger_hash0.var diff --git a/src/lib/coda_base/ledger_hash0.ml b/src/lib/coda_base/ledger_hash0.ml new file mode 100644 index 00000000000..12b2fe54200 --- /dev/null +++ b/src/lib/coda_base/ledger_hash0.ml @@ -0,0 +1,31 @@ +open Core_kernel +open Snark_params.Tick + +include Data_hash.Make_full_size (struct + let description = "Ledger hash" + + let version_byte = Base58_check.Version_bytes.ledger_hash +end) + +(* Data hash versioned boilerplate below *) + +[%%versioned +module Stable = struct + module V1 = struct + module T = struct + type t = Field.t [@@deriving sexp, compare, hash, version {asserted}] + end + + include T + + let to_latest = Core.Fn.id + + [%%define_from_scope + to_yojson, of_yojson] + + include Comparable.Make (T) + include Hashable.Make_binable (T) + end +end] + +type _unused = unit constraint t = Stable.Latest.t diff --git a/src/lib/coda_base/ledger_hash0.mli b/src/lib/coda_base/ledger_hash0.mli new file mode 100644 index 00000000000..6b94bba412b --- /dev/null +++ b/src/lib/coda_base/ledger_hash0.mli @@ -0,0 +1,7 @@ +(* This module exists to break the dependency cycle + + Snapp_account + -> Ledger_hash + -> Account + -> Snapp_account *) +include Ledger_hash_intf0.S diff --git a/src/lib/coda_base/ledger_hash_intf.ml b/src/lib/coda_base/ledger_hash_intf.ml index bb4e9813c83..e2f17676e72 100644 --- a/src/lib/coda_base/ledger_hash_intf.ml +++ b/src/lib/coda_base/ledger_hash_intf.ml @@ -1,25 +1,9 @@ -open Core open Snark_params open Snarky_backendless open Tick module type S = sig - include Data_hash.Full_size - - [%%versioned: - module Stable : sig - [@@@no_toplevel_latest_type] - - module V1 : sig - type t = Field.t [@@deriving sexp, compare, hash, yojson] - - val to_latest : t -> t - - include Comparable.S with type t := t - - include Hashable_binable with type t := t - end - end] + include Ledger_hash_intf0.S type path = Random_oracle.Digest.t list diff --git a/src/lib/coda_base/ledger_hash_intf0.ml b/src/lib/coda_base/ledger_hash_intf0.ml new file mode 100644 index 00000000000..dca98bc28cb --- /dev/null +++ b/src/lib/coda_base/ledger_hash_intf0.ml @@ -0,0 +1,21 @@ +open Core_kernel +open Snark_params.Tick + +module type S = sig + include Data_hash.Full_size + + [%%versioned: + module Stable : sig + [@@@no_toplevel_latest_type] + + module V1 : sig + type t = Field.t [@@deriving sexp, compare, hash, yojson] + + val to_latest : t -> t + + include Comparable.S with type t := t + + include Hashable_binable with type t := t + end + end] +end diff --git a/src/lib/coda_base/proof.ml b/src/lib/coda_base/proof.ml index d239d4fc3f4..9ff79893241 100644 --- a/src/lib/coda_base/proof.ml +++ b/src/lib/coda_base/proof.ml @@ -33,7 +33,7 @@ let%test_module "proof-tests" = let%test "proof serialization v1" = let proof = blockchain_dummy in - let known_good_digest = "a02b4f4ad38bc5c0a51da3a39c3673b4" in + let known_good_digest = "8f5c48f27fa3f84e6cadc04add6861b4" in Ppx_version_runtime.Serialization.check_serialization (module Stable.V1) proof known_good_digest diff --git a/src/lib/coda_base/receipt.ml b/src/lib/coda_base/receipt.ml index 536bc1743fe..d5d3f871583 100644 --- a/src/lib/coda_base/receipt.ml +++ b/src/lib/coda_base/receipt.ml @@ -58,7 +58,7 @@ module Chain_hash = struct : (Field.t, bool) Input.t ) (field (t :> Field.t))) |> pack_input - |> hash ~init:Hash_prefix.receipt_chain + |> hash ~init:Hash_prefix.receipt_chain_user_command |> of_hash [%%if @@ -77,7 +77,7 @@ module Chain_hash = struct let open Checked in let%bind payload = Transaction_union_payload.Checked.to_input payload in make_checked (fun () -> - hash ~init:Hash_prefix.receipt_chain + hash ~init:Hash_prefix.receipt_chain_user_command (pack_input Input.(append payload (var_to_input t))) |> var_of_hash_packed ) end diff --git a/src/lib/staged_ledger_hash/staged_ledger_hash.ml b/src/lib/coda_base/staged_ledger_hash.ml similarity index 99% rename from src/lib/staged_ledger_hash/staged_ledger_hash.ml rename to src/lib/coda_base/staged_ledger_hash.ml index 40f13a1c9f4..0dfa31a2fb4 100644 --- a/src/lib/staged_ledger_hash/staged_ledger_hash.ml +++ b/src/lib/coda_base/staged_ledger_hash.ml @@ -2,7 +2,6 @@ "../../config.mlh"] open Core -open Coda_base open Fold_lib open Snark_params.Tick @@ -110,7 +109,7 @@ module Non_snark = struct let dummy : t Lazy.t = lazy - { ledger_hash= Coda_base.Ledger_hash.empty_hash + { ledger_hash= Ledger_hash.empty_hash ; aux_hash= Aux_hash.dummy ; pending_coinbase_aux= Pending_coinbase_aux.dummy } diff --git a/src/lib/staged_ledger_hash/staged_ledger_hash.mli b/src/lib/coda_base/staged_ledger_hash.mli similarity index 98% rename from src/lib/staged_ledger_hash/staged_ledger_hash.mli rename to src/lib/coda_base/staged_ledger_hash.mli index 3c5d259d341..7f163631a99 100644 --- a/src/lib/staged_ledger_hash/staged_ledger_hash.mli +++ b/src/lib/coda_base/staged_ledger_hash.mli @@ -1,5 +1,4 @@ open Core -open Coda_base open Snark_params.Tick type t [@@deriving sexp, eq, compare, hash, yojson] diff --git a/src/lib/coda_graphql/coda_graphql.ml b/src/lib/coda_graphql/coda_graphql.ml index bfbb2691609..1ef85f36828 100644 --- a/src/lib/coda_graphql/coda_graphql.ml +++ b/src/lib/coda_graphql/coda_graphql.ml @@ -507,7 +507,8 @@ module Types = struct ; receipt_chain_hash ; delegate ; voting_for - ; timing } = + ; timing + ; snapp } = let open Option.Let_syntax in let%bind public_key = public_key in let%bind token_permissions = token_permissions in @@ -515,7 +516,8 @@ module Types = struct let%bind receipt_chain_hash = receipt_chain_hash in let%bind delegate = delegate in let%bind voting_for = voting_for in - let%map timing = timing in + let%bind timing = timing in + let%map snapp = snapp in { Account.Poly.public_key ; token_id ; token_permissions @@ -524,7 +526,8 @@ module Types = struct ; receipt_chain_hash ; delegate ; voting_for - ; timing } + ; timing + ; snapp } let of_full_account ?breadcrumb { Account.Poly.public_key @@ -535,7 +538,8 @@ module Types = struct ; receipt_chain_hash ; delegate ; voting_for - ; timing } = + ; timing + ; snapp } = { Account.Poly.public_key= Some public_key ; token_id ; token_permissions= Some token_permissions @@ -545,7 +549,8 @@ module Types = struct ; receipt_chain_hash= Some receipt_chain_hash ; delegate= Some delegate ; voting_for= Some voting_for - ; timing } + ; timing + ; snapp } let of_account_id coda account_id = let account = @@ -575,7 +580,8 @@ module Types = struct ; breadcrumb= None } ; receipt_chain_hash= None ; voting_for= None - ; timing= Timing.Untimed } + ; timing= Timing.Untimed + ; snapp= None } let of_pk coda pk = of_account_id coda (Account_id.create pk Token_id.default) @@ -595,7 +601,8 @@ module Types = struct , Account.Nonce.t option , Receipt.Chain_hash.t option , State_hash.t option - , Account.Timing.t ) + , Account.Timing.t + , Account.Snapp_account.t option ) Account.Poly.t ; locked: bool option ; is_actively_staking: bool diff --git a/src/lib/consensus/dune b/src/lib/consensus/dune index bbeea33841a..11848fab82c 100644 --- a/src/lib/consensus/dune +++ b/src/lib/consensus/dune @@ -21,7 +21,6 @@ global_signer_private_key non_zero_curve_point yojson - staged_ledger_hash coda_metrics graphql_lib) (preprocessor_deps "../../config.mlh") diff --git a/src/lib/consensus/proof_of_stake.ml b/src/lib/consensus/proof_of_stake.ml index 2c2ddadf60f..88b3cc69143 100644 --- a/src/lib/consensus/proof_of_stake.ml +++ b/src/lib/consensus/proof_of_stake.ml @@ -360,31 +360,11 @@ module Data = struct end module Epoch_ledger = struct - module Poly = struct - [%%versioned - module Stable = struct - module V1 = struct - type ('ledger_hash, 'amount) t = - {hash: 'ledger_hash; total_currency: 'amount} - [@@deriving sexp, eq, compare, hash, to_yojson, hlist] - end - end] - end - - module Value = struct - [%%versioned - module Stable = struct - module V1 = struct - type t = - ( Coda_base.Frozen_ledger_hash.Stable.V1.t - , Amount.Stable.V1.t ) - Poly.Stable.V1.t - [@@deriving sexp, eq, compare, hash, to_yojson] + include Coda_base.Epoch_ledger - let to_latest = Fn.id - end - end] - end + let genesis ~ledger = + { Poly.hash= genesis_ledger_hash ~ledger + ; total_currency= genesis_ledger_total_currency ~ledger } let graphql_type () : ('ctx, Value.t option) Graphql_async.Schema.typ = let open Graphql_async in @@ -399,45 +379,6 @@ module Data = struct ~args:Arg.[] ~resolve:(fun _ {Poly.total_currency; _} -> Amount.to_uint64 total_currency ) ] ) - - let to_input ({hash; total_currency} : Value.t) = - let open Snark_params.Tick in - { Random_oracle.Input.field_elements= [|(hash :> Field.t)|] - ; bitstrings= [|Amount.to_bits total_currency|] } - - type var = (Coda_base.Frozen_ledger_hash.var, Amount.var) Poly.t - - let data_spec = - Tick.Data_spec.[Coda_base.Frozen_ledger_hash.typ; Amount.typ] - - let typ : (var, Value.t) Typ.t = - Tick.Typ.of_hlistable data_spec ~var_to_hlist:Poly.to_hlist - ~var_of_hlist:Poly.of_hlist ~value_to_hlist:Poly.to_hlist - ~value_of_hlist:Poly.of_hlist - - let var_to_input ({Poly.hash; total_currency} : var) = - { Random_oracle.Input.field_elements= - [|Coda_base.Frozen_ledger_hash.var_to_hash_packed hash|] - ; bitstrings= - [|Bitstring.Lsb_first.to_list (Amount.var_to_bits total_currency)|] - } - - let if_ cond - ~(then_ : (Coda_base.Frozen_ledger_hash.var, Amount.var) Poly.t) - ~(else_ : (Coda_base.Frozen_ledger_hash.var, Amount.var) Poly.t) = - let open Tick.Checked.Let_syntax in - let%map hash = - Coda_base.Frozen_ledger_hash.if_ cond ~then_:then_.hash - ~else_:else_.hash - and total_currency = - Amount.Checked.if_ cond ~then_:then_.total_currency - ~else_:else_.total_currency - in - {Poly.hash; total_currency} - - let genesis ~ledger = - { Poly.hash= genesis_ledger_hash ~ledger - ; total_currency= genesis_ledger_total_currency ~ledger } end module Vrf = struct diff --git a/src/lib/hash_prefix_states/hash_prefix_states.ml b/src/lib/hash_prefix_states/hash_prefix_states.ml index 8d24467afee..616b7067208 100644 --- a/src/lib/hash_prefix_states/hash_prefix_states.ml +++ b/src/lib/hash_prefix_states/hash_prefix_states.ml @@ -17,7 +17,9 @@ open Hash_prefixes let salt (s : Hash_prefixes.t) = Random_oracle.salt (s :> string) -let receipt_chain = salt receipt_chain +let receipt_chain_user_command = salt receipt_chain_user_command + +let receipt_chain_snapp = salt receipt_chain_snapp let coinbase = salt coinbase @@ -73,3 +75,13 @@ let epoch_seed = salt epoch_seed let transition_system_snark = salt transition_system_snark let account = salt account + +let side_loaded_vk = salt side_loaded_vk + +let snapp_account = salt snapp_account + +let snapp_payload = salt snapp_payload + +let snapp_predicate_account = salt snapp_predicate_account + +let snapp_predicate_protocol_state = salt snapp_predicate_protocol_state diff --git a/src/lib/hash_prefix_states/hash_prefix_states.mli b/src/lib/hash_prefix_states/hash_prefix_states.mli index cbf4efe6eef..dee5326ad0e 100644 --- a/src/lib/hash_prefix_states/hash_prefix_states.mli +++ b/src/lib/hash_prefix_states/hash_prefix_states.mli @@ -39,7 +39,19 @@ val transition_system_snark : Field.t State.t val account : Field.t State.t -val receipt_chain : Field.t State.t +val side_loaded_vk : Field.t State.t + +val snapp_account : Field.t State.t + +val snapp_payload : Field.t State.t + +val snapp_predicate_account : Field.t State.t + +val snapp_predicate_protocol_state : Field.t State.t + +val receipt_chain_user_command : Field.t State.t + +val receipt_chain_snapp : Field.t State.t val pending_coinbases : Field.t State.t diff --git a/src/lib/hash_prefixes/hash_prefixes.ml b/src/lib/hash_prefixes/hash_prefixes.ml index eece5b61391..ed27693f7c9 100644 --- a/src/lib/hash_prefixes/hash_prefixes.ml +++ b/src/lib/hash_prefixes/hash_prefixes.ml @@ -26,6 +26,12 @@ let protocol_state_body = create "CodaProtoStateBody" let account = create "CodaAccount" +let side_loaded_vk = create "CodaSideLoadedVk" + +let snapp_account = create "CodaSnappAccount" + +let snapp_payload = create "CodaSnappPayload" + let merkle_tree i = create (Printf.sprintf "CodaMklTree%03d" i) let coinbase_merkle_tree i = create (Printf.sprintf "CodaCbMklTree%03d" i) @@ -38,7 +44,9 @@ let transition_system_snark = create "CodaTransitionSnark" let signature = create "CodaSignature" -let receipt_chain = create "CodaReceiptChain" +let receipt_chain_user_command = create "CodaReceiptUC" + +let receipt_chain_snapp = create "CodaReceiptSnapp" let epoch_seed = create "CodaEpochSeed" @@ -60,3 +68,7 @@ let coinbase = create "Coinbase" let checkpoint_list = create "CodaCheckpoints" let bowe_gabizon_hash = create "CodaTockBGHash" + +let snapp_predicate_account = create "CodaSnappPredAcct" + +let snapp_predicate_protocol_state = create "CodaSnappPredPS" diff --git a/src/lib/network_pool/transaction_pool.ml b/src/lib/network_pool/transaction_pool.ml index 2cf08af1765..e4ec31c7583 100644 --- a/src/lib/network_pool/transaction_pool.ml +++ b/src/lib/network_pool/transaction_pool.ml @@ -1242,7 +1242,8 @@ let%test_module _ = ; voting_for= Quickcheck.random_value ~seed:(`Deterministic "constant") State_hash.gen - ; timing= Account.Timing.Untimed } ) + ; timing= Account.Timing.Untimed + ; snapp= None } ) let%test_unit "Transactions are removed and added back in fork changes" = Thread_safe.block_on_async_exn (fun () -> diff --git a/src/lib/pickles/composition_types/bulletproof_challenge.ml b/src/lib/pickles/composition_types/bulletproof_challenge.ml index 4c28cbdbae4..c05ce88734d 100644 --- a/src/lib/pickles/composition_types/bulletproof_challenge.ml +++ b/src/lib/pickles/composition_types/bulletproof_challenge.ml @@ -1,5 +1,5 @@ type ('challenge, 'bool) t = {prechallenge: 'challenge; is_square: 'bool} -[@@deriving bin_io, sexp, compare, yojson] +[@@deriving bin_io, sexp, compare, yojson, hash, eq] let pack {prechallenge; is_square} = is_square :: prechallenge diff --git a/src/lib/pickles/composition_types/composition_types.ml b/src/lib/pickles/composition_types/composition_types.ml index 92be384d295..e6a05efa9ca 100644 --- a/src/lib/pickles/composition_types/composition_types.ml +++ b/src/lib/pickles/composition_types/composition_types.ml @@ -26,7 +26,7 @@ module Dlog_based = struct ; beta_1: 'scalar_challenge ; beta_2: 'scalar_challenge ; beta_3: 'scalar_challenge } - [@@deriving bin_io, sexp, compare, yojson, hlist] + [@@deriving bin_io, sexp, compare, yojson, hlist, hash, eq] let map_challenges { sigma_2 @@ -78,7 +78,7 @@ module Dlog_based = struct ; xi: 'scalar_challenge ; bulletproof_challenges: 'bulletproof_challenges ; which_branch: 'index } - [@@deriving bin_io, sexp, compare, yojson, hlist] + [@@deriving bin_io, sexp, compare, yojson, hlist, hash, eq] let map_challenges { marlin @@ -111,7 +111,7 @@ module Dlog_based = struct module Me_only = struct type ('g1, 'bulletproof_challenges) t = {sg: 'g1; old_bulletproof_challenges: 'bulletproof_challenges} - [@@deriving bin_io, sexp, compare, yojson, hlist] + [@@deriving bin_io, sexp, compare, yojson, hlist, hash, eq] let to_field_elements {sg; old_bulletproof_challenges} ~g1:g1_to_field_elements = @@ -149,7 +149,7 @@ module Dlog_based = struct ; sponge_digest_before_evaluations: 'digest (* Not needed by other proof system *) ; me_only: 'me_only } - [@@deriving bin_io, sexp, compare, yojson, hlist] + [@@deriving bin_io, sexp, compare, yojson, hlist, hash, eq] let typ chal fp bool fq me_only digest index = Snarky_backendless.Typ.of_hlistable @@ -230,7 +230,7 @@ module Dlog_based = struct , 'index ) Proof_state.t ; pass_through: 'pass_through } - [@@deriving bin_io, compare, yojson, sexp] + [@@deriving bin_io, compare, yojson, sexp, hash, eq] let spec = let open Spec in diff --git a/src/lib/pickles/composition_types/index.ml b/src/lib/pickles/composition_types/index.ml index 365e4c0e42d..8a0973db3ef 100644 --- a/src/lib/pickles/composition_types/index.ml +++ b/src/lib/pickles/composition_types/index.ml @@ -1,7 +1,7 @@ open Core_kernel open Pickles_types -type t = char [@@deriving sexp, bin_io, sexp, compare, yojson] +type t = char [@@deriving sexp, bin_io, sexp, compare, yojson, hash, eq] let of_int = Char.of_int diff --git a/src/lib/pickles/composition_types/index.mli b/src/lib/pickles/composition_types/index.mli index 437521cc206..d2059bc4737 100644 --- a/src/lib/pickles/composition_types/index.mli +++ b/src/lib/pickles/composition_types/index.mli @@ -1,6 +1,6 @@ open Pickles_types -type t [@@deriving sexp, bin_io, sexp, compare, yojson] +type t [@@deriving sexp, bin_io, sexp, compare, yojson, hash, eq] val of_int : int -> t option diff --git a/src/lib/pickles/limb_vector/constant.ml b/src/lib/pickles/limb_vector/constant.ml index 66cfbd019eb..400d5dc780f 100644 --- a/src/lib/pickles/limb_vector/constant.ml +++ b/src/lib/pickles/limb_vector/constant.ml @@ -40,7 +40,7 @@ module Make (N : Vector.Nat_intf) = struct let t_of_sexp = Fn.compose of_hex String.t_of_sexp end - type t = Hex64.t A.t [@@deriving bin_io, sexp, compare, yojson] + type t = Hex64.t A.t [@@deriving bin_io, sexp, compare, yojson, hash, eq] let to_bits = to_bits diff --git a/src/lib/pickles/pickles.ml b/src/lib/pickles/pickles.ml index cd55876cffd..59660eed27e 100644 --- a/src/lib/pickles/pickles.ml +++ b/src/lib/pickles/pickles.ml @@ -670,6 +670,8 @@ module Side_loaded = struct (Vector.map2 d.branchings d.step_domains ~f:(fun width ds -> ({Domains.h= ds.h; k= ds.k}, Width.of_int_exn width) )) (Nat.lte_exn (Vector.length d.step_domains) Max_branches.n) } + + module Max_width = Width.Max end let in_circuit tag vk = Types_map.set_ephemeral tag {index= `In_circuit vk} @@ -684,6 +686,21 @@ module Side_loaded = struct ; var_to_field_elements ; typ ; branches= Verification_key.Max_branches.n } + + module Proof = struct + module T = + Proof.Make (Verification_key.Width.Max) (Verification_key.Width.Max) + + [%%versioned + module Stable = struct + module V1 = struct + type t = T.t + [@@deriving version {asserted}, sexp, eq, yojson, hash, compare] + + let to_latest = Fn.id + end + end] + end end let compile diff --git a/src/lib/pickles/pickles.mli b/src/lib/pickles/pickles.mli index 364b9590140..8717698392e 100644 --- a/src/lib/pickles/pickles.mli +++ b/src/lib/pickles/pickles.mli @@ -121,6 +121,19 @@ module Side_loaded : sig val typ : (Checked.t, t) Impls.Step.Typ.t module Max_branches : Nat.Add.Intf + + module Max_width : Nat.Intf + end + + module Proof : sig + [%%versioned: + module Stable : sig + module V1 : sig + type t = + (Verification_key.Max_width.n, Verification_key.Max_width.n) Proof.t + [@@deriving sexp, eq, yojson, hash, compare] + end + end] end val create : diff --git a/src/lib/pickles/proof.ml b/src/lib/pickles/proof.ml index 54a2b308e85..fe2a66d4032 100644 --- a/src/lib/pickles/proof.ml +++ b/src/lib/pickles/proof.ml @@ -26,7 +26,8 @@ module Base = struct ; proof: Tick.Proof.t } end - type 'a triple = 'a * 'a * 'a [@@deriving bin_io, compare, sexp, yojson] + type 'a triple = 'a * 'a * 'a + [@@deriving bin_io, compare, sexp, yojson, hash, eq] module Dlog_based = struct type ('dlog_me_only, 'pairing_me_only) t = @@ -46,10 +47,12 @@ module Base = struct , Index.t ) Types.Dlog_based.Statement.t ; prev_evals: - Tick.Field.t array Dlog_marlin_types.Evals.Stable.Latest.t triple + Tick.Field.t Dlog_marlin_types.Pc_array.Stable.Latest.t + Dlog_marlin_types.Evals.Stable.Latest.t + triple ; prev_x_hat: Tick.Field.t triple ; proof: Tock.Proof.t } - [@@deriving bin_io, compare, sexp, yojson] + [@@deriving bin_io, compare, sexp, yojson, hash, eq] end end @@ -166,7 +169,7 @@ module Make (W : Nat.Intf) (MLMB : Nat.Intf) = struct Max_branching_at_most.t ) Base.Me_only.Pairing_based.t ) Base.Dlog_based.t - [@@deriving bin_io, compare, sexp, yojson] + [@@deriving bin_io, compare, sexp, yojson, hash, eq] end type nonrec t = (W.n, MLMB.n) t @@ -202,6 +205,12 @@ module Make (W : Nat.Intf) (MLMB : Nat.Intf) = struct let compare t1 t2 = Repr.compare (to_repr t1) (to_repr t2) + let equal t1 t2 = Repr.equal (to_repr t1) (to_repr t2) + + let hash_fold_t s t = Repr.hash_fold_t s (to_repr t) + + let hash t = Repr.hash (to_repr t) + include Binable.Of_binable (Repr) (struct diff --git a/src/lib/pickles/reduced_me_only.ml b/src/lib/pickles/reduced_me_only.ml index 32a5d0e3113..d5e5c0f8ca6 100644 --- a/src/lib/pickles/reduced_me_only.ml +++ b/src/lib/pickles/reduced_me_only.ml @@ -12,7 +12,7 @@ open Backend module Pairing_based = struct type ('s, 'sgs, 'bpcs) t = {app_state: 's; sg: 'sgs; old_bulletproof_challenges: 'bpcs} - [@@deriving sexp, bin_io, yojson, sexp, compare] + [@@deriving sexp, bin_io, yojson, sexp, compare, hash, eq] let prepare ~dlog_marlin_index {app_state; sg; old_bulletproof_challenges} = { Pairing_based.Proof_state.Me_only.app_state @@ -29,7 +29,7 @@ module Dlog_based = struct , bool ) Bulletproof_challenge.t Wrap_bp_vec.t - [@@deriving bin_io, sexp, compare, yojson] + [@@deriving bin_io, sexp, compare, yojson, hash, eq] module Prepared = struct type t = (Tock.Field.t, Tock.Rounds.n) Vector.t diff --git a/src/lib/pickles/side_loaded_verification_key.ml b/src/lib/pickles/side_loaded_verification_key.ml index acc6a8ad4a7..00aed0e8c6a 100644 --- a/src/lib/pickles/side_loaded_verification_key.ml +++ b/src/lib/pickles/side_loaded_verification_key.ml @@ -46,7 +46,7 @@ module Width : sig val typ : (Checked.t, t) Typ.t - module Max : Nat.Add.Intf + module Max : Nat.Add.Intf_transparent end = struct [%%versioned module Stable = struct diff --git a/src/lib/pickles_types/dlog_marlin_types.ml b/src/lib/pickles_types/dlog_marlin_types.ml index eb80169217e..b76ea56170c 100644 --- a/src/lib/pickles_types/dlog_marlin_types.ml +++ b/src/lib/pickles_types/dlog_marlin_types.ml @@ -1,5 +1,19 @@ open Core_kernel +module Pc_array = struct + [%%versioned + module Stable = struct + module V1 = struct + type 'a t = 'a array [@@deriving compare, sexp, yojson, eq] + + let hash_fold_t f s a = List.hash_fold_t f s (Array.to_list a) + end + end] + + [%%define_locally + Stable.Latest.(hash_fold_t)] +end + module Evals = struct [%%versioned module Stable = struct @@ -18,7 +32,7 @@ module Evals = struct ; g_1: 'a ; g_2: 'a ; g_3: 'a } - [@@deriving fields, sexp, compare, yojson] + [@@deriving fields, sexp, compare, yojson, hash, eq] end end] @@ -163,8 +177,12 @@ module Openings = struct module Stable = struct module V1 = struct type ('g, 'fq) t = - {lr: ('g * 'g) array; z_1: 'fq; z_2: 'fq; delta: 'g; sg: 'g} - [@@deriving sexp, compare, yojson, hlist] + { lr: ('g * 'g) Pc_array.Stable.V1.t + ; z_1: 'fq + ; z_2: 'fq + ; delta: 'g + ; sg: 'g } + [@@deriving sexp, compare, yojson, hash, eq, hlist] end end] @@ -185,7 +203,7 @@ module Openings = struct 'fqv Evals.Stable.V1.t * 'fqv Evals.Stable.V1.t * 'fqv Evals.Stable.V1.t } - [@@deriving sexp, compare, yojson, hlist] + [@@deriving sexp, compare, yojson, hash, eq, hlist] end end] @@ -205,8 +223,8 @@ module Poly_comm = struct [%%versioned module Stable = struct module V1 = struct - type 'g t = {unshifted: 'g array; shifted: 'g} - [@@deriving sexp, compare, yojson, hlist] + type 'g t = {unshifted: 'g Pc_array.Stable.V1.t; shifted: 'g} + [@@deriving sexp, compare, yojson, hlist, hash, eq] end end] @@ -220,7 +238,8 @@ module Poly_comm = struct [%%versioned module Stable = struct module V1 = struct - type 'g t = 'g array [@@deriving sexp, compare, yojson] + type 'g t = 'g Pc_array.Stable.V1.t + [@@deriving sexp, compare, yojson, hash, eq] end end] @@ -249,7 +268,7 @@ module Messages = struct 'fq * ( 'g With_degree_bound.Stable.V1.t * 'g Without_degree_bound.Stable.V1.t ) } - [@@deriving sexp, compare, yojson, fields, hlist] + [@@deriving sexp, compare, yojson, fields, hash, eq, hlist] end end] @@ -291,7 +310,7 @@ module Proof = struct type ('g, 'fq, 'fqv) t = { messages: ('g, 'fq) Messages.Stable.V1.t ; openings: ('g, 'fq, 'fqv) Openings.Stable.V1.t } - [@@deriving sexp, compare, yojson, hlist] + [@@deriving sexp, compare, yojson, hash, eq] end end] end diff --git a/src/lib/pickles_types/scalar_challenge.ml b/src/lib/pickles_types/scalar_challenge.ml index 870984e9708..3fdd95f576e 100644 --- a/src/lib/pickles_types/scalar_challenge.ml +++ b/src/lib/pickles_types/scalar_challenge.ml @@ -3,7 +3,8 @@ open Core_kernel [%%versioned module Stable = struct module V1 = struct - type 'f t = Scalar_challenge of 'f [@@deriving sexp, compare, eq, yojson] + type 'f t = Scalar_challenge of 'f + [@@deriving sexp, compare, eq, yojson, hash] end end] diff --git a/src/lib/pickles_types/vector.ml b/src/lib/pickles_types/vector.ml index e3a9a302f80..da88401aff8 100644 --- a/src/lib/pickles_types/vector.ml +++ b/src/lib/pickles_types/vector.ml @@ -1,3 +1,4 @@ +open Core_kernel module Nat = Nat module type Nat_intf = Nat.Intf @@ -65,7 +66,7 @@ let zip xs ys = map2 xs ys ~f:(fun x y -> (x, y)) let rec to_list : type a n. (a, n) t -> a list = fun t -> match t with [] -> [] | x :: xs -> x :: to_list xs -let sexp_of_t a _ v = Core_kernel.List.sexp_of_t a (to_list v) +let sexp_of_t a _ v = List.sexp_of_t a (to_list v) let to_array t = Array.of_list (to_list t) @@ -103,9 +104,7 @@ let mapi (type a b m) (t : (a, m) t) ~(f : int -> a -> b) = let unzip ts = (map ts ~f:fst, map ts ~f:snd) let unzip3 ts = - ( map ts ~f:Core_kernel.Tuple3.get1 - , map ts ~f:Core_kernel.Tuple3.get2 - , map ts ~f:Core_kernel.Tuple3.get3 ) + (map ts ~f:Tuple3.get1, map ts ~f:Tuple3.get2, map ts ~f:Tuple3.get3) type _ e = T : ('a, 'n) t -> 'a e @@ -116,6 +115,11 @@ let rec of_list : type a. a list -> a e = function let (T xs) = of_list xs in T (x :: xs) +let to_sequence : type a n. (a, n) t -> a Sequence.t = + fun t -> + Sequence.unfold ~init:(T t) ~f:(fun (T t) -> + match t with [] -> None | x :: xs -> Some (x, T xs) ) + let rec of_list_and_length_exn : type a n. a list -> n nat -> (a, n) t = fun xs n -> match (xs, n) with @@ -127,13 +131,13 @@ let rec of_list_and_length_exn : type a n. a list -> n nat -> (a, n) t = failwith "Vector: Length mismatch" let of_list_and_length xs n = - Core_kernel.Option.try_with (fun () -> of_list_and_length_exn xs n) + Option.try_with (fun () -> of_list_and_length_exn xs n) let of_array_and_length_exn : type a n. a array -> n nat -> (a, n) t = fun xs n -> if Array.length xs <> Nat.to_int n then - Core_kernel.failwithf "of_array_and_length_exn: got %d (expected %d)" - (Array.length xs) (Nat.to_int n) () ; + failwithf "of_array_and_length_exn: got %d (expected %d)" (Array.length xs) + (Nat.to_int n) () ; init n ~f:(Array.get xs) let reverse t = @@ -172,8 +176,6 @@ let reduce_exn (type n) (t : (_, n) t) ~f = | init :: xs -> fold xs ~f ~init -open Core_kernel - module Cata (F : sig type _ t diff --git a/src/lib/random_oracle/dune b/src/lib/random_oracle/dune index 6fa2d5798b3..f37377317d0 100644 --- a/src/lib/random_oracle/dune +++ b/src/lib/random_oracle/dune @@ -5,9 +5,9 @@ (preprocess (pps ppx_version ppx_optcomp ppx_sexp_conv ppx_compare ppx_inline_test ppx_assert ppx_deriving.eq ppx_deriving_yojson ppx_let)) (inline_tests) (libraries + random_oracle_input core_kernel o1trace pickles - random_oracle_input snarky.backendless sponge )) diff --git a/src/lib/staged_ledger_diff/dune b/src/lib/staged_ledger_diff/dune index fd55ce4ca1a..ee932f38b88 100644 --- a/src/lib/staged_ledger_diff/dune +++ b/src/lib/staged_ledger_diff/dune @@ -1,5 +1,5 @@ (library (name staged_ledger_diff) (public_name staged_ledger_diff) - (libraries core_kernel coda_base transaction_snark_work staged_ledger_hash) + (libraries core_kernel coda_base transaction_snark_work) (preprocess (pps ppx_jane ppx_version ppx_deriving_yojson))) diff --git a/src/lib/staged_ledger_hash/dune b/src/lib/staged_ledger_hash/dune deleted file mode 100644 index 6ba51b7e686..00000000000 --- a/src/lib/staged_ledger_hash/dune +++ /dev/null @@ -1,6 +0,0 @@ -(library - (name staged_ledger_hash) - (public_name staged_ledger_hash) - (preprocessor_deps "../../config.mlh") - (preprocess (pps ppx_coda ppx_version ppx_bin_prot ppx_sexp_conv ppx_compare ppx_hash ppx_snarky ppx_optcomp ppx_deriving.std ppx_deriving_yojson h_list.ppx)) - (libraries core_kernel coda_base snark_params test_genesis_ledger bitstring_lib fold_lib tuple_lib with_hash)) diff --git a/src/lib/transaction_snark/transaction_snark.ml b/src/lib/transaction_snark/transaction_snark.ml index baa93ddf50e..839d00fddcb 100644 --- a/src/lib/transaction_snark/transaction_snark.ml +++ b/src/lib/transaction_snark/transaction_snark.ml @@ -1366,7 +1366,8 @@ module Base = struct ; receipt_chain_hash ; delegate ; voting_for= account.voting_for - ; timing } )) + ; timing + ; snapp= account.snapp } )) in let%bind receiver_increase = (* - payments: payload.body.amount @@ -1527,7 +1528,8 @@ module Base = struct ; receipt_chain_hash= account.receipt_chain_hash ; delegate ; voting_for= account.voting_for - ; timing= account.timing } )) + ; timing= account.timing + ; snapp= account.snapp } )) in let%bind fee_payer_is_source = Account_id.Checked.equal fee_payer source in let%bind root_after_source_update = @@ -1667,7 +1669,8 @@ module Base = struct ; receipt_chain_hash= account.receipt_chain_hash ; delegate ; voting_for= account.voting_for - ; timing } )) + ; timing + ; snapp= account.snapp } )) in let%bind fee_excess = (* - payments: payload.common.fee diff --git a/src/lib/transaction_snark_scan_state/dune b/src/lib/transaction_snark_scan_state/dune index 71f8c9e2276..b1c27e94f4e 100644 --- a/src/lib/transaction_snark_scan_state/dune +++ b/src/lib/transaction_snark_scan_state/dune @@ -3,7 +3,7 @@ (public_name transaction_snark_scan_state) (library_flags -linkall) (libraries pipe_lib core async async_extra sgn parallel_scan - transaction_snark coda_base ledger_proof staged_ledger_hash transaction_snark_work transaction_witness snark_work_lib snark_params logger coda_state ppx_deriving_yojson.runtime + transaction_snark coda_base ledger_proof transaction_snark_work transaction_witness snark_work_lib snark_params logger coda_state ppx_deriving_yojson.runtime yojson) (preprocessor_deps ../../config.mlh) (preprocess diff --git a/src/lib/with_hash/dune b/src/lib/with_hash/dune index 83a7b7291e7..67f6fa208b5 100644 --- a/src/lib/with_hash/dune +++ b/src/lib/with_hash/dune @@ -2,4 +2,4 @@ (name with_hash) (public_name with_hash) (libraries core_kernel) - (preprocess (pps ppx_jane ppx_deriving_yojson ppx_version))) + (preprocess (pps ppx_jane ppx_deriving_yojson ppx_deriving.std ppx_version))) diff --git a/src/lib/with_hash/with_hash.ml b/src/lib/with_hash/with_hash.ml index 4007fb2d438..cdf4f2ead4d 100644 --- a/src/lib/with_hash/with_hash.ml +++ b/src/lib/with_hash/with_hash.ml @@ -6,7 +6,7 @@ module Stable = struct module V1 = struct type ('a, 'h) t = {data: 'a; hash: 'h} - [@@deriving sexp, compare, hash, to_yojson] + [@@deriving sexp, eq, compare, hash, yojson] let to_latest data_latest hash_latest {data; hash} = {data= data_latest data; hash= hash_latest hash} @@ -14,7 +14,7 @@ module Stable = struct end] type ('a, 'h) t = ('a, 'h) Stable.Latest.t = {data: 'a; hash: 'h} -[@@deriving sexp, compare, hash, to_yojson] +[@@deriving sexp, eq, compare, hash, yojson] let data {data; _} = data diff --git a/src/lib/zexe_backend/zexe_backend_common/dlog_based_proof.ml b/src/lib/zexe_backend/zexe_backend_common/dlog_based_proof.ml index 968401e56b1..b764c0df76a 100644 --- a/src/lib/zexe_backend/zexe_backend_common/dlog_based_proof.ml +++ b/src/lib/zexe_backend/zexe_backend_common/dlog_based_proof.ml @@ -4,7 +4,7 @@ open Pickles_types module type Stable_v1 = sig module Stable : sig module V1 : sig - type t [@@deriving version, bin_io, sexp, compare, yojson] + type t [@@deriving version, bin_io, sexp, compare, yojson, hash, eq] end module Latest = V1 @@ -252,9 +252,9 @@ module Make (Inputs : Inputs_intf) = struct type t = ( G.Affine.Stable.V1.t , Fq.Stable.V1.t - , Fq.Stable.V1.t array ) + , Fq.Stable.V1.t Dlog_marlin_types.Pc_array.Stable.V1.t ) Dlog_marlin_types.Proof.Stable.V1.t - [@@deriving compare, sexp, yojson] + [@@deriving compare, sexp, yojson, hash, eq] let to_latest = Fn.id end diff --git a/src/nonconsensus/coda_base/account_timing.ml b/src/nonconsensus/coda_base/account_timing.ml new file mode 120000 index 00000000000..2b090cc2511 --- /dev/null +++ b/src/nonconsensus/coda_base/account_timing.ml @@ -0,0 +1 @@ +../../lib/coda_base/account_timing.ml \ No newline at end of file diff --git a/src/staged_ledger_hash.opam b/src/staged_ledger_hash.opam deleted file mode 100644 index a1b56499734..00000000000 --- a/src/staged_ledger_hash.opam +++ /dev/null @@ -1,5 +0,0 @@ -opam-version: "1.2" -version: "0.1" -build: [ - ["dune" "build" "--only" "src" "--root" "." "-j" jobs "@install"] -]