Enable payments using zkApp accounts

graphql_schema.json

@@ -6178,7 +6178,7 @@
             },
             {
               "name": "supplyIncrease",
-              "description": "Increase in total coinbase reward ",
+              "description": "Increase in total supply",
               "args": [],
               "type": {
                 "kind": "NON_NULL",
@@ -6189,6 +6189,22 @@
                   "ofType": null
                 }
               },
+              "isDeprecated": true,
+              "deprecationReason": "Use supplyChange"
+            },
+            {
+              "name": "supplyChange",
+              "description": "Increase/Decrease in total supply",
+              "args": [],
+              "type": {
+                "kind": "NON_NULL",
+                "name": null,
+                "ofType": {
+                  "kind": "OBJECT",
+                  "name": "SignedFee",
+                  "ofType": null
+                }
+              },
               "isDeprecated": false,
               "deprecationReason": null
             },

src/app/cli/src/init/transaction_snark_profiler.ml

@@ -145,7 +145,7 @@ let profile (module T : Transaction_snark.S) sparse_ledger0
     List.fold_map transitions
       ~init:(Time.Span.zero, sparse_ledger0, Pending_coinbase.Stack.empty)
       ~f:(fun (max_span, sparse_ledger, coinbase_stack_source) t ->
-        let sparse_ledger', _ =
+        let sparse_ledger', applied_transaction =
           Sparse_ledger.apply_transaction ~constraint_constants ~txn_state_view
             sparse_ledger (Transaction.forget t)
           |> Or_error.ok_exn
@@ -154,6 +154,11 @@ let profile (module T : Transaction_snark.S) sparse_ledger0
           pending_coinbase_stack_target (Transaction.forget t)
             coinbase_stack_source
         in
+        let supply_increase =
+          Mina_ledger.Ledger.Transaction_applied.supply_increase
+            applied_transaction
+          |> Or_error.ok_exn
+        in
         let span, proof =
           time (fun () ->
               Async.Thread_safe.block_on_async_exn (fun () ->
@@ -170,8 +175,7 @@ let profile (module T : Transaction_snark.S) sparse_ledger0
                           ; pending_coinbase_stack = coinbase_stack_target
                           ; local_state = Mina_state.Local_state.empty ()
                           }
-                      ; supply_increase =
-                          Transaction.supply_increase t |> Or_error.ok_exn
+                      ; supply_increase
                       ; fee_excess =
                           Transaction.fee_excess (Transaction.forget t)
                           |> Or_error.ok_exn
@@ -217,7 +221,7 @@ let check_base_snarks sparse_ledger0 (transitions : Transaction.Valid.t list)
       in
       let txn_state_view = Lazy.force curr_state_view in
       List.fold transitions ~init:sparse_ledger0 ~f:(fun sparse_ledger t ->
-          let sparse_ledger', _ =
+          let sparse_ledger', applied_transaction =
             Sparse_ledger.apply_transaction ~constraint_constants
               ~txn_state_view sparse_ledger (Transaction.forget t)
             |> Or_error.ok_exn
@@ -226,6 +230,11 @@ let check_base_snarks sparse_ledger0 (transitions : Transaction.Valid.t list)
             pending_coinbase_stack_target (Transaction.forget t)
               Pending_coinbase.Stack.empty
           in
+          let supply_increase =
+            Mina_ledger.Ledger.Transaction_applied.supply_increase
+              applied_transaction
+            |> Or_error.ok_exn
+          in
           let () =
             Transaction_snark.check_transaction ?preeval ~constraint_constants
               ~sok_message
@@ -236,7 +245,7 @@ let check_base_snarks sparse_ledger0 (transitions : Transaction.Valid.t list)
                 { source = Pending_coinbase.Stack.empty
                 ; target = coinbase_stack_target
                 }
-              ~zkapp_account1:None ~zkapp_account2:None
+              ~zkapp_account1:None ~zkapp_account2:None ~supply_increase
               { Transaction_protocol_state.Poly.block_data =
                   Lazy.force state_body
               ; transaction = t
@@ -258,7 +267,7 @@ let generate_base_snarks_witness sparse_ledger0
       in
       let txn_state_view = Lazy.force curr_state_view in
       List.fold transitions ~init:sparse_ledger0 ~f:(fun sparse_ledger t ->
-          let sparse_ledger', _ =
+          let sparse_ledger', applied_transaction =
             Sparse_ledger.apply_transaction ~constraint_constants
               ~txn_state_view sparse_ledger (Transaction.forget t)
             |> Or_error.ok_exn
@@ -267,6 +276,11 @@ let generate_base_snarks_witness sparse_ledger0
             pending_coinbase_stack_target (Transaction.forget t)
               Pending_coinbase.Stack.empty
           in
+          let supply_increase =
+            Mina_ledger.Ledger.Transaction_applied.supply_increase
+              applied_transaction
+            |> Or_error.ok_exn
+          in
           let () =
             Transaction_snark.generate_transaction_witness ?preeval
               ~constraint_constants ~sok_message
@@ -278,7 +292,7 @@ let generate_base_snarks_witness sparse_ledger0
                     Pending_coinbase.Stack.empty
                 ; target = coinbase_stack_target
                 }
-              ~zkapp_account1:None ~zkapp_account2:None
+              ~zkapp_account1:None ~zkapp_account2:None ~supply_increase
               { Transaction_protocol_state.Poly.transaction = t
               ; block_data = Lazy.force state_body
               }

src/lib/block_producer/block_producer.ml

@@ -258,7 +258,7 @@ let generate_next_state ~constraint_constants ~previous_protocol_state
               Option.value_map ledger_proof_opt
                 ~f:(fun (proof, _) ->
                   (Ledger_proof.statement proof).supply_increase )
-                ~default:Currency.Amount.zero
+                ~default:Currency.Amount.Signed.zero
             in
             let body_reference =
               Staged_ledger_diff.Body.compute_reference

src/lib/block_producer/dune

@@ -54,6 +54,7 @@
    unsigned_extended
    genesis_constants
    data_hash_lib
+   sgn
  )
  (preprocess
   (pps ppx_coda ppx_version ppx_jane ppx_register_event))

src/lib/blockchain_snark/blockchain_snark_state.ml

@@ -191,7 +191,9 @@ let%snarkydef step ~(logger : Logger.t)
         (previous_state |> Protocol_state.blockchain_state).registers
         { txn_snark.target with pending_coinbase_stack = () }
     and supply_increase_is_zero =
-      Currency.Amount.(equal_var txn_snark.supply_increase (var_of_t zero))
+      Currency.Amount.(
+        Signed.Checked.equal txn_snark.supply_increase
+          (Signed.Checked.of_unsigned (var_of_t zero)))
     in
     let%bind new_pending_coinbase_hash, deleted_stack, no_coinbases_popped =
       let coinbase_receiver =
@@ -259,7 +261,8 @@ let%snarkydef step ~(logger : Logger.t)
       Pending_coinbase.Hash.equal_var new_pending_coinbase_hash new_root
     in
     let%bind () =
-      Boolean.Assert.any [ txn_snark_input_correct; nothing_changed ]
+      with_label __LOC__
+        (Boolean.Assert.any [ txn_snark_input_correct; nothing_changed ])
     in
     let transaction_snark_should_verifiy = Boolean.not nothing_changed in
     let%bind result =
@@ -311,7 +314,9 @@ let%snarkydef step ~(logger : Logger.t)
     | Full ->
         Boolean.not is_base_case
   in
-  let%bind () = Boolean.Assert.any [ is_base_case; success ] in
+  let%bind () =
+    with_label __LOC__ (Boolean.Assert.any [ is_base_case; success ])
+  in
   let%bind previous_blockchain_proof =
     exists (Typ.Internal.ref ()) ~request:(As_prover.return Prev_state_proof)
   in

src/lib/consensus/intf.ml

@@ -195,7 +195,7 @@ module type State_hooks = sig
     -> supercharge_coinbase:bool
     -> snarked_ledger_hash:Mina_base.Frozen_ledger_hash.t
     -> genesis_ledger_hash:Mina_base.Frozen_ledger_hash.t
-    -> supply_increase:Currency.Amount.t
+    -> supply_increase:Currency.Amount.Signed.t
     -> logger:Logger.t
     -> constraint_constants:Genesis_constants.Constraint_constants.t
     -> protocol_state * consensus_transition
@@ -209,7 +209,7 @@ module type State_hooks = sig
     -> prev_state:protocol_state_var
     -> prev_state_hash:Mina_base.State_hash.var
     -> snark_transition_var
-    -> Currency.Amount.var
+    -> Currency.Amount.Signed.var
     -> ([ `Success of Snark_params.Tick.Boolean.var ] * consensus_state_var)
        Snark_params.Tick.Checked.t
 

src/lib/consensus/proof_of_stake.ml

@@ -1867,7 +1867,7 @@ module Data = struct
     let update ~(constants : Constants.t) ~(previous_consensus_state : Value.t)
         ~(consensus_transition : Consensus_transition.t)
         ~(previous_protocol_state_hash : Mina_base.State_hash.t)
-        ~(supply_increase : Currency.Amount.t)
+        ~(supply_increase : Currency.Amount.Signed.t)
         ~(snarked_ledger_hash : Mina_base.Frozen_ledger_hash.t)
         ~(genesis_ledger_hash : Mina_base.Frozen_ledger_hash.t)
         ~(producer_vrf_result : Random_oracle.Digest.t)
@@ -1897,10 +1897,16 @@ module Data = struct
              ~f:(fun diff -> Ok diff)
       in
       let%map total_currency =
-        Amount.add previous_consensus_state.total_currency supply_increase
-        |> Option.map ~f:Or_error.return
-        |> Option.value
-             ~default:(Or_error.error_string "Failed to add total_currency")
+        let total, `Overflow overflow =
+          Amount.add_signed_flagged previous_consensus_state.total_currency
+            supply_increase
+        in
+        if overflow then
+          Or_error.errorf
+            !"New total currency less than zero. supply_increase: %{sexp: \
+              Amount.Signed.t} previous total currency: %{sexp: Amount.t}"
+            supply_increase previous_consensus_state.total_currency
+        else Ok total
       and () =
         if
           Consensus_transition.(
@@ -2059,7 +2065,7 @@ module Data = struct
              (negative_one ~genesis_ledger ~genesis_epoch_data ~constants
                 ~constraint_constants )
            ~previous_protocol_state_hash:negative_one_protocol_state_hash
-           ~consensus_transition ~supply_increase:Currency.Amount.zero
+           ~consensus_transition ~supply_increase:Currency.Amount.Signed.zero
            ~snarked_ledger_hash ~genesis_ledger_hash:snarked_ledger_hash
            ~block_stake_winner:genesis_winner_pk
            ~block_creator:genesis_winner_pk ~coinbase_receiver:genesis_winner_pk
@@ -2101,7 +2107,7 @@ module Data = struct
     let%snarkydef update_var (previous_state : var)
         (transition_data : Consensus_transition.var)
         (previous_protocol_state_hash : Mina_base.State_hash.var)
-        ~(supply_increase : Currency.Amount.var)
+        ~(supply_increase : Currency.Amount.Signed.var)
         ~(previous_blockchain_state_ledger_hash :
            Mina_base.Frozen_ledger_hash.var ) ~genesis_ledger_hash
         ~constraint_constants
@@ -2169,10 +2175,14 @@ module Data = struct
         compute_supercharge_coinbase ~winner_account
           ~global_slot:global_slot_since_genesis
       in
-      let%bind new_total_currency =
-        Currency.Amount.Checked.add previous_state.total_currency
+      let%bind new_total_currency, `Overflow overflow =
+        Currency.Amount.Checked.add_signed_flagged previous_state.total_currency
           supply_increase
       in
+      let%bind () =
+        [%with_label "Total currency is greater than or equal to zero"]
+          (Boolean.Assert.is_true (Boolean.not overflow))
+      in
       let%bind has_ancestor_in_same_checkpoint_window =
         same_checkpoint_window ~constants ~prev:prev_global_slot
           ~next:next_global_slot
@@ -2231,11 +2241,6 @@ module Data = struct
         }
       and blockchain_length =
         Length.Checked.succ previous_state.blockchain_length
-      (* TODO: keep track of total_currency in transaction snark. The current_slot
-       * implementation would allow an adversary to make then total_currency incorrect by
-       * not adding the coinbase to their account. *)
-      and new_total_currency =
-        Amount.Checked.add previous_state.total_currency supply_increase
       and epoch_count =
         Length.Checked.succ_if previous_state.epoch_count epoch_increased
       and min_window_density, sub_window_densities =
@@ -3600,7 +3605,7 @@ let%test_module "Proof of stake tests" =
       let consensus_transition : Consensus_transition.t =
         Global_slot.slot_number global_slot
       in
-      let supply_increase = Currency.Amount.of_int 42 in
+      let supply_increase = Currency.Amount.(Signed.of_unsigned (of_int 42)) in
       (* setup ledger, needed to compute producer_vrf_result here and handler below *)
       let open Mina_base in
       (* choose largest account as most likely to produce a block *)
@@ -3686,7 +3691,7 @@ let%test_module "Proof of stake tests" =
             ~compute:(As_prover.return previous_protocol_state_hash)
         in
         let%bind supply_increase =
-          exists Amount.typ ~compute:(As_prover.return supply_increase)
+          exists Amount.Signed.typ ~compute:(As_prover.return supply_increase)
         in
         let%bind previous_blockchain_state_ledger_hash =
           exists Mina_base.Frozen_ledger_hash.typ

src/lib/currency/currency.ml

@@ -409,7 +409,7 @@ end = struct
 
     let magnitude { magnitude; _ } = magnitude
 
-    let zero = create ~magnitude:zero ~sgn:Sgn.Pos
+    let zero : t = create ~magnitude:zero ~sgn:Sgn.Pos
 
     let gen =
       Quickcheck.Generator.map2 gen Sgn.gen ~f:(fun magnitude sgn ->
@@ -464,7 +464,7 @@ end = struct
       if Unsigned.(equal zero t.magnitude) then zero
       else { t with sgn = Sgn.negate t.sgn }
 
-    let of_unsigned magnitude = create ~magnitude ~sgn:Sgn.Pos
+    let of_unsigned magnitude : t = create ~magnitude ~sgn:Sgn.Pos
 
     let ( + ) = add
 

src/lib/currency/currency.mli

@@ -113,6 +113,8 @@ module Amount : sig
 
   val add_fee : t -> Fee.t -> t option
 
+  val add_signed_flagged : t -> Signed.t -> t * [ `Overflow of bool ]
+
   [%%ifdef consensus_mechanism]
 
   module Checked : sig
@@ -124,6 +126,9 @@ module Amount : sig
 
     val add_signed : var -> Signed.var -> var Checked.t
 
+    val add_signed_flagged :
+      var -> Signed.var -> (var * [ `Overflow of Boolean.var ]) Checked.t
+
     val of_fee : Fee.var -> var
 
     val to_fee : var -> Fee.var

src/lib/genesis_proof/genesis_proof.ml

@@ -168,7 +168,7 @@ let base_proof (module B : Blockchain_snark.Blockchain_snark_state.S)
     { sok_digest = Mina_base.Sok_message.Digest.default
     ; source = reg (Protocol_state.blockchain_state prev_state)
     ; target = reg (Protocol_state.blockchain_state curr)
-    ; supply_increase = Currency.Amount.zero
+    ; supply_increase = Currency.Amount.Signed.zero
     ; fee_excess = Fee_excess.zero
     }
   in

src/lib/mina_base/account.ml

@@ -664,6 +664,18 @@ module Checked = struct
     in
     (*Note: Untimed accounts will always have zero min balance*)
     Boolean.not zero_min_balance
+
+  let has_permission ~to_ (account : var) =
+    match to_ with
+    | `Send ->
+        Permissions.Auth_required.Checked.eval_no_proof account.permissions.send
+          ~signature_verifies:Boolean.true_
+    | `Receive ->
+        Permissions.Auth_required.Checked.eval_no_proof
+          account.permissions.receive ~signature_verifies:Boolean.false_
+    | `Set_delegate ->
+        Permissions.Auth_required.Checked.eval_no_proof
+          account.permissions.set_delegate ~signature_verifies:Boolean.true_
 end
 
 [%%endif]
@@ -824,6 +836,18 @@ let has_locked_tokens ~global_slot (account : t) =
       in
       Balance.(curr_min_balance > zero)
 
+let has_permission ~to_ (account : t) =
+  match to_ with
+  | `Send ->
+      Permissions.Auth_required.check account.permissions.send
+        Control.Tag.Signature
+  | `Receive ->
+      Permissions.Auth_required.check account.permissions.receive
+        Control.Tag.None_given
+  | `Set_delegate ->
+      Permissions.Auth_required.check account.permissions.set_delegate
+        Control.Tag.Signature
+
 let gen =
   let open Quickcheck.Let_syntax in
   let%bind public_key = Public_key.Compressed.gen in

src/lib/mina_base/coinbase.ml

@@ -64,7 +64,7 @@ let create ~amount ~receiver ~fee_transfer =
     Ok { t with fee_transfer = adjusted_fee_transfer }
   else Or_error.error_string "Coinbase.create: invalid coinbase"
 
-let supply_increase { receiver = _; amount; fee_transfer } =
+let expected_supply_increase { receiver = _; amount; fee_transfer } =
   match fee_transfer with
   | None ->
       Ok amount
@@ -75,7 +75,8 @@ let supply_increase { receiver = _; amount; fee_transfer } =
            ~default:(Or_error.error_string "Coinbase underflow")
 
 let fee_excess t =
-  Or_error.map (supply_increase t) ~f:(fun _increase -> Fee_excess.empty)
+  Or_error.map (expected_supply_increase t) ~f:(fun _increase ->
+      Fee_excess.empty )
 
 module Gen = struct
   let gen ~(constraint_constants : Genesis_constants.Constraint_constants.t) =

src/lib/mina_base/coinbase.mli

@@ -43,7 +43,7 @@ val create :
   -> fee_transfer:Fee_transfer.t option
   -> t Or_error.t
 
-val supply_increase : t -> Currency.Amount.t Or_error.t
+val expected_supply_increase : t -> Currency.Amount.t Or_error.t
 
 val fee_excess : t -> Fee_excess.t Or_error.t