Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Account deriver DEVELOP #12700

Merged
merged 20 commits into from
Feb 23, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6,002 changes: 6,001 additions & 1 deletion genesis_ledgers/berkeley.json

Large diffs are not rendered by default.

23 changes: 22 additions & 1 deletion src/lib/fields_derivers_zkapps/fields_derivers_js.ml
Original file line number Diff line number Diff line change
Expand Up @@ -75,6 +75,7 @@ module Js_layout = struct
| UInt32
| UInt64
| PublicKey
| Sign
| Custom of string

let leaf_type_to_string = function
Expand All @@ -94,6 +95,8 @@ module Js_layout = struct
"UInt64"
| PublicKey ->
"PublicKey"
| Sign ->
"Sign"
| Custom s ->
s

Expand All @@ -105,6 +108,10 @@ module Js_layout = struct
let leaf_type (s : leaf_type) =
`Assoc [ ("type", `String (leaf_type_to_string s)) ]

let of_layout layout obj =
obj#js_layout := layout ;
obj

let skip obj =
obj#skip := true ;
obj#js_layout := leaf_type Null ;
Expand Down Expand Up @@ -135,6 +142,20 @@ module Js_layout = struct
] ;
obj

let record (entries : (string * 'a) list) (obj : _ Input.t) : _ Input.t =
obj#js_layout :=
`Assoc
[ ("type", `String "object")
; ("name", `String "Anonymous")
; ("docs", `Null)
; ("keys", `List (List.map ~f:(fun (key, _) -> `String key) entries))
; ( "entries"
, `Assoc (List.map ~f:(fun (key, inner) -> (key, inner)) entries) )
; ( "docEntries"
, `Assoc (List.map ~f:(fun (key, _) -> (key, `String "")) entries) )
] ;
obj

let option x obj ~(js_type : option_type) : _ Input.t =
let inner = !(x#js_layout) in
let layout =
Expand Down Expand Up @@ -167,7 +188,7 @@ module Js_layout = struct
obj#js_layout := !(x#js_layout) ;
obj

let with_checked ~name (x : _ Input.t) (obj : _ Input.t) =
let needs_custom_js ~name (x : _ Input.t) (obj : _ Input.t) =
match !(obj#js_layout) with
| `Assoc layout ->
obj#js_layout :=
Expand Down
19 changes: 13 additions & 6 deletions src/lib/fields_derivers_zkapps/fields_derivers_zkapps.ml
Original file line number Diff line number Diff line change
Expand Up @@ -189,14 +189,21 @@ module Make (Schema : Graphql_intf.Schema) = struct
let _e = Fields_derivers_js.Js_layout.skip obj in
Fields_derivers_json.Of_yojson.skip obj

let js_only js_layout obj : _ Unified_input.t =
let js_only (js_layout : _ Fields_derivers_js.Js_layout.Input.t -> 'a) obj :
_ Unified_input.t =
let _a = Graphql.Fields.skip obj in
let _b = Graphql.Args.skip obj in
let _c = Fields_derivers_json.To_yojson.skip obj in
let _d = Fields_derivers_graphql.Graphql_query.skip obj in
obj#js_layout := js_layout ;
let _e = js_layout obj in
Fields_derivers_json.Of_yojson.skip obj

let js_leaf leaf obj =
js_only Fields_derivers_js.Js_layout.(of_layout @@ leaf_type leaf) obj

let js_record entries obj =
js_only (Fields_derivers_js.Js_layout.record entries) obj

let int obj : _ Unified_input.t =
let _a = Graphql.Fields.int obj in
let _b = Graphql.Args.int obj in
Expand Down Expand Up @@ -311,9 +318,9 @@ module Make (Schema : Graphql_intf.Schema) = struct
in
Fields_derivers_json.Of_yojson.finish ((fun x -> f (`Right x)), acc)

let with_checked ~checked ~name deriver obj =
Fields_derivers_js.Js_layout.with_checked ~name
(checked @@ o ())
let needs_custom_js ~js_type ~name deriver obj =
Fields_derivers_js.Js_layout.needs_custom_js ~name
(js_type @@ o ())
(deriver obj)

let balance_change obj =
Expand All @@ -332,7 +339,7 @@ module Make (Schema : Graphql_intf.Schema) = struct
failwith "impossible"
in
let sign_deriver =
iso_string ~name:"Sign" ~js_type:(Custom "Sign") ~to_string:sign_to_string
iso_string ~name:"Sign" ~js_type:Sign ~to_string:sign_to_string
~of_string:sign_of_string
in
let ( !. ) = ( !. ) ~t_fields_annots:Currency.Signed_poly.t_fields_annots in
Expand Down
18 changes: 17 additions & 1 deletion src/lib/mina_base/account.ml
Original file line number Diff line number Diff line change
Expand Up @@ -250,7 +250,7 @@ module Poly = struct
; permissions : 'permissions
; zkapp : 'zkapp_opt
}
[@@deriving sexp, equal, compare, hash, yojson, fields, hlist]
[@@deriving sexp, equal, compare, hash, yojson, fields, hlist, annot]

let to_latest = Fn.id
end
Expand Down Expand Up @@ -886,3 +886,19 @@ let gen_timed =
failwith @@ Error.to_string_hum e
| Ok a ->
return a

let deriver obj =
let open Fields_derivers_zkapps in
let ( !. ) = ( !. ) ~t_fields_annots:Poly.t_fields_annots in
let receipt_chain_hash =
needs_custom_js ~js_type:field ~name:"ReceiptChainHash" field
in
finish "Account" ~t_toplevel_annots:Poly.t_toplevel_annots
@@ Poly.Fields.make_creator ~public_key:!.public_key
~token_id:!.Token_id.deriver ~token_symbol:!.string ~balance:!.balance
~nonce:!.uint32 ~receipt_chain_hash:!.receipt_chain_hash
~delegate:!.(option ~js_type:Or_undefined (public_key @@ o ()))
~voting_for:!.field ~timing:!.Timing.deriver
~permissions:!.Permissions.deriver
~zkapp:!.(option ~js_type:Or_undefined (Zkapp_account.deriver @@ o ()))
obj
107 changes: 66 additions & 41 deletions src/lib/mina_base/account_timing.ml
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,15 @@ module As_record = struct
; vesting_period : 'slot
; vesting_increment : 'amount
}
[@@deriving hlist]
[@@deriving hlist, fields, annot]

let deriver obj =
let open Fields_derivers_zkapps.Derivers in
let ( !. ) = ( !. ) ~t_fields_annots in
Fields.make_creator obj ~is_timed:!.bool ~initial_minimum_balance:!.balance
~cliff_time:!.global_slot ~cliff_amount:!.amount
~vesting_period:!.global_slot ~vesting_increment:!.amount
|> finish "AccountTiming" ~t_toplevel_annots
end

(* convert sum type to record format, useful for to_bits and typ *)
Expand All @@ -78,29 +86,45 @@ let to_record t =
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
; cliff_amount = amount_unused
; vesting_period = slot_one (* avoid division by zero *)
; vesting_increment = amount_unused
}
{ As_record.is_timed = false
; initial_minimum_balance = balance_unused
; cliff_time = slot_unused
; cliff_amount = amount_unused
; vesting_period = slot_one (* avoid division by zero *)
; vesting_increment = amount_unused
}
| Timed
{ initial_minimum_balance
; cliff_time
; cliff_amount
; vesting_period
; vesting_increment
} ->
As_record.
{ is_timed = true
; initial_minimum_balance
; cliff_time
; cliff_amount
; vesting_period
; vesting_increment
}
{ is_timed = true
; initial_minimum_balance
; cliff_time
; cliff_amount
; vesting_period
; vesting_increment
}

let of_record
{ As_record.is_timed
; initial_minimum_balance
; cliff_time
; cliff_amount
; vesting_period
; vesting_increment
} : t =
if is_timed then
Timed
{ initial_minimum_balance
; cliff_time
; cliff_amount
; vesting_period
; vesting_increment
}
else Untimed

let to_input t =
let As_record.
Expand Down Expand Up @@ -148,24 +172,22 @@ let var_to_input
|]

let var_of_t (t : t) : var =
let As_record.
{ is_timed
; initial_minimum_balance
; cliff_time
; cliff_amount
; vesting_period
; vesting_increment
} =
let { As_record.is_timed
; initial_minimum_balance
; cliff_time
; cliff_amount
; 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
; cliff_amount = Amount.var_of_t cliff_amount
; vesting_period = Global_slot.Checked.constant vesting_period
; vesting_increment = Amount.var_of_t vesting_increment
}
{ 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
; cliff_amount = Amount.var_of_t cliff_amount
; vesting_period = Global_slot.Checked.constant vesting_period
; vesting_increment = Amount.var_of_t vesting_increment
}

let untimed_var = var_of_t Untimed

Expand Down Expand Up @@ -260,13 +282,16 @@ let if_ b ~(then_ : var) ~(else_ : var) =
Amount.Checked.if_ b ~then_:then_.vesting_increment
~else_:else_.vesting_increment
in
As_record.
{ is_timed
; initial_minimum_balance
; cliff_time
; cliff_amount
; vesting_period
; vesting_increment
}
{ As_record.is_timed
; initial_minimum_balance
; cliff_time
; cliff_amount
; vesting_period
; vesting_increment
}

let deriver obj =
let open Fields_derivers_zkapps in
iso_record ~to_record ~of_record As_record.deriver obj

[%%endif]
10 changes: 6 additions & 4 deletions src/lib/mina_base/account_update.ml
Original file line number Diff line number Diff line change
Expand Up @@ -917,13 +917,15 @@ module Update = struct
let open Fields_derivers_zkapps in
let ( !. ) = ( !. ) ~t_fields_annots in
let zkapp_uri =
with_checked
~checked:(Data_as_hash.deriver string)
needs_custom_js
~js_type:(Data_as_hash.deriver string)
~name:"ZkappUri" string
in
let token_symbol =
with_checked
~checked:(js_only (Js_layout.leaf_type (Custom "TokenSymbol")))
needs_custom_js
~js_type:
(js_record
[ ("symbol", js_layout string); ("field", js_layout field) ] )
~name:"TokenSymbol" string
in
finish "AccountUpdateModification" ~t_toplevel_annots
Expand Down
24 changes: 21 additions & 3 deletions src/lib/mina_base/zkapp_account.ml
Original file line number Diff line number Diff line change
Expand Up @@ -92,8 +92,8 @@ struct
let deriver obj =
let open Fields_derivers_zkapps in
let events = list @@ array field (o ()) in
with_checked
~checked:(Data_as_hash.deriver events)
needs_custom_js
~js_type:(Data_as_hash.deriver events)
~name:Inputs.deriver_name events obj
end

Expand Down Expand Up @@ -240,7 +240,7 @@ module Poly = struct
; proved_state : 'bool
; zkapp_uri : 'zkapp_uri
}
[@@deriving sexp, equal, compare, hash, yojson, hlist, fields]
[@@deriving sexp, equal, compare, hash, yojson, hlist, fields, annot]
end
end]
end
Expand Down Expand Up @@ -450,3 +450,21 @@ let hash_zkapp_account_opt' = function
Lazy.force default_digest
| Some (a : t) ->
digest a

let sequence_state_deriver obj =
let open Fields_derivers_zkapps.Derivers in
let list_5 = list ~static_length:5 (field @@ o ()) in
let open Pickles_types.Vector.Vector_5 in
iso ~map:of_list_exn ~contramap:to_list (list_5 (o ())) obj

let deriver obj =
let open Fields_derivers_zkapps in
let ( !. ) = ( !. ) ~t_fields_annots:Poly.t_fields_annots in
finish "ZkappAccount" ~t_toplevel_annots:Poly.t_toplevel_annots
@@ Poly.Fields.make_creator
~app_state:!.(Zkapp_state.deriver field)
~verification_key:
!.(option ~js_type:Or_undefined (verification_key_with_hash @@ o ()))
~zkapp_version:!.uint32 ~sequence_state:!.sequence_state_deriver
~last_sequence_slot:!.global_slot ~proved_state:!.bool
~zkapp_uri:!.string obj
2 changes: 1 addition & 1 deletion src/lib/mina_base/zkapp_precondition.ml
Original file line number Diff line number Diff line change
Expand Up @@ -525,7 +525,7 @@ module Account = struct
let open Fields_derivers_zkapps in
let ( !. ) = ( !. ) ~t_fields_annots in
let sequence_state =
with_checked ~checked:field ~name:"SequenceState" field
needs_custom_js ~js_type:field ~name:"SequenceState" field
in
Fields.make_creator obj ~balance:!.Numeric.Derivers.balance
~nonce:!.Numeric.Derivers.nonce
Expand Down
Loading