Merge pull request #12700 from MinaProtocol/snarkyjs/account-deriver-…

…develop

Account deriver DEVELOP

src/lib/fields_derivers_zkapps/fields_derivers_js.ml

@@ -75,6 +75,7 @@ module Js_layout = struct
     | UInt32
     | UInt64
     | PublicKey
+    | Sign
     | Custom of string
 
   let leaf_type_to_string = function
@@ -94,6 +95,8 @@ module Js_layout = struct
         "UInt64"
     | PublicKey ->
         "PublicKey"
+    | Sign ->
+        "Sign"
     | Custom s ->
         s
 
@@ -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 ;
@@ -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 =
@@ -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 :=

src/lib/fields_derivers_zkapps/fields_derivers_zkapps.ml

@@ -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
@@ -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 =
@@ -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

src/lib/mina_base/account.ml

@@ -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
@@ -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

src/lib/mina_base/account_timing.ml

@@ -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 *)
@@ -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.
@@ -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
 
@@ -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]

src/lib/mina_base/account_update.ml

@@ -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

src/lib/mina_base/zkapp_account.ml

@@ -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
 
@@ -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
@@ -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

src/lib/mina_base/zkapp_precondition.ml

@@ -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