diff --git a/graphql_schema.json b/graphql_schema.json
index 1458ab89ceb..b49b13d78e3 100644
--- a/graphql_schema.json
+++ b/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
             },
diff --git a/src/app/cli/src/init/transaction_snark_profiler.ml b/src/app/cli/src/init/transaction_snark_profiler.ml
index 7f81b481321..a580f7fb08e 100644
--- a/src/app/cli/src/init/transaction_snark_profiler.ml
+++ b/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
               }
diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml
index 7f30d80ce77..2d5f431bd5c 100644
--- a/src/lib/block_producer/block_producer.ml
+++ b/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
diff --git a/src/lib/block_producer/dune b/src/lib/block_producer/dune
index 93183073da0..95e3e72478a 100644
--- a/src/lib/block_producer/dune
+++ b/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))
diff --git a/src/lib/blockchain_snark/blockchain_snark_state.ml b/src/lib/blockchain_snark/blockchain_snark_state.ml
index a67118bf3f7..85adbfba322 100644
--- a/src/lib/blockchain_snark/blockchain_snark_state.ml
+++ b/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
diff --git a/src/lib/consensus/intf.ml b/src/lib/consensus/intf.ml
index 5d2d219621d..c3c8ed6519e 100644
--- a/src/lib/consensus/intf.ml
+++ b/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
 
diff --git a/src/lib/consensus/proof_of_stake.ml b/src/lib/consensus/proof_of_stake.ml
index 7054bc2c9e8..02f761fa2af 100644
--- a/src/lib/consensus/proof_of_stake.ml
+++ b/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
diff --git a/src/lib/currency/currency.ml b/src/lib/currency/currency.ml
index 129eba7f5bb..f2ddddea815 100644
--- a/src/lib/currency/currency.ml
+++ b/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
 
diff --git a/src/lib/currency/currency.mli b/src/lib/currency/currency.mli
index 2b79f721f23..4394bc532aa 100644
--- a/src/lib/currency/currency.mli
+++ b/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
diff --git a/src/lib/genesis_proof/genesis_proof.ml b/src/lib/genesis_proof/genesis_proof.ml
index 7bd7e30f551..68919b69136 100644
--- a/src/lib/genesis_proof/genesis_proof.ml
+++ b/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
diff --git a/src/lib/mina_base/account.ml b/src/lib/mina_base/account.ml
index dc2e57ff275..bb2aaf57a5c 100644
--- a/src/lib/mina_base/account.ml
+++ b/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
diff --git a/src/lib/mina_base/coinbase.ml b/src/lib/mina_base/coinbase.ml
index d508578de3e..d56fbbd2168 100644
--- a/src/lib/mina_base/coinbase.ml
+++ b/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) =
diff --git a/src/lib/mina_base/coinbase.mli b/src/lib/mina_base/coinbase.mli
index 7b0c639fc5a..cc46fc6f6d1 100644
--- a/src/lib/mina_base/coinbase.mli
+++ b/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
 
diff --git a/src/lib/mina_base/transaction_union_payload.ml b/src/lib/mina_base/transaction_union_payload.ml
index 17a12bcb2c9..f200d25a6e4 100644
--- a/src/lib/mina_base/transaction_union_payload.ml
+++ b/src/lib/mina_base/transaction_union_payload.ml
@@ -342,7 +342,7 @@ let fee_excess ({ body = { tag; amount; _ }; common = { fee; _ } } : t) =
   | Coinbase ->
       Fee_excess.of_single (Token_id.default, Fee.Signed.zero)
 
-let supply_increase (payload : payload) =
+let expected_supply_increase (payload : payload) =
   let tag = payload.body.tag in
   match tag with
   | Coinbase ->
diff --git a/src/lib/mina_block/sample_precomputed_block.ml b/src/lib/mina_block/sample_precomputed_block.ml
index 70dc0b20f52..9ee61c702f0 100644
--- a/src/lib/mina_block/sample_precomputed_block.ml
+++ b/src/lib/mina_block/sample_precomputed_block.ml
@@ -242,7 +242,8 @@ let sample_block_sexp =
              (22499651728538207005910357716049978340631095673070502882028605031745076772395
               21266536673826554532093395738082641944736479358210082051896629070545311602022)))))
          (status Applied))))
-      (coinbase (One ())))
+      (coinbase (One ()))
+      (internal_command_statuses (Applied (Failed ((Update_not_permitted_balance) (Update_not_permitted_balance))))))
      ()))))
  (delta_transition_chain_proof
   (5582850020617837418082100114371302095819386849215536975366590036056158060076
@@ -765,6 +766,10 @@ let sample_block_json =
           "coinbase": [
             "One",
             null
+          ],
+          "internal_command_statuses":[
+            ["Applied"],
+            ["Failed",[[["Update_not_permitted_balance"]],[["Update_not_permitted_balance"]]]]
           ]
         },
         null
diff --git a/src/lib/mina_graphql/mina_graphql.ml b/src/lib/mina_graphql/mina_graphql.ml
index 660b5c9d9d9..37e834c7f99 100644
--- a/src/lib/mina_graphql/mina_graphql.ml
+++ b/src/lib/mina_graphql/mina_graphql.ml
@@ -610,12 +610,20 @@ module Types = struct
                 magnitude = Currency.Amount.of_fee fee_excess_l.magnitude
               } )
         ; field "supplyIncrease" ~typ:(non_null uint64)
-            ~doc:"Increase in total coinbase reward "
+            ~doc:"Increase in total supply"
             ~args:Arg.[]
+            ~deprecated:(Deprecated (Some "Use supplyChange"))
             ~resolve:(fun _
                           ({ supply_increase; _ } :
                             Transaction_snark.Statement.t ) ->
-              Currency.Amount.to_uint64 supply_increase )
+              Currency.Amount.to_uint64 supply_increase.magnitude )
+        ; field "supplyChange" ~typ:(non_null signed_fee)
+            ~doc:"Increase/Decrease in total supply"
+            ~args:Arg.[]
+            ~resolve:(fun _
+                          ({ supply_increase; _ } :
+                            Transaction_snark.Statement.t ) -> supply_increase
+              )
         ; field "workId" ~doc:"Unique identifier for a snark work"
             ~typ:(non_null int)
             ~args:Arg.[]
diff --git a/src/lib/mina_ledger/ledger.mli b/src/lib/mina_ledger/ledger.mli
index a3cbf804ae2..e7a1d87e2b4 100644
--- a/src/lib/mina_ledger/ledger.mli
+++ b/src/lib/mina_ledger/ledger.mli
@@ -144,13 +144,19 @@ module Transaction_applied : sig
 
   module Fee_transfer_applied : sig
     type t = Transaction_applied.Fee_transfer_applied.t =
-      { fee_transfer : Fee_transfer.t; new_accounts : Account_id.t list }
+      { fee_transfer : Fee_transfer.t With_status.t
+      ; new_accounts : Account_id.t list
+      ; burned_tokens : Currency.Amount.t
+      }
     [@@deriving sexp]
   end
 
   module Coinbase_applied : sig
     type t = Transaction_applied.Coinbase_applied.t =
-      { coinbase : Coinbase.t; new_accounts : Account_id.t list }
+      { coinbase : Coinbase.t With_status.t
+      ; new_accounts : Account_id.t list
+      ; burned_tokens : Currency.Amount.t
+      }
     [@@deriving sexp]
   end
 
@@ -166,6 +172,10 @@ module Transaction_applied : sig
     { previous_hash : Ledger_hash.t; varying : Varying.t }
   [@@deriving sexp]
 
+  val burned_tokens : t -> Currency.Amount.t
+
+  val supply_increase : t -> Currency.Amount.Signed.t Or_error.t
+
   val transaction : t -> Transaction.t With_status.t
 
   val user_command_status : t -> Transaction_status.t
diff --git a/src/lib/prover/prover.ml b/src/lib/prover/prover.ml
index 54ee7b2b95a..cc68fda48bf 100644
--- a/src/lib/prover/prover.ml
+++ b/src/lib/prover/prover.ml
@@ -79,7 +79,7 @@ module Worker_state = struct
         let chain_state = Blockchain_snark.Blockchain.state chain in
         ( { source = reg chain_state
           ; target = reg next_state
-          ; supply_increase = Currency.Amount.zero
+          ; supply_increase = Currency.Amount.Signed.zero
           ; fee_excess = Fee_excess.zero
           ; sok_digest = Sok_message.Digest.default
           }
diff --git a/src/lib/sgn/sgn.mli b/src/lib/sgn/sgn.mli
index 51b30cf1bb0..7348ee94bcc 100644
--- a/src/lib/sgn/sgn.mli
+++ b/src/lib/sgn/sgn.mli
@@ -11,6 +11,8 @@ module Stable : sig
   end
 end]
 
+type t = Stable.Latest.t = Pos | Neg
+
 val to_field : t -> Field.t
 
 val of_field_exn : Field.t -> t
diff --git a/src/lib/staged_ledger/pre_diff_info.ml b/src/lib/staged_ledger/pre_diff_info.ml
index fe722b41d41..67e213e40fd 100644
--- a/src/lib/staged_ledger/pre_diff_info.ml
+++ b/src/lib/staged_ledger/pre_diff_info.ml
@@ -269,7 +269,8 @@ let get_transaction_data (type c) ~constraint_constants coinbase_parts ~receiver
   { Transaction_data.commands; coinbases; fee_transfers }
 
 let get_individual_info (type c) ~constraint_constants coinbase_parts ~receiver
-    ~coinbase_amount commands completed_works ~(forget : c -> _) =
+    ~coinbase_amount commands completed_works ~(forget : c -> _)
+    ~internal_command_statuses =
   let open Result.Let_syntax in
   let%bind { Transaction_data.commands
            ; coinbases = coinbase_parts
@@ -284,10 +285,11 @@ let get_individual_info (type c) ~constraint_constants coinbase_parts ~receiver
   in
   let%map internal_commands_with_statuses =
     Or_error.try_with (fun () ->
-        List.map internal_commands ~f:(fun cmd ->
+        List.map2_exn internal_commands internal_command_statuses
+          ~f:(fun cmd status ->
             match cmd with
             | Transaction.Coinbase _ | Transaction.Fee_transfer _ ->
-                { With_status.data = cmd; status = Applied }
+                { With_status.data = cmd; status }
             | _ ->
                 (* Caught by [try_with] above, it doesn't matter what we throw. *)
                 assert false ) )
@@ -308,11 +310,11 @@ let generate_statuses (type c) ~constraint_constants coinbase_parts ~receiver
     ~coinbase_amount commands completed_works ~(forget : c -> _)
     ~generate_status =
   let open Result.Let_syntax in
-  let%bind { Transaction_data.commands; _ } =
+  let%bind { Transaction_data.commands; coinbases; fee_transfers } =
     get_transaction_data ~constraint_constants coinbase_parts ~receiver
       ~coinbase_amount commands completed_works ~forget
   in
-  let%map transactions =
+  let%bind transactions =
     Or_error.try_with (fun () ->
         List.map commands ~f:(fun cmd ->
             { With_status.data = cmd.With_status.data
@@ -322,7 +324,18 @@ let generate_statuses (type c) ~constraint_constants coinbase_parts ~receiver
             } ) )
     |> Result.map_error ~f:(fun err -> Error.Unexpected err)
   in
-  transactions
+  (*Order of application is user-commands, coinbase, fee transfers. See [get_individual_info]*)
+  let internal_commands =
+    List.map coinbases ~f:(fun t -> Transaction.Coinbase t)
+    @ List.map fee_transfers ~f:(fun t -> Transaction.Fee_transfer t)
+  in
+  let%map internal_command_statuses =
+    Or_error.try_with (fun () ->
+        List.map internal_commands ~f:(fun cmd ->
+            Or_error.ok_exn (generate_status cmd) ) )
+    |> Result.map_error ~f:(fun err -> Error.Unexpected err)
+  in
+  (transactions, internal_command_statuses)
 
 open Staged_ledger_diff
 
@@ -352,12 +365,16 @@ let compute_statuses (type c)
     let coinbase_parts =
       match t1.coinbase with Zero -> `Zero | One x -> `One x | Two x -> `Two x
     in
-    let%map commands =
+    let%map commands, internal_command_statuses =
       generate_statuses ~constraint_constants ~generate_status coinbase_parts
         ~receiver:coinbase_receiver t1.commands t1.completed_works
         ~coinbase_amount ~forget
     in
-    ( { commands; completed_works = t1.completed_works; coinbase = t1.coinbase }
+    ( { commands
+      ; completed_works = t1.completed_works
+      ; coinbase = t1.coinbase
+      ; internal_command_statuses
+      }
       : _ Pre_diff_two.t )
   in
   let get_statuses_pre_diff_with_at_most_one
@@ -365,7 +382,7 @@ let compute_statuses (type c)
     let coinbase_added =
       match t2.coinbase with Zero -> `Zero | One x -> `One x
     in
-    let%map commands =
+    let%map commands, internal_command_statuses =
       generate_statuses ~constraint_constants ~generate_status coinbase_added
         ~receiver:coinbase_receiver t2.commands t2.completed_works
         ~coinbase_amount ~forget
@@ -374,6 +391,7 @@ let compute_statuses (type c)
       ( { commands
         ; completed_works = t2.completed_works
         ; coinbase = t2.coinbase
+        ; internal_command_statuses
         }
         : _ Pre_diff_one.t )
   in
@@ -408,6 +426,7 @@ let get' (type c)
     in
     get_individual_info coinbase_parts ~receiver:coinbase_receiver t1.commands
       t1.completed_works ~coinbase_amount ~forget
+      ~internal_command_statuses:t1.internal_command_statuses
   in
   let apply_pre_diff_with_at_most_one (t2 : (_, c With_status.t) Pre_diff_one.t)
       =
@@ -416,6 +435,7 @@ let get' (type c)
     in
     get_individual_info coinbase_added ~receiver:coinbase_receiver t2.commands
       t2.completed_works ~coinbase_amount ~forget
+      ~internal_command_statuses:t2.internal_command_statuses
   in
   let%bind () = check_coinbase diff in
   let%bind p1 =
diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml
index dd9189f78a0..37058087cb7 100644
--- a/src/lib/staged_ledger/staged_ledger.ml
+++ b/src/lib/staged_ledger/staged_ledger.ml
@@ -503,9 +503,8 @@ module T = struct
       txn_state_view =
     let open Result.Let_syntax in
     (*TODO: check fee_excess as a result of applying the txns matches with this*)
-    let%bind fee_excess = Transaction.fee_excess s |> to_staged_ledger_or_error
-    and supply_increase =
-      Transaction.supply_increase s |> to_staged_ledger_or_error
+    let%bind fee_excess =
+      Transaction.fee_excess s |> to_staged_ledger_or_error
     in
     let source_merkle_root =
       Ledger.merkle_root ledger |> Frozen_ledger_hash.of_ledger_hash
@@ -517,8 +516,22 @@ module T = struct
       push_coinbase pending_coinbase_stack_state.init_stack s
     in
     let empty_local_state = Mina_state.Local_state.empty () in
-    let%map applied_txn =
-      Ledger.apply_transaction ~constraint_constants ~txn_state_view ledger s
+    let%bind applied_txn =
+      ( match
+          Ledger.apply_transaction ~constraint_constants ~txn_state_view ledger
+            s
+        with
+      | Error e ->
+          Or_error.error_string
+            (sprintf
+               !"Error when applying transaction %{sexp: Transaction.t}: %s"
+               s (Error.to_string_hum e) )
+      | res ->
+          res )
+      |> to_staged_ledger_or_error
+    in
+    let%map supply_increase =
+      Ledger.Transaction_applied.supply_increase applied_txn
       |> to_staged_ledger_or_error
     in
     let target_merkle_root =
@@ -1650,6 +1663,8 @@ module T = struct
               Sequence.to_list_rev res.commands_rev
           ; completed_works = Sequence.to_list_rev res.completed_work_rev
           ; coinbase = to_at_most_one res.coinbase
+          ; internal_command_statuses =
+              [] (*updated later based on application result*)
           } )
     in
     let pre_diff_with_two (res : Resources.t) :
@@ -1659,6 +1674,8 @@ module T = struct
       { commands = Sequence.to_list_rev res.commands_rev
       ; completed_works = Sequence.to_list_rev res.completed_work_rev
       ; coinbase = res.coinbase
+      ; internal_command_statuses =
+          [] (*updated later based on application result*)
       }
     in
     let end_log ((res : Resources.t), (log : Diff_creation_log.t)) =
@@ -2722,6 +2739,7 @@ let%test_module "staged ledger tests" =
                 @@ ( { completed_works = List.take completed_works job_count1
                      ; commands = List.take txns slots
                      ; coinbase = Zero
+                     ; internal_command_statuses = []
                      }
                    , None )
             }
@@ -2731,6 +2749,7 @@ let%test_module "staged ledger tests" =
               ( { completed_works = List.take completed_works job_count1
                 ; commands = List.take txns slots
                 ; coinbase = Zero
+                ; internal_command_statuses = []
                 }
               , Some
                   { completed_works =
@@ -2738,19 +2757,12 @@ let%test_module "staged ledger tests" =
                       else List.drop completed_works job_count1 )
                   ; commands = txns_in_second_diff
                   ; coinbase = Zero
+                  ; internal_command_statuses = []
                   } )
             in
             { diff = compute_statuses ~ledger ~coinbase_amount diff }
       in
-      let empty_diff : Staged_ledger_diff.t =
-        { diff =
-            ( { completed_works = []
-              ; commands = []
-              ; coinbase = Staged_ledger_diff.At_most_two.Zero
-              }
-            , None )
-        }
-      in
+      let empty_diff = Staged_ledger_diff.empty_diff in
       Quickcheck.test gen_at_capacity
         ~sexp_of:
           [%sexp_of:
diff --git a/src/lib/staged_ledger_diff/diff.ml b/src/lib/staged_ledger_diff/diff.ml
index 15e6b3e41b7..0efa4d0e40f 100644
--- a/src/lib/staged_ledger_diff/diff.ml
+++ b/src/lib/staged_ledger_diff/diff.ml
@@ -83,6 +83,7 @@ module Pre_diff_two = struct
         { completed_works : 'a list
         ; commands : 'b list
         ; coinbase : Ft.Stable.V1.t At_most_two.Stable.V1.t
+        ; internal_command_statuses : Transaction_status.Stable.V2.t list
         }
       [@@deriving compare, sexp, yojson]
     end
@@ -92,6 +93,7 @@ module Pre_diff_two = struct
     { completed_works : 'a list
     ; commands : 'b list
     ; coinbase : Ft.t At_most_two.t
+    ; internal_command_statuses : Transaction_status.t list
     }
   [@@deriving compare, sexp, yojson]
 
@@ -99,6 +101,7 @@ module Pre_diff_two = struct
     { completed_works = List.map t.completed_works ~f:f1
     ; commands = List.map t.commands ~f:f2
     ; coinbase = t.coinbase
+    ; internal_command_statuses = t.internal_command_statuses
     }
 end
 
@@ -112,6 +115,7 @@ module Pre_diff_one = struct
         { completed_works : 'a list
         ; commands : 'b list
         ; coinbase : Ft.Stable.V1.t At_most_one.Stable.V1.t
+        ; internal_command_statuses : Transaction_status.Stable.V2.t list
         }
       [@@deriving compare, sexp, yojson]
     end
@@ -121,6 +125,7 @@ module Pre_diff_one = struct
     { completed_works : 'a list
     ; commands : 'b list
     ; coinbase : Ft.t At_most_one.t
+    ; internal_command_statuses : Transaction_status.t list
     }
   [@@deriving compare, sexp, yojson]
 
@@ -128,6 +133,7 @@ module Pre_diff_one = struct
     { completed_works = List.map t.completed_works ~f:f1
     ; commands = List.map t.commands ~f:f2
     ; coinbase = t.coinbase
+    ; internal_command_statuses = t.internal_command_statuses
     }
 end
 
@@ -223,7 +229,11 @@ module With_valid_signatures_and_proofs = struct
 
   let empty_diff : t =
     { diff =
-        ( { completed_works = []; commands = []; coinbase = At_most_two.Zero }
+        ( { completed_works = []
+          ; commands = []
+          ; coinbase = At_most_two.Zero
+          ; internal_command_statuses = []
+          }
         , None )
     }
 
@@ -321,6 +331,7 @@ let validate_commands (t : t)
         { completed_works = d1.completed_works
         ; commands = commands1
         ; coinbase = d1.coinbase
+        ; internal_command_statuses = d1.internal_command_statuses
         }
       in
       let p2 =
@@ -329,6 +340,7 @@ let validate_commands (t : t)
               { Pre_diff_one.completed_works = d2.completed_works
               ; commands = commands2
               ; coinbase = d2.coinbase
+              ; internal_command_statuses = d2.internal_command_statuses
               } )
       in
       ({ diff = (p1, p2) } : With_valid_signatures.t) )
@@ -340,6 +352,7 @@ let forget_proof_checks (d : With_valid_signatures_and_proofs.t) :
     { completed_works = forget_cw d1.completed_works
     ; commands = d1.commands
     ; coinbase = d1.coinbase
+    ; internal_command_statuses = d1.internal_command_statuses
     }
   in
   let p2 =
@@ -348,6 +361,7 @@ let forget_proof_checks (d : With_valid_signatures_and_proofs.t) :
         { completed_works = forget_cw d2.completed_works
         ; commands = d2.commands
         ; coinbase = d2.coinbase
+        ; internal_command_statuses = d2.internal_command_statuses
         } )
   in
   { diff = (p1, p2) }
@@ -362,6 +376,7 @@ let forget_pre_diff_with_at_most_two
         ~f:(With_status.map ~f:User_command.forget_check)
         pre_diff.commands
   ; coinbase = pre_diff.coinbase
+  ; internal_command_statuses = pre_diff.internal_command_statuses
   }
 
 let forget_pre_diff_with_at_most_one
@@ -373,6 +388,7 @@ let forget_pre_diff_with_at_most_one
         ~f:(With_status.map ~f:User_command.forget_check)
         pre_diff.commands
   ; coinbase = pre_diff.coinbase
+  ; internal_command_statuses = pre_diff.internal_command_statuses
   }
 
 let forget (t : With_valid_signatures_and_proofs.t) =
@@ -412,6 +428,10 @@ let net_return
 
 let empty_diff : t =
   { diff =
-      ( { completed_works = []; commands = []; coinbase = At_most_two.Zero }
+      ( { completed_works = []
+        ; commands = []
+        ; coinbase = At_most_two.Zero
+        ; internal_command_statuses = []
+        }
       , None )
   }
diff --git a/src/lib/staged_ledger_diff/diff.mli b/src/lib/staged_ledger_diff/diff.mli
index c6f48faff4f..e6bc7529cae 100644
--- a/src/lib/staged_ledger_diff/diff.mli
+++ b/src/lib/staged_ledger_diff/diff.mli
@@ -36,6 +36,7 @@ module Pre_diff_two : sig
         { completed_works : 'a list
         ; commands : 'b list
         ; coinbase : Coinbase.Fee_transfer.Stable.V1.t At_most_two.Stable.V1.t
+        ; internal_command_statuses : Transaction_status.Stable.V2.t list
         }
       [@@deriving compare, sexp, yojson]
     end
@@ -52,6 +53,7 @@ module Pre_diff_one : sig
         { completed_works : 'a list
         ; commands : 'b list
         ; coinbase : Coinbase.Fee_transfer.Stable.V1.t At_most_one.Stable.V1.t
+        ; internal_command_statuses : Transaction_status.Stable.V2.t list
         }
       [@@deriving compare, sexp, yojson]
     end
diff --git a/src/lib/transaction/transaction.ml b/src/lib/transaction/transaction.ml
index 0c05d815403..f0dbaf26399 100644
--- a/src/lib/transaction/transaction.ml
+++ b/src/lib/transaction/transaction.ml
@@ -76,11 +76,11 @@ let fee_excess : t -> Fee_excess.t Or_error.t = function
   | Coinbase t ->
       Coinbase.fee_excess t
 
-let supply_increase = function
+let expected_supply_increase = function
   | Command _ | Fee_transfer _ ->
       Ok Currency.Amount.zero
   | Coinbase t ->
-      Coinbase.supply_increase t
+      Coinbase.expected_supply_increase t
 
 let public_keys : t -> _ = function
   | Command (Signed_command cmd) ->
diff --git a/src/lib/transaction/transaction_union.ml b/src/lib/transaction/transaction_union.ml
index 0f9c0d53e3f..d8011cfaa14 100644
--- a/src/lib/transaction/transaction_union.ml
+++ b/src/lib/transaction/transaction_union.ml
@@ -102,5 +102,5 @@ let of_transaction : Signed_command.t Transaction.Poly.t -> t = function
 
 let fee_excess (t : t) = Transaction_union_payload.fee_excess t.payload
 
-let supply_increase (t : t) =
-  Transaction_union_payload.supply_increase t.payload
+let expected_supply_increase (t : t) =
+  Transaction_union_payload.expected_supply_increase t.payload
diff --git a/src/lib/transaction_logic/mina_transaction_logic.ml b/src/lib/transaction_logic/mina_transaction_logic.ml
index ce5dce46150..a3c0e43cfaf 100644
--- a/src/lib/transaction_logic/mina_transaction_logic.ml
+++ b/src/lib/transaction_logic/mina_transaction_logic.ml
@@ -87,8 +87,9 @@ module Transaction_applied = struct
     module Stable = struct
       module V2 = struct
         type t =
-          { fee_transfer : Fee_transfer.Stable.V2.t
+          { fee_transfer : Fee_transfer.Stable.V2.t With_status.Stable.V2.t
           ; new_accounts : Account_id.Stable.V2.t list
+          ; burned_tokens : Currency.Amount.Stable.V1.t
           }
         [@@deriving sexp]
 
@@ -102,8 +103,9 @@ module Transaction_applied = struct
     module Stable = struct
       module V2 = struct
         type t =
-          { coinbase : Coinbase.Stable.V1.t
+          { coinbase : Coinbase.Stable.V1.t With_status.Stable.V2.t
           ; new_accounts : Account_id.Stable.V2.t list
+          ; burned_tokens : Currency.Amount.Stable.V1.t
           }
         [@@deriving sexp]
 
@@ -140,6 +142,40 @@ module Transaction_applied = struct
     end
   end]
 
+  let burned_tokens : t -> Currency.Amount.t =
+   fun { varying; _ } ->
+    match varying with
+    | Command _ ->
+        Currency.Amount.zero
+    | Fee_transfer f ->
+        f.burned_tokens
+    | Coinbase c ->
+        c.burned_tokens
+
+  let supply_increase : t -> Currency.Amount.Signed.t Or_error.t =
+   fun t ->
+    let open Or_error.Let_syntax in
+    let burned_tokens = Currency.Amount.Signed.of_unsigned (burned_tokens t) in
+    let txn : Transaction.t =
+      match t.varying with
+      | Command
+          (Signed_command { common = { user_command = { data; _ }; _ }; _ }) ->
+          Command (Signed_command data)
+      | Command (Parties c) ->
+          Command (Parties c.command.data)
+      | Fee_transfer f ->
+          Fee_transfer f.fee_transfer.data
+      | Coinbase c ->
+          Coinbase c.coinbase.data
+    in
+    let%bind expected_supply_increase =
+      Transaction.expected_supply_increase txn
+    in
+    Currency.Amount.Signed.(
+      add (of_unsigned expected_supply_increase) (negate burned_tokens))
+    |> Option.value_map ~default:(Or_error.error_string "overflow") ~f:(fun v ->
+           Ok v )
+
   let transaction_with_status : t -> Transaction.t With_status.t =
    fun { varying; _ } ->
     match varying with
@@ -150,9 +186,9 @@ module Transaction_applied = struct
         With_status.map s.command ~f:(fun c ->
             Transaction.Command (User_command.Parties c) )
     | Fee_transfer f ->
-        { data = Fee_transfer f.fee_transfer; status = Applied }
+        With_status.map f.fee_transfer ~f:(fun f -> Transaction.Fee_transfer f)
     | Coinbase c ->
-        { data = Coinbase c.coinbase; status = Applied }
+        With_status.map c.coinbase ~f:(fun c -> Transaction.Coinbase c)
 
   let user_command_status : t -> Transaction_status.t =
    fun { varying; _ } ->
@@ -162,10 +198,10 @@ module Transaction_applied = struct
         status
     | Command (Parties c) ->
         c.command.status
-    | Fee_transfer _ ->
-        Applied
-    | Coinbase _ ->
-        Applied
+    | Fee_transfer f ->
+        f.fee_transfer.status
+    | Coinbase c ->
+        c.coinbase.status
 end
 
 module type S = sig
@@ -211,13 +247,19 @@ module type S = sig
 
     module Fee_transfer_applied : sig
       type t = Transaction_applied.Fee_transfer_applied.t =
-        { fee_transfer : Fee_transfer.t; new_accounts : Account_id.t list }
+        { fee_transfer : Fee_transfer.t With_status.t
+        ; new_accounts : Account_id.t list
+        ; burned_tokens : Currency.Amount.t
+        }
       [@@deriving sexp]
     end
 
     module Coinbase_applied : sig
       type t = Transaction_applied.Coinbase_applied.t =
-        { coinbase : Coinbase.t; new_accounts : Account_id.t list }
+        { coinbase : Coinbase.t With_status.t
+        ; new_accounts : Account_id.t list
+        ; burned_tokens : Currency.Amount.t
+        }
       [@@deriving sexp]
     end
 
@@ -233,6 +275,10 @@ module type S = sig
       { previous_hash : Ledger_hash.t; varying : Varying.t }
     [@@deriving sexp]
 
+    val burned_tokens : t -> Currency.Amount.t
+
+    val supply_increase : t -> Currency.Amount.Signed.t Or_error.t
+
     val transaction : t -> Transaction.t With_status.t
 
     val user_command_status : t -> Transaction_status.t
@@ -548,9 +594,10 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct
           With_status.map s.command ~f:(fun c ->
               Transaction.Command (User_command.Parties c) )
       | Fee_transfer f ->
-          { data = Fee_transfer f.fee_transfer; status = Applied }
+          With_status.map f.fee_transfer ~f:(fun f ->
+              Transaction.Fee_transfer f )
       | Coinbase c ->
-          { data = Coinbase c.coinbase; status = Applied }
+          With_status.map c.coinbase ~f:(fun c -> Transaction.Coinbase c)
 
     let user_command_status : t -> Transaction_status.t =
      fun { varying; _ } ->
@@ -561,10 +608,10 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct
           status
       | Command (Parties c) ->
           c.command.status
-      | Fee_transfer _ ->
-          Applied
-      | Coinbase _ ->
-          Applied
+      | Fee_transfer f ->
+          f.fee_transfer.status
+      | Coinbase c ->
+          c.coinbase.status
   end
 
   let get_new_accounts action pk =
@@ -575,18 +622,6 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct
     let%map _, account = get_with_location ledger account_id in
     Account.has_locked_tokens ~global_slot account
 
-  let get_user_account_with_location ledger account_id =
-    let open Or_error.Let_syntax in
-    let%bind ((_, acct) as r) = get_with_location ledger account_id in
-    let%map () =
-      check
-        (Option.is_none acct.zkapp)
-        !"Expected account %{sexp: Account_id.t} to be a user account, got a \
-          snapp account."
-        account_id
-    in
-    r
-
   let failure (e : Transaction_status.Failure.t) = e
 
   let incr_balance (acct : Account.t) amt =
@@ -600,9 +635,7 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct
   let pay_fee' ~command ~nonce ~fee_payer ~fee ~ledger ~current_global_slot =
     let open Or_error.Let_syntax in
     (* Fee-payer information *)
-    let%bind location, account =
-      get_user_account_with_location ledger fee_payer
-    in
+    let%bind location, account = get_with_location ledger fee_payer in
     let%bind () =
       match location with
       | `Existing _ ->
@@ -687,6 +720,12 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct
     let%bind fee_payer_location, fee_payer_account =
       pay_fee ~user_command ~signer_pk ~ledger ~current_global_slot
     in
+    let%bind () =
+      if Account.has_permission ~to_:`Send fee_payer_account then Ok ()
+      else
+        Or_error.error_string
+          Transaction_status.Failure.(describe Update_not_permitted_balance)
+    in
     (* Charge the fee. This must happen, whether or not the command itself
        succeeds, to ensure that the network is compensated for processing this
        command.
@@ -712,6 +751,11 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct
           let source_location, source_account =
             get_with_location ledger source |> ok_or_reject
           in
+          let%bind () =
+            if Account.has_permission ~to_:`Set_delegate source_account then
+              Ok ()
+            else Error Transaction_status.Failure.Update_not_permitted_delegate
+          in
           let%bind () =
             match (source_location, receiver_location) with
             | `Existing _, `Existing _ ->
@@ -743,6 +787,10 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct
           let receiver_location, receiver_account =
             get_with_location ledger receiver |> ok_or_reject
           in
+          let%bind () =
+            if Account.has_permission ~to_:`Receive receiver_account then Ok ()
+            else Error Transaction_status.Failure.Update_not_permitted_balance
+          in
           let%bind source_location, source_account =
             let ret =
               if Account_id.equal source receiver then
@@ -797,6 +845,10 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct
                           (Transaction_status.Failure.describe failure) ) )
             else ret
           in
+          let%bind () =
+            if Account.has_permission ~to_:`Send source_account then Ok ()
+            else Error Transaction_status.Failure.Update_not_permitted_balance
+          in
           (* Charge the account creation fee. *)
           let%bind receiver_amount =
             match receiver_location with
@@ -1681,6 +1733,46 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct
   let update_timing_when_no_deduction ~txn_global_slot account =
     validate_timing ~txn_amount:Amount.zero ~txn_global_slot ~account
 
+  let has_permission_to_receive ~ledger receiver_account_id :
+      Account.t
+      * Ledger_intf.account_state
+      * [> `Has_permission_to_receive of bool ] =
+    let init_account = Account.initialize receiver_account_id in
+    match location_of_account ledger receiver_account_id with
+    | None ->
+        (*new account, check that default permissions allow receiving *)
+        ( init_account
+        , `Added
+        , `Has_permission_to_receive
+            (Account.has_permission ~to_:`Receive init_account) )
+    | Some loc -> (
+        match get ledger loc with
+        | None ->
+            ( init_account
+            , `Added
+            , `Has_permission_to_receive
+                (Account.has_permission ~to_:`Receive init_account) )
+        | Some receiver_account ->
+            ( receiver_account
+            , `Existed
+            , `Has_permission_to_receive
+                (Account.has_permission ~to_:`Receive receiver_account) ) )
+
+  let no_failure = []
+
+  let update_failed =
+    [ Transaction_status.Failure.Update_not_permitted_balance ]
+
+  let empty = Transaction_status.Failure.Collection.empty
+
+  let single_failure =
+    Transaction_status.Failure.Collection.of_single_failure
+      Update_not_permitted_balance
+
+  let append_entry f (s : Transaction_status.Failure.Collection.t) :
+      Transaction_status.Failure.Collection.t =
+    match s with [] -> [ f ] | h :: t -> h :: f :: t
+
   let process_fee_transfer t (transfer : Fee_transfer.t) ~modify_balance
       ~modify_timing =
     let open Or_error.Let_syntax in
@@ -1696,53 +1788,85 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct
     match Fee_transfer.to_singles transfer with
     | `One ft ->
         let account_id = Fee_transfer.Single.receiver ft in
-        (* TODO(#4496): Do not use get_or_create here; we should not create a
-           new account before we know that the transaction will go through and
-           thus the creation fee has been paid.
-        *)
-        let%bind action, a, loc = get_or_create t account_id in
-        let new_accounts = get_new_accounts action account_id in
+        let a, action, `Has_permission_to_receive can_receive =
+          has_permission_to_receive ~ledger:t account_id
+        in
         let%bind timing = modify_timing a in
-        let%map balance = modify_balance action account_id a.balance ft.fee in
-        set t loc { a with balance; timing } ;
-        new_accounts
+        let%bind balance = modify_balance action account_id a.balance ft.fee in
+        if can_receive then (
+          let%map _action, a, loc = get_or_create t account_id in
+          let new_accounts = get_new_accounts action account_id in
+          set t loc { a with balance; timing } ;
+          (new_accounts, empty, Currency.Amount.zero) )
+        else Ok ([], single_failure, Currency.Amount.of_fee ft.fee)
     | `Two (ft1, ft2) ->
         let account_id1 = Fee_transfer.Single.receiver ft1 in
-        (* TODO(#4496): Do not use get_or_create here; we should not create a
-           new account before we know that the transaction will go through and
-           thus the creation fee has been paid.
-        *)
-        let%bind action1, a1, l1 = get_or_create t account_id1 in
-        let new_accounts1 = get_new_accounts action1 account_id1 in
+        let a1, action1, `Has_permission_to_receive can_receive1 =
+          has_permission_to_receive ~ledger:t account_id1
+        in
         let account_id2 = Fee_transfer.Single.receiver ft2 in
-        if Account_id.equal account_id1 account_id2 then (
+        if Account_id.equal account_id1 account_id2 then
           let%bind fee = error_opt "overflow" (Fee.add ft1.fee ft2.fee) in
           let%bind timing = modify_timing a1 in
-          let%map balance = modify_balance action1 account_id1 a1.balance fee in
-          set t l1 { a1 with balance; timing } ;
-          new_accounts1 )
+          let%bind balance =
+            modify_balance action1 account_id1 a1.balance fee
+          in
+          if can_receive1 then (
+            let%map _action1, a1, l1 = get_or_create t account_id1 in
+            let new_accounts1 = get_new_accounts action1 account_id1 in
+            set t l1 { a1 with balance; timing } ;
+            (new_accounts1, empty, Currency.Amount.zero) )
+          else
+            (*failure for each fee transfer single*)
+            Ok
+              ( []
+              , append_entry update_failed single_failure
+              , Currency.Amount.of_fee fee )
         else
-          (* TODO(#4496): Do not use get_or_create here; we should not create a
-             new account before we know that the transaction will go through
-             and thus the creation fee has been paid.
-          *)
-          let%bind action2, a2, l2 = get_or_create t account_id2 in
-          let new_accounts2 = get_new_accounts action2 account_id2 in
+          let a2, action2, `Has_permission_to_receive can_receive2 =
+            has_permission_to_receive ~ledger:t account_id2
+          in
           let%bind balance1 =
             modify_balance action1 account_id1 a1.balance ft1.fee
           in
           (*Note: Not updating the timing field of a1 to avoid additional check in transactions snark (check_timing for "receiver"). This is OK because timing rules will not be violated when balance increases and will be checked whenever an amount is deducted from the account. (#5973)*)
           let%bind timing2 = modify_timing a2 in
-          let%map balance2 =
+          let%bind balance2 =
             modify_balance action2 account_id2 a2.balance ft2.fee
           in
-          set t l1 { a1 with balance = balance1 } ;
-          set t l2 { a2 with balance = balance2; timing = timing2 } ;
-          new_accounts1 @ new_accounts2
+          let%bind new_accounts1, failures, burned_tokens1 =
+            if can_receive1 then (
+              let%map _action1, a1, l1 = get_or_create t account_id1 in
+              let new_accounts1 = get_new_accounts action1 account_id1 in
+              set t l1 { a1 with balance = balance1 } ;
+              ( new_accounts1
+              , append_entry no_failure empty
+              , Currency.Amount.zero ) )
+            else Ok ([], single_failure, Currency.Amount.of_fee ft1.fee)
+          in
+          let%bind new_accounts2, failures', burned_tokens2 =
+            if can_receive2 then (
+              let%map _action2, a2, l2 = get_or_create t account_id2 in
+              let new_accounts2 = get_new_accounts action2 account_id2 in
+              set t l2 { a2 with balance = balance2; timing = timing2 } ;
+              ( new_accounts2
+              , append_entry no_failure failures
+              , Currency.Amount.zero ) )
+            else
+              Ok
+                ( []
+                , append_entry update_failed failures
+                , Currency.Amount.of_fee ft2.fee )
+          in
+          let%map burned_tokens =
+            error_opt "burned tokens overflow"
+              (Currency.Amount.add burned_tokens1 burned_tokens2)
+          in
+          (new_accounts1 @ new_accounts2, failures', burned_tokens)
 
   let apply_fee_transfer ~constraint_constants ~txn_global_slot t transfer =
     let open Or_error.Let_syntax in
-    let%map new_accounts =
+    let%map new_accounts, failures, burned_tokens =
       process_fee_transfer t transfer
         ~modify_balance:(fun action _ b f ->
           let%bind amount =
@@ -1753,8 +1877,13 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct
         ~modify_timing:(fun acc ->
           update_timing_when_no_deduction ~txn_global_slot acc )
     in
+    let ft_with_status =
+      if Transaction_status.Failure.Collection.is_empty failures then
+        { With_status.data = transfer; status = Applied }
+      else { data = transfer; status = Failed failures }
+    in
     Transaction_applied.Fee_transfer_applied.
-      { fee_transfer = transfer; new_accounts }
+      { fee_transfer = ft_with_status; new_accounts; burned_tokens }
 
   let apply_coinbase ~constraint_constants ~txn_global_slot t
       (* TODO: Better system needed for making atomic changes. Could use a monad. *)
@@ -1764,10 +1893,12 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct
     let%bind ( receiver_reward
              , new_accounts1
              , transferee_update
-             , transferee_timing_prev ) =
+             , transferee_timing_prev
+             , failures1
+             , burned_tokens1 ) =
       match fee_transfer with
       | None ->
-          return (coinbase_amount, [], None, None)
+          return (coinbase_amount, [], None, None, empty, Currency.Amount.zero)
       | Some ({ receiver_pk = transferee; fee } as ft) ->
           assert (not @@ Public_key.Compressed.equal transferee receiver) ;
           let transferee_id = Coinbase.Fee_transfer.receiver ft in
@@ -1776,36 +1907,37 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct
             error_opt "Coinbase fee transfer too large"
               (Amount.sub coinbase_amount fee)
           in
-          let%bind action, transferee_account, transferee_location =
-            (* TODO(#4496): Do not use get_or_create here; we should not create
-               a new account before we know that the transaction will go
-               through and thus the creation fee has been paid.
-            *)
-            get_or_create t transferee_id
+          let transferee_account, action, `Has_permission_to_receive can_receive
+              =
+            has_permission_to_receive ~ledger:t transferee_id
           in
           let new_accounts = get_new_accounts action transferee_id in
           let%bind timing =
             update_timing_when_no_deduction ~txn_global_slot transferee_account
           in
-          let%map balance =
+          let%bind balance =
             let%bind amount =
               sub_account_creation_fee ~constraint_constants action fee
             in
             add_amount transferee_account.balance amount
           in
-          ( receiver_reward
-          , new_accounts
-          , Some
-              (transferee_location, { transferee_account with balance; timing })
-          , Some transferee_account.timing )
+          if can_receive then
+            let%map _action, transferee_account, transferee_location =
+              get_or_create t transferee_id
+            in
+            ( receiver_reward
+            , new_accounts
+            , Some
+                ( transferee_location
+                , { transferee_account with balance; timing } )
+            , Some transferee_account.timing
+            , append_entry no_failure empty
+            , Currency.Amount.zero )
+          else return (receiver_reward, [], None, None, single_failure, fee)
     in
     let receiver_id = Account_id.create receiver Token_id.default in
-    let%bind action2, receiver_account, receiver_location =
-      (* TODO(#4496): Do not use get_or_create here; we should not create a new
-         account before we know that the transaction will go through and thus
-         the creation fee has been paid.
-      *)
-      get_or_create t receiver_id
+    let receiver_account, action2, `Has_permission_to_receive can_receive =
+      has_permission_to_receive ~ledger:t receiver_id
     in
     let new_accounts2 = get_new_accounts action2 receiver_id in
     (* Note: Updating coinbase receiver timing only if there is no fee transfer. This is so as to not add any extra constraints in transaction snark for checking "receiver" timings. This is OK because timing rules will not be violated when balance increases and will be checked whenever an amount is deducted from the account(#5973)*)
@@ -1819,20 +1951,40 @@ module Make (L : Ledger_intf.S) : S with type ledger := L.t = struct
       | Some _timing ->
           Ok receiver_account.timing
     in
-    let%map receiver_balance =
+    let%bind receiver_balance =
       let%bind amount =
         sub_account_creation_fee ~constraint_constants action2 receiver_reward
       in
       add_amount receiver_account.balance amount
     in
-    set t receiver_location
-      { receiver_account with
-        balance = receiver_balance
-      ; timing = coinbase_receiver_timing
-      } ;
+    let%bind failures, burned_tokens2 =
+      if can_receive then (
+        let%map _action2, receiver_account, receiver_location =
+          get_or_create t receiver_id
+        in
+        set t receiver_location
+          { receiver_account with
+            balance = receiver_balance
+          ; timing = coinbase_receiver_timing
+          } ;
+        (append_entry no_failure failures1, Currency.Amount.zero) )
+      else return (append_entry update_failed failures1, receiver_reward)
+    in
     Option.iter transferee_update ~f:(fun (l, a) -> set t l a) ;
+    let%map burned_tokens =
+      error_opt "burned tokens overflow"
+        (Amount.add burned_tokens1 burned_tokens2)
+    in
+    let coinbase_with_status =
+      if Transaction_status.Failure.Collection.is_empty failures then
+        { With_status.data = cb; status = Applied }
+      else { With_status.data = cb; status = Failed failures }
+    in
     Transaction_applied.Coinbase_applied.
-      { coinbase = cb; new_accounts = new_accounts1 @ new_accounts2 }
+      { coinbase = coinbase_with_status
+      ; new_accounts = new_accounts1 @ new_accounts2
+      ; burned_tokens
+      }
 
   let apply_transaction ~constraint_constants
       ~(txn_state_view : Zkapp_precondition.Protocol_state.View.t) ledger
diff --git a/src/lib/transaction_snark/test/account_timing/account_timing.ml b/src/lib/transaction_snark/test/account_timing/account_timing.ml
index 25bd2425d88..94803dfefc3 100644
--- a/src/lib/transaction_snark/test/account_timing/account_timing.ml
+++ b/src/lib/transaction_snark/test/account_timing/account_timing.ml
@@ -369,7 +369,7 @@ let%test_module "account timing check" =
             failwith "Expected signed user command"
       in
       let state_body_hash = Mina_state.Protocol_state.Body.hash state_body in
-      let sparse_ledger_after, _ =
+      let sparse_ledger_after, txn_applied =
         Mina_ledger.Sparse_ledger.apply_transaction ~constraint_constants
           ~txn_state_view sparse_ledger_before transaction
         |> Or_error.ok_exn
@@ -385,6 +385,10 @@ let%test_module "account timing check" =
         | _ ->
             stack_with_state
       in
+      let supply_increase =
+        Mina_ledger.Ledger.Transaction_applied.supply_increase txn_applied
+        |> Or_error.ok_exn
+      in
       Transaction_snark.check_transaction ~constraint_constants ~sok_message
         ~source:(Mina_ledger.Sparse_ledger.merkle_root sparse_ledger_before)
         ~target:(Mina_ledger.Sparse_ledger.merkle_root sparse_ledger_after)
@@ -393,7 +397,7 @@ let%test_module "account timing check" =
           { 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 = state_body
         ; transaction = validated_transaction
         }
diff --git a/src/lib/transaction_snark/test/transaction_union/transaction_union.ml b/src/lib/transaction_snark/test/transaction_union/transaction_union.ml
index 61aed438838..5c5a9e4a61b 100644
--- a/src/lib/transaction_snark/test/transaction_union/transaction_union.ml
+++ b/src/lib/transaction_snark/test/transaction_union/transaction_union.ml
@@ -1,7 +1,6 @@
 open Core
 open Mina_ledger
 open Currency
-open Snark_params
 open Signature_lib
 open Mina_transaction
 module U = Transaction_snark_tests.Util
@@ -41,17 +40,6 @@ let%test_module "Transaction union tests" =
       let merkle_root t = Frozen_ledger_hash.of_ledger_hash @@ merkle_root t
     end
 
-    let to_preunion (t : Transaction.t) =
-      match t with
-      | Command (Signed_command x) ->
-          `Transaction (Transaction.Command x)
-      | Fee_transfer x ->
-          `Transaction (Fee_transfer x)
-      | Coinbase x ->
-          `Transaction (Coinbase x)
-      | Command (Parties x) ->
-          `Parties x
-
     let of_user_command' (sok_digest : Sok_message.Digest.t) ledger
         (user_command : Signed_command.With_valid_signature.t) init_stack
         pending_coinbase_stack_state state_body handler =
@@ -69,6 +57,7 @@ let%test_module "Transaction union tests" =
         ; block_data = state_body
         }
       in
+      let user_command_supply_increase = Currency.Amount.Signed.zero in
       Async.Thread_safe.block_on_async_exn (fun () ->
           let statement =
             let txn =
@@ -79,8 +68,7 @@ let%test_module "Transaction union tests" =
             Transaction_snark.Statement.Poly.with_empty_local_state ~source
               ~target ~sok_digest
               ~fee_excess:(Or_error.ok_exn (Transaction.fee_excess txn))
-              ~supply_increase:
-                (Or_error.ok_exn (Transaction.supply_increase txn))
+              ~supply_increase:user_command_supply_increase
               ~pending_coinbase_stack_state
           in
           U.T.of_user_command ~init_stack ~statement user_command_in_block
@@ -129,7 +117,7 @@ let%test_module "Transaction union tests" =
             Sparse_ledger.of_ledger_subset_exn ledger
               [ producer_id; receiver_id; other_id ]
           in
-          let sparse_ledger_after, _ =
+          let sparse_ledger_after, applied_transaction =
             Sparse_ledger.apply_transaction
               ~constraint_constants:U.constraint_constants sparse_ledger
               ~txn_state_view:
@@ -137,6 +125,11 @@ let%test_module "Transaction union tests" =
               txn_in_block.transaction
             |> Or_error.ok_exn
           in
+          let supply_increase =
+            Mina_ledger.Ledger.Transaction_applied.supply_increase
+              applied_transaction
+            |> Or_error.ok_exn
+          in
           Transaction_snark.check_transaction txn_in_block
             (unstage (Sparse_ledger.handler sparse_ledger))
             ~constraint_constants:U.constraint_constants
@@ -148,7 +141,7 @@ let%test_module "Transaction union tests" =
             ~init_stack:pending_coinbase_init
             ~pending_coinbase_stack_state:
               { source = source_stack; target = pending_coinbase_stack_target }
-            ~zkapp_account1:None ~zkapp_account2:None )
+            ~zkapp_account1:None ~zkapp_account2:None ~supply_increase )
 
     let%test_unit "coinbase with new state body hash" =
       Test_util.with_randomness 123456789 (fun () ->
@@ -207,100 +200,18 @@ let%test_module "Transaction union tests" =
                 ; target = pending_coinbase_stack_target
                 }
               in
+              let user_command_supply_increase = Currency.Amount.Signed.zero in
               Transaction_snark.check_user_command ~constraint_constants
                 ~sok_message
                 ~source:(Ledger.merkle_root ledger)
                 ~target ~init_stack:pending_coinbase_stack
                 ~pending_coinbase_stack_state
+                ~supply_increase:user_command_supply_increase
                 { transaction = t1; block_data = state_body }
                 (unstage @@ Sparse_ledger.handler sparse_ledger) ) )
 
     let account_fee = Fee.to_int constraint_constants.account_creation_fee
 
-    let test_transaction ~constraint_constants ?txn_global_slot ledger txn =
-      let source = Ledger.merkle_root ledger in
-      let pending_coinbase_stack = Pending_coinbase.Stack.empty in
-      let state_body, state_body_hash =
-        match txn_global_slot with
-        | None ->
-            (state_body, state_body_hash)
-        | Some txn_global_slot ->
-            let state_body =
-              let state =
-                (* NB: The [previous_state_hash] is a dummy, do not use. *)
-                Mina_state.Protocol_state.create
-                  ~previous_state_hash:Tick0.Field.zero ~body:state_body
-              in
-              let consensus_state_at_slot =
-                Consensus.Data.Consensus_state.Value.For_tests
-                .with_global_slot_since_genesis
-                  (Mina_state.Protocol_state.consensus_state state)
-                  txn_global_slot
-              in
-              Mina_state.Protocol_state.(
-                create_value
-                  ~previous_state_hash:(previous_state_hash state)
-                  ~genesis_state_hash:(genesis_state_hash state)
-                  ~blockchain_state:(blockchain_state state)
-                  ~consensus_state:consensus_state_at_slot
-                  ~constants:
-                    (Protocol_constants_checked.value_of_t
-                       Genesis_constants.compiled.protocol ))
-                .body
-            in
-            let state_body_hash =
-              Mina_state.Protocol_state.Body.hash state_body
-            in
-            (state_body, state_body_hash)
-      in
-      let txn_state_view : Zkapp_precondition.Protocol_state.View.t =
-        Mina_state.Protocol_state.Body.view state_body
-      in
-      let mentioned_keys, pending_coinbase_stack_target =
-        let pending_coinbase_stack =
-          Pending_coinbase.Stack.push_state state_body_hash
-            pending_coinbase_stack
-        in
-        match (txn : Transaction.Valid.t) with
-        | Command (Signed_command uc) ->
-            ( Signed_command.accounts_accessed (uc :> Signed_command.t)
-            , pending_coinbase_stack )
-        | Command (Parties _) ->
-            failwith "Parties commands not yet supported"
-        | Fee_transfer ft ->
-            (Fee_transfer.receivers ft, pending_coinbase_stack)
-        | Coinbase cb ->
-            ( Coinbase.accounts_accessed cb
-            , Pending_coinbase.Stack.push_coinbase cb pending_coinbase_stack )
-      in
-      let sok_signer =
-        match to_preunion (Transaction.forget txn) with
-        | `Transaction t ->
-            (Transaction_union.of_transaction t).signer |> Public_key.compress
-        | `Parties c ->
-            Account_id.public_key (Parties.fee_payer c)
-      in
-      let sparse_ledger =
-        Sparse_ledger.of_ledger_subset_exn ledger mentioned_keys
-      in
-      let _applied =
-        Or_error.ok_exn
-        @@ Ledger.apply_transaction ledger ~constraint_constants ~txn_state_view
-             (Transaction.forget txn)
-      in
-      let target = Ledger.merkle_root ledger in
-      let sok_message = Sok_message.create ~fee:Fee.zero ~prover:sok_signer in
-      Transaction_snark.check_transaction ~constraint_constants ~sok_message
-        ~source ~target ~init_stack:pending_coinbase_stack
-        ~pending_coinbase_stack_state:
-          { Transaction_snark.Pending_coinbase_stack_state.source =
-              pending_coinbase_stack
-          ; target = pending_coinbase_stack_target
-          }
-        ~zkapp_account1:None ~zkapp_account2:None
-        { transaction = txn; block_data = state_body }
-        (unstage @@ Sparse_ledger.handler sparse_ledger)
-
     let%test_unit "account creation fee - user commands" =
       Test_util.with_randomness 123456789 (fun () ->
           let wallets = U.Wallet.random_wallets ~n:3 () |> Array.to_list in
@@ -325,7 +236,6 @@ let%test_module "Transaction union tests" =
                   ~f:(fun (nonce, txns) receiver ->
                     let uc =
                       U.Wallet.user_command ~fee_payer:sender
-                        ~source_pk:(Account.public_key sender.account)
                         ~receiver_pk:(Account.public_key receiver.account)
                         amount (Fee.of_int txn_fee) nonce memo
                     in
@@ -336,7 +246,7 @@ let%test_module "Transaction union tests" =
                 sender.account ;
               let () =
                 List.iter ucs ~f:(fun uc ->
-                    test_transaction ~constraint_constants ledger
+                    U.test_transaction_union ledger
                       (Transaction.Command (Signed_command uc)) )
               in
               List.iter receivers ~f:(fun receiver ->
@@ -378,7 +288,7 @@ let%test_module "Transaction union tests" =
               let () =
                 List.iter fts ~f:(fun ft ->
                     let txn = Mina_transaction.Transaction.Fee_transfer ft in
-                    test_transaction ~constraint_constants ledger txn )
+                    U.test_transaction_union ledger txn )
               in
               List.iter receivers ~f:(fun receiver ->
                   U.check_balance
@@ -421,7 +331,7 @@ let%test_module "Transaction union tests" =
               let () =
                 List.iter cbs ~f:(fun cb ->
                     let txn = Mina_transaction.Transaction.Coinbase cb in
-                    test_transaction ~constraint_constants ledger txn )
+                    U.test_transaction_union ledger txn )
               in
               let fees = fee * ft_count in
               U.check_balance
@@ -658,8 +568,8 @@ let%test_module "Transaction union tests" =
     let create_account pk token balance =
       Account.create (Account_id.create pk token) (Balance.of_int balance)
 
-    let test_user_command_with_accounts ~constraint_constants ~ledger ~accounts
-        ~signer ~fee ~fee_payer_pk ~fee_token ?memo ?valid_until ?nonce body =
+    let test_user_command_with_accounts ~ledger ~accounts ~signer ~fee
+        ~fee_payer_pk ~fee_token ?memo ?valid_until ?nonce body =
       let memo =
         match memo with
         | Some memo ->
@@ -697,8 +607,7 @@ let%test_module "Transaction union tests" =
       in
       let signer = Signature_lib.Keypair.of_private_key_exn signer in
       let user_command = Signed_command.sign signer payload in
-      test_transaction ~constraint_constants ledger
-        (Command (Signed_command user_command)) ;
+      U.test_transaction_union ledger (Command (Signed_command user_command)) ;
       let fee_payer = Signed_command.Payload.fee_payer payload in
       let source = Signed_command.Payload.source payload in
       let receiver = Signed_command.Payload.receiver payload in
@@ -739,7 +648,7 @@ let%test_module "Transaction union tests" =
                   let ( `Fee_payer_account fee_payer_account
                       , `Source_account source_account
                       , `Receiver_account receiver_account ) =
-                    test_user_command_with_accounts ~constraint_constants ~ledger
+                    test_user_command_with_accounts ~ledger
                       ~accounts ~signer ~fee ~fee_payer_pk ~fee_token
                       (Payment { source_pk; receiver_pk; amount })
                   in
@@ -777,7 +686,7 @@ let%test_module "Transaction union tests" =
                   let ( `Fee_payer_account fee_payer_account
                       , `Source_account source_account
                       , `Receiver_account receiver_account ) =
-                    test_user_command_with_accounts ~constraint_constants ~ledger
+                    test_user_command_with_accounts ~ledger
                       ~accounts ~signer ~fee ~fee_payer_pk ~fee_token
                       (Payment { source_pk; receiver_pk; amount })
                   in
@@ -927,8 +836,8 @@ let%test_module "Transaction union tests" =
               let ( `Fee_payer_account fee_payer_account
                   , `Source_account source_account
                   , `Receiver_account receiver_account ) =
-                test_user_command_with_accounts ~constraint_constants ~ledger
-                  ~accounts ~signer ~fee ~fee_payer_pk ~fee_token
+                test_user_command_with_accounts ~ledger ~accounts ~signer ~fee
+                  ~fee_payer_pk ~fee_token
                   (Stake_delegation
                      (Set_delegate
                         { delegator = source_pk; new_delegate = receiver_pk } )
@@ -967,8 +876,8 @@ let%test_module "Transaction union tests" =
               let ( `Fee_payer_account fee_payer_account
                   , `Source_account source_account
                   , `Receiver_account receiver_account ) =
-                test_user_command_with_accounts ~constraint_constants ~ledger
-                  ~accounts ~signer ~fee ~fee_payer_pk ~fee_token
+                test_user_command_with_accounts ~ledger ~accounts ~signer ~fee
+                  ~fee_payer_pk ~fee_token
                   (Stake_delegation
                      (Set_delegate
                         { delegator = source_pk; new_delegate = receiver_pk } )
@@ -1037,8 +946,8 @@ let%test_module "Transaction union tests" =
                 sender.account ;
               let () =
                 List.iter ucs ~f:(fun uc ->
-                    test_transaction ~constraint_constants ~txn_global_slot
-                      ledger (Transaction.Command (Signed_command uc)) )
+                    U.test_transaction_union ~txn_global_slot ledger
+                      (Transaction.Command (Signed_command uc)) )
               in
               List.iter receivers ~f:(fun receiver ->
                   U.check_balance
@@ -1991,6 +1900,532 @@ let%test_module "Transaction union tests" =
               (* well over the vesting period, the timing field shouldn't change*)
               let txn_global_slot = Mina_numbers.Global_slot.of_int 100 in
               List.iter transactions ~f:(fun txn ->
-                  test_transaction ~txn_global_slot ~constraint_constants ledger
-                    txn ) ) )
+                  U.test_transaction_union ~txn_global_slot ledger txn ) ) )
+  end )
+
+let%test_module "legacy transactions using zkApp accounts" =
+  ( module struct
+    let memo = Signed_command_memo.create_from_string_exn "zkApp-legacy-txns"
+
+    let `VK vk, `Prover _snapp_prover = Lazy.force U.trivial_zkapp
+
+    let account ledger pk =
+      let location =
+        Option.value_exn
+          (Ledger.location_of_account ledger
+             (Account_id.create pk Token_id.default) )
+      in
+      Option.value_exn (Ledger.get ledger location)
+
+    let test_payments ?expected_failure_sender ?expected_failure_receiver
+        ~(new_kp : Signature_lib.Keypair.t)
+        ~(spec : Mina_transaction_logic.For_tests.Transaction_spec.t)
+        ?permissions ledger =
+      let expected_failure_receiver =
+        Option.map expected_failure_receiver ~f:(fun f -> [ f ])
+      in
+      let expected_failure_sender =
+        Option.map expected_failure_sender ~f:(fun f -> [ f ])
+      in
+      let snapp_pk = Signature_lib.Public_key.compress new_kp.public_key in
+      Transaction_snark.For_tests.create_trivial_zkapp_account ?permissions ~vk
+        ~ledger snapp_pk ;
+      let txn_fee = Fee.of_int 1000000 in
+      let amount = 100 in
+      (*send from a zkApp account*)
+      let signed_command1 =
+        let fee_payer =
+          { U.Wallet.private_key = new_kp.private_key
+          ; account = account ledger snapp_pk
+          }
+        in
+        U.Wallet.user_command ~fee_payer ~receiver_pk:spec.receiver amount
+          txn_fee Account.Nonce.zero memo
+      in
+      U.test_transaction_union ?expected_failure:expected_failure_sender ledger
+        (Mina_transaction.Transaction.Command (Signed_command signed_command1)) ;
+      let sender_kp, sender_nonce = spec.sender in
+      (*send to a zkApp account*)
+      let signed_command2 =
+        let source_pk =
+          Signature_lib.Public_key.compress sender_kp.public_key
+        in
+        let fee_payer =
+          { U.Wallet.private_key = sender_kp.private_key
+          ; account = account ledger source_pk
+          }
+        in
+        U.Wallet.user_command ~fee_payer ~receiver_pk:snapp_pk amount txn_fee
+          sender_nonce memo
+      in
+      U.test_transaction_union ?expected_failure:expected_failure_receiver
+        ledger
+        (Mina_transaction.Transaction.Command (Signed_command signed_command2))
+
+    let%test_unit "Successful payments from zkapp accounts- Signature, None" =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        send = Permissions.Auth_required.Signature
+                      ; receive = Permissions.Auth_required.None
+                      }
+                  in
+                  test_payments ?permissions ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
+
+    let%test_unit "Successful payments from zkapp accounts- None,None" =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        send = Permissions.Auth_required.None
+                      ; receive = Permissions.Auth_required.None
+                      }
+                  in
+                  test_payments ?permissions ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
+
+    let%test_unit "Failed payments from zkapp accounts- Proof,None" =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        send = Permissions.Auth_required.Proof
+                      ; receive = Permissions.Auth_required.None
+                      }
+                  in
+                  test_payments ?permissions
+                    ~expected_failure_sender:
+                      Transaction_status.Failure.Update_not_permitted_balance
+                    ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
+
+    let%test_unit "Failed payments from zkapp accounts- Signature,Signature" =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        send = Permissions.Auth_required.Signature
+                      ; receive = Permissions.Auth_required.Signature
+                      }
+                  in
+                  test_payments ?permissions
+                    ~expected_failure_receiver:
+                      Transaction_status.Failure.Update_not_permitted_balance
+                    ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
+
+    let%test_unit "Failed payments from zkapp accounts- Signature,Proof" =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        send = Permissions.Auth_required.Signature
+                      ; receive = Permissions.Auth_required.Proof
+                      }
+                  in
+                  test_payments ?permissions
+                    ~expected_failure_receiver:
+                      Transaction_status.Failure.Update_not_permitted_balance
+                    ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
+
+    let test_delegations ?expected_failure_sender
+        ~(new_kp : Signature_lib.Keypair.t)
+        ~(spec : Mina_transaction_logic.For_tests.Transaction_spec.t)
+        ?permissions ledger =
+      let expected_failure =
+        Option.map expected_failure_sender ~f:(fun f -> [ f ])
+      in
+      let snapp_pk = Signature_lib.Public_key.compress new_kp.public_key in
+      Transaction_snark.For_tests.create_trivial_zkapp_account ?permissions ~vk
+        ~ledger snapp_pk ;
+      let txn_fee = Fee.of_int 1000000 in
+      let sender_kp, sender_nonce = spec.sender in
+      (*Delegator is a zkapp account*)
+      let stake_delegation1 =
+        let fee_payer =
+          { U.Wallet.private_key = new_kp.private_key
+          ; account = account ledger snapp_pk
+          }
+        in
+        U.Wallet.stake_delegation ~fee_payer ~delegate_pk:spec.receiver txn_fee
+          Account.Nonce.zero memo
+      in
+      U.test_transaction_union ?expected_failure ledger
+        (Mina_transaction.Transaction.Command (Signed_command stake_delegation1)) ;
+      (*Delegate is a zkApp account*)
+      let stake_delegation2 =
+        let source_pk =
+          Signature_lib.Public_key.compress sender_kp.public_key
+        in
+        let fee_payer =
+          { U.Wallet.private_key = sender_kp.private_key
+          ; account = account ledger source_pk
+          }
+        in
+        U.Wallet.stake_delegation ~fee_payer ~delegate_pk:snapp_pk txn_fee
+          sender_nonce memo
+      in
+      U.test_transaction_union ledger
+        (Mina_transaction.Transaction.Command (Signed_command stake_delegation2))
+
+    let%test_unit "Successful stake delegations from zkapp accounts- Signature"
+        =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        set_delegate = Permissions.Auth_required.Signature
+                      }
+                  in
+                  test_delegations ?permissions ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
+
+    let%test_unit "Successful stake delegations from zkapp accounts- None" =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        set_delegate = Permissions.Auth_required.None
+                      }
+                  in
+                  test_delegations ?permissions ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
+
+    let%test_unit "Failed stake delegation from zkapp accounts- Proof" =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        set_delegate = Permissions.Auth_required.Proof
+                      }
+                  in
+                  test_delegations ?permissions
+                    ~expected_failure_sender:
+                      Transaction_status.Failure.Update_not_permitted_delegate
+                    ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
+
+    let%test_unit "Successful stake delegation from zkapp accounts- \
+                   receive=Proof" =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        receive = Permissions.Auth_required.Proof
+                      }
+                  in
+                  test_delegations ?permissions ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
+
+    let test_coinbase ?expected_failure_fee_receiver
+        ~(new_kp : Signature_lib.Keypair.t)
+        ~(spec : Mina_transaction_logic.For_tests.Transaction_spec.t)
+        ?permissions ledger =
+      let expected_failure =
+        Option.map expected_failure_fee_receiver ~f:(fun f -> [ f ])
+      in
+      let snapp_pk = Signature_lib.Public_key.compress new_kp.public_key in
+      Transaction_snark.For_tests.create_trivial_zkapp_account ?permissions ~vk
+        ~ledger snapp_pk ;
+      let fee = Fee.of_int 1000000 in
+      let amount = U.constraint_constants.coinbase_amount in
+      (*send coinbase reward to a zkApp account*)
+      let coinbase1 =
+        let ft = Coinbase.Fee_transfer.create ~receiver_pk:spec.receiver ~fee in
+        Coinbase.create ~amount ~receiver:snapp_pk ~fee_transfer:(Some ft)
+        |> Or_error.ok_exn
+      in
+      U.test_transaction_union ?expected_failure ledger
+        (Mina_transaction.Transaction.Coinbase coinbase1) ;
+      (*coinbase fee transfer to a zkApp account*)
+      let coinbase2 =
+        let ft = Coinbase.Fee_transfer.create ~receiver_pk:snapp_pk ~fee in
+        Coinbase.create ~amount ~receiver:spec.receiver ~fee_transfer:(Some ft)
+        |> Or_error.ok_exn
+      in
+      U.test_transaction_union ?expected_failure ledger
+        (Mina_transaction.Transaction.Coinbase coinbase2) ;
+      (*coinbase reward and fee transfer to zkApp accounts*)
+      let snapp_pk2 =
+        Quickcheck.random_value Signature_lib.Public_key.Compressed.gen
+      in
+      Transaction_snark.For_tests.create_trivial_zkapp_account ?permissions ~vk
+        ~ledger snapp_pk2 ;
+      let coinbase3 =
+        let ft = Coinbase.Fee_transfer.create ~receiver_pk:snapp_pk ~fee in
+        Coinbase.create ~amount ~receiver:snapp_pk2 ~fee_transfer:(Some ft)
+        |> Or_error.ok_exn
+      in
+      U.test_transaction_union
+        ?expected_failure:
+          (Option.map expected_failure_fee_receiver ~f:(fun f -> [ f; f ]))
+        ledger (Mina_transaction.Transaction.Coinbase coinbase3)
+
+    let%test_unit "Successful coinbase to zkapp accounts" =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        receive = Permissions.Auth_required.None
+                      }
+                  in
+                  test_coinbase ?permissions ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
+
+    let%test_unit "Failed coinbase to zkapp accounts- with proof auth" =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        receive = Permissions.Auth_required.Proof
+                      }
+                  in
+                  test_coinbase ?permissions
+                    ~expected_failure_fee_receiver:
+                      Transaction_status.Failure.Update_not_permitted_balance
+                    ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
+
+    let%test_unit "Failed coinbase to zkapp accounts- with signature Auth" =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        receive = Permissions.Auth_required.Signature
+                      }
+                  in
+                  test_coinbase ?permissions
+                    ~expected_failure_fee_receiver:
+                      Transaction_status.Failure.Update_not_permitted_balance
+                    ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
+
+    let test_fee_transfers ?expected_failure_fee_receiver
+        ~(new_kp : Signature_lib.Keypair.t)
+        ~(spec : Mina_transaction_logic.For_tests.Transaction_spec.t)
+        ?permissions ledger =
+      let expected_failure =
+        Option.map expected_failure_fee_receiver ~f:(fun f -> [ f ])
+      in
+      let snapp_pk = Signature_lib.Public_key.compress new_kp.public_key in
+      Transaction_snark.For_tests.create_trivial_zkapp_account ?permissions ~vk
+        ~ledger snapp_pk ;
+      let fee = U.constraint_constants.account_creation_fee in
+      (*send first one to a zkApp account*)
+      let ft1, ft2 =
+        let single1 =
+          Fee_transfer.Single.create ~receiver_pk:snapp_pk ~fee
+            ~fee_token:Token_id.default
+        in
+        let single2 =
+          Fee_transfer.Single.create ~receiver_pk:spec.receiver ~fee
+            ~fee_token:Token_id.default
+        in
+        ( Fee_transfer.create single1 (Some single2) |> Or_error.ok_exn
+        , Fee_transfer.create single1 None |> Or_error.ok_exn )
+      in
+      List.iter [ ft1; ft2 ] ~f:(fun ft ->
+          U.test_transaction_union ?expected_failure ledger
+            (Mina_transaction.Transaction.Fee_transfer ft) ) ;
+      (*send the second one to a zkApp account*)
+      let ft3, ft4 =
+        let single1 =
+          Fee_transfer.Single.create ~receiver_pk:spec.receiver ~fee
+            ~fee_token:Token_id.default
+        in
+        let single2 =
+          Fee_transfer.Single.create ~receiver_pk:snapp_pk ~fee
+            ~fee_token:Token_id.default
+        in
+        ( Fee_transfer.create single1 (Some single2) |> Or_error.ok_exn
+        , Fee_transfer.create single1 None |> Or_error.ok_exn )
+      in
+      U.test_transaction_union ?expected_failure ledger
+        (Mina_transaction.Transaction.Fee_transfer ft3) ;
+      U.test_transaction_union ledger
+        (Mina_transaction.Transaction.Fee_transfer ft4) ;
+      (*send the both to zkApp accounts*)
+      let snapp_pk2 =
+        Quickcheck.random_value Signature_lib.Public_key.Compressed.gen
+      in
+      Transaction_snark.For_tests.create_trivial_zkapp_account ?permissions ~vk
+        ~ledger snapp_pk2 ;
+      let ft5 =
+        let single1 =
+          Fee_transfer.Single.create ~receiver_pk:snapp_pk ~fee
+            ~fee_token:Token_id.default
+        in
+        let single2 =
+          Fee_transfer.Single.create ~receiver_pk:snapp_pk2 ~fee
+            ~fee_token:Token_id.default
+        in
+        Fee_transfer.create single1 (Some single2) |> Or_error.ok_exn
+      in
+      U.test_transaction_union
+        ?expected_failure:
+          (Option.map expected_failure_fee_receiver ~f:(fun f -> [ f; f ]))
+        ledger (Mina_transaction.Transaction.Fee_transfer ft5)
+
+    let%test_unit "Successful fee transfers to zkapp accounts" =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        receive = Permissions.Auth_required.None
+                      }
+                  in
+                  test_fee_transfers ?permissions ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
+
+    let%test_unit "Failed fee transfers to zkapp accounts- with proof auth" =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        receive = Permissions.Auth_required.Proof
+                      }
+                  in
+                  test_fee_transfers ?permissions
+                    ~expected_failure_fee_receiver:
+                      Transaction_status.Failure.Update_not_permitted_balance
+                    ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
+
+    let%test_unit "Failed fee transfers to zkapp accounts- with signature Auth"
+        =
+      let open Mina_transaction_logic.For_tests in
+      Quickcheck.test ~trials:5 U.gen_snapp_ledger
+        ~f:(fun ({ init_ledger; specs }, new_kp) ->
+          Ledger.with_ledger ~depth:U.ledger_depth ~f:(fun ledger ->
+              Async.Thread_safe.block_on_async_exn (fun () ->
+                  Init_ledger.init
+                    (module Ledger.Ledger_inner)
+                    init_ledger ledger ;
+                  let spec = List.hd_exn specs in
+                  let permissions =
+                    Some
+                      { Permissions.user_default with
+                        receive = Permissions.Auth_required.Signature
+                      }
+                  in
+                  test_fee_transfers ?permissions
+                    ~expected_failure_fee_receiver:
+                      Transaction_status.Failure.Update_not_permitted_balance
+                    ~new_kp ~spec ledger ;
+                  Async.Deferred.return () ) ) )
   end )
diff --git a/src/lib/transaction_snark/test/util.ml b/src/lib/transaction_snark/test/util.ml
index 15df59a11d7..3ff3630b2a1 100644
--- a/src/lib/transaction_snark/test/util.ml
+++ b/src/lib/transaction_snark/test/util.ml
@@ -346,7 +346,8 @@ module Wallet = struct
     in
     Array.init n ~f:(fun _ -> random_wallet ())
 
-  let user_command ~fee_payer ~source_pk ~receiver_pk amt fee nonce memo =
+  let user_command ~fee_payer ~receiver_pk amt fee nonce memo =
+    let source_pk = Account.public_key fee_payer.account in
     let payload : Signed_command.Payload.t =
       Signed_command.Payload.create ~fee
         ~fee_payer_pk:(Account.public_key fee_payer.account)
@@ -362,12 +363,31 @@ module Wallet = struct
         }
     |> Option.value_exn
 
+  let stake_delegation ~fee_payer ~delegate_pk fee nonce memo =
+    let source_pk = Account.public_key fee_payer.account in
+    let payload : Signed_command.Payload.t =
+      Signed_command.Payload.create ~fee
+        ~fee_payer_pk:(Account.public_key fee_payer.account)
+        ~nonce ~memo ~valid_until:None
+        ~body:
+          (Stake_delegation
+             (Set_delegate { delegator = source_pk; new_delegate = delegate_pk })
+          )
+    in
+    let signature = Signed_command.sign_payload fee_payer.private_key payload in
+    Signed_command.check
+      Signed_command.Poly.Stable.Latest.
+        { payload
+        ; signer = Public_key.of_private_key_exn fee_payer.private_key
+        ; signature
+        }
+    |> Option.value_exn
+
   let user_command_with_wallet wallets ~sender:i ~receiver:j amt fee nonce memo
       =
     let fee_payer = wallets.(i) in
     let receiver = wallets.(j) in
     user_command ~fee_payer
-      ~source_pk:(Account.public_key fee_payer.account)
       ~receiver_pk:(Account.public_key receiver.account)
       amt fee nonce memo
 end
@@ -392,3 +412,145 @@ let check_balance pk balance ledger =
   let loc = Ledger.location_of_account ledger pk |> Option.value_exn in
   let acc = Ledger.get ledger loc |> Option.value_exn in
   [%test_eq: Balance.t] acc.balance (Balance.of_int balance)
+
+(** Test legacy transactions*)
+let test_transaction_union ?expected_failure ?txn_global_slot ledger txn =
+  let open Mina_transaction in
+  let to_preunion (t : Transaction.t) =
+    match t with
+    | Command (Signed_command x) ->
+        `Transaction (Transaction.Command x)
+    | Fee_transfer x ->
+        `Transaction (Fee_transfer x)
+    | Coinbase x ->
+        `Transaction (Coinbase x)
+    | Command (Parties x) ->
+        `Parties x
+  in
+  let source = Ledger.merkle_root ledger in
+  let pending_coinbase_stack = Pending_coinbase.Stack.empty in
+  let txn_unchecked = Transaction.forget txn in
+  let state_body, state_body_hash =
+    match txn_global_slot with
+    | None ->
+        (genesis_state_body, genesis_state_body_hash)
+    | Some txn_global_slot ->
+        let state_body =
+          let state =
+            (* NB: The [previous_state_hash] is a dummy, do not use. *)
+            Mina_state.Protocol_state.create
+              ~previous_state_hash:Snark_params.Tick0.Field.zero
+              ~body:genesis_state_body
+          in
+          let consensus_state_at_slot =
+            Consensus.Data.Consensus_state.Value.For_tests
+            .with_global_slot_since_genesis
+              (Mina_state.Protocol_state.consensus_state state)
+              txn_global_slot
+          in
+          Mina_state.Protocol_state.(
+            create_value
+              ~previous_state_hash:(previous_state_hash state)
+              ~genesis_state_hash:(genesis_state_hash state)
+              ~blockchain_state:(blockchain_state state)
+              ~consensus_state:consensus_state_at_slot
+              ~constants:
+                (Protocol_constants_checked.value_of_t
+                   Genesis_constants.compiled.protocol ))
+            .body
+        in
+        let state_body_hash = Mina_state.Protocol_state.Body.hash state_body in
+        (state_body, state_body_hash)
+  in
+  let txn_state_view : Zkapp_precondition.Protocol_state.View.t =
+    Mina_state.Protocol_state.Body.view state_body
+  in
+  let mentioned_keys, pending_coinbase_stack_target =
+    let pending_coinbase_stack =
+      Pending_coinbase.Stack.push_state state_body_hash pending_coinbase_stack
+    in
+    match txn_unchecked with
+    | Command (Signed_command uc) ->
+        ( Signed_command.accounts_accessed (uc :> Signed_command.t)
+        , pending_coinbase_stack )
+    | Command (Parties _) ->
+        failwith "Parties commands not supported here"
+    | Fee_transfer ft ->
+        (Fee_transfer.receivers ft, pending_coinbase_stack)
+    | Coinbase cb ->
+        ( Coinbase.accounts_accessed cb
+        , Pending_coinbase.Stack.push_coinbase cb pending_coinbase_stack )
+  in
+  let sok_signer =
+    match to_preunion txn_unchecked with
+    | `Transaction t ->
+        (Transaction_union.of_transaction t).signer |> Public_key.compress
+    | `Parties c ->
+        Account_id.public_key (Parties.fee_payer c)
+  in
+  let sparse_ledger =
+    Sparse_ledger.of_ledger_subset_exn ledger mentioned_keys
+  in
+  let expect_snark_failure, applied_transaction =
+    match
+      Ledger.apply_transaction ledger ~constraint_constants ~txn_state_view
+        txn_unchecked
+    with
+    | Ok res ->
+        ( if Option.is_some expected_failure then
+          match Ledger.Transaction_applied.user_command_status res with
+          | Applied ->
+              failwith
+                (sprintf "Expected Ledger.apply_transaction to fail with %s"
+                   (Transaction_status.Failure.describe
+                      (List.hd_exn (Option.value_exn expected_failure)) ) )
+          | Failed f ->
+              assert (
+                List.equal Transaction_status.Failure.equal
+                  (Option.value_exn expected_failure)
+                  (List.concat f) ) ) ;
+        (false, Some res)
+    | Error e ->
+        if Option.is_none expected_failure then
+          failwith
+            (sprintf "Ledger.apply_transaction failed with %s"
+               (Error.to_string_hum e) )
+        else if
+          String.equal (Error.to_string_hum e)
+            (Transaction_status.Failure.describe
+               (List.hd_exn (Option.value_exn expected_failure)) )
+        then ()
+        else
+          failwith
+            (sprintf
+               "Expected Ledger.apply_transaction to fail with %s but failed \
+                with %s"
+               (Transaction_status.Failure.describe
+                  (List.hd_exn (Option.value_exn expected_failure)) )
+               (Error.to_string_hum e) ) ;
+        (true, None)
+  in
+  let target = Ledger.merkle_root ledger in
+  let sok_message = Sok_message.create ~fee:Fee.zero ~prover:sok_signer in
+  let supply_increase =
+    Option.value_map applied_transaction ~default:Amount.Signed.zero
+      ~f:(fun txn ->
+        Ledger.Transaction_applied.supply_increase txn |> Or_error.ok_exn )
+  in
+  match
+    Or_error.try_with (fun () ->
+        Transaction_snark.check_transaction ~constraint_constants ~sok_message
+          ~source ~target ~init_stack:pending_coinbase_stack
+          ~pending_coinbase_stack_state:
+            { Transaction_snark.Pending_coinbase_stack_state.source =
+                pending_coinbase_stack
+            ; target = pending_coinbase_stack_target
+            }
+          ~zkapp_account1:None ~zkapp_account2:None ~supply_increase
+          { transaction = txn; block_data = state_body }
+          (unstage @@ Sparse_ledger.handler sparse_ledger) )
+  with
+  | Error _e ->
+      assert expect_snark_failure
+  | Ok _ ->
+      assert (not expect_snark_failure)
diff --git a/src/lib/transaction_snark/test/util.mli b/src/lib/transaction_snark/test/util.mli
index 7765cc6975d..9e70afa00df 100644
--- a/src/lib/transaction_snark/test/util.mli
+++ b/src/lib/transaction_snark/test/util.mli
@@ -126,13 +126,27 @@ module Wallet : sig
 
   val user_command :
        fee_payer:t
-    -> source_pk:Signature_lib.Public_key.Compressed.t
     -> receiver_pk:Signature_lib.Public_key.Compressed.t
     -> int
     -> Currency.Fee.t
     -> Mina_numbers.Account_nonce.t
     -> Mina_base.Signed_command_memo.t
     -> Mina_base.Signed_command.With_valid_signature.t
+
+  val stake_delegation :
+       fee_payer:t
+    -> delegate_pk:Signature_lib.Public_key.Compressed.t
+    -> Currency.Fee.t
+    -> Mina_numbers.Account_nonce.t
+    -> Mina_base.Signed_command_memo.t
+    -> Mina_base.Signed_command.With_valid_signature.t
 end
 
 val check_balance : Account_id.t -> int -> Ledger.t -> unit
+
+val test_transaction_union :
+     ?expected_failure:Transaction_status.Failure.t list
+  -> ?txn_global_slot:Mina_numbers.Global_slot.t
+  -> Ledger.t
+  -> Mina_transaction.Transaction.Valid.t
+  -> unit
diff --git a/src/lib/transaction_snark/test/zkapp_payments/dune b/src/lib/transaction_snark/test/zkapp_payments/dune
index 87fd9accaff..e7a3faad945 100644
--- a/src/lib/transaction_snark/test/zkapp_payments/dune
+++ b/src/lib/transaction_snark/test/zkapp_payments/dune
@@ -32,6 +32,7 @@
    transaction_snark_tests
    test_util
    mina_transaction_logic
+   mina_transaction
    )
   (library_flags -linkall)
   (inline_tests)
diff --git a/src/lib/transaction_snark/transaction_snark.ml b/src/lib/transaction_snark/transaction_snark.ml
index c4acaf9dfcb..948f4bee443 100644
--- a/src/lib/transaction_snark/transaction_snark.ml
+++ b/src/lib/transaction_snark/transaction_snark.ml
@@ -204,7 +204,7 @@ module Statement = struct
     module V2 = struct
       type t =
         ( Frozen_ledger_hash.Stable.V1.t
-        , Currency.Amount.Stable.V1.t
+        , (Amount.Stable.V1.t, Sgn.Stable.V1.t) Signed_poly.Stable.V1.t
         , Pending_coinbase.Stack_versioned.Stable.V1.t
         , Fee_excess.Stable.V1.t
         , unit
@@ -222,7 +222,7 @@ module Statement = struct
       module V2 = struct
         type t =
           ( Frozen_ledger_hash.Stable.V1.t
-          , Currency.Amount.Stable.V1.t
+          , (Amount.Stable.V1.t, Sgn.Stable.V1.t) Signed_poly.Stable.V1.t
           , Pending_coinbase.Stack_versioned.Stable.V1.t
           , Fee_excess.Stable.V1.t
           , Sok_message.Digest.Stable.V1.t
@@ -236,7 +236,7 @@ module Statement = struct
 
     type var =
       ( Frozen_ledger_hash.var
-      , Currency.Amount.var
+      , Currency.Amount.Signed.var
       , Pending_coinbase.Stack.var
       , Fee_excess.var
       , Sok_message.Digest.Checked.t
@@ -244,7 +244,7 @@ module Statement = struct
       Poly.t
 
     let typ : (var, t) Tick.Typ.t =
-      Poly.typ Frozen_ledger_hash.typ Currency.Amount.typ
+      Poly.typ Frozen_ledger_hash.typ Currency.Amount.Signed.typ
         Pending_coinbase.Stack.typ Fee_excess.typ Sok_message.Digest.typ
         Local_state.typ
 
@@ -254,7 +254,7 @@ module Statement = struct
           [| Sok_message.Digest.to_input sok_digest
            ; Registers.to_input source
            ; Registers.to_input target
-           ; Amount.to_input supply_increase
+           ; Amount.Signed.to_input supply_increase
            ; Fee_excess.to_input fee_excess
           |]
       in
@@ -276,12 +276,15 @@ module Statement = struct
         let%bind fee_excess = Fee_excess.to_input_checked fee_excess in
         let source = Registers.Checked.to_input source
         and target = Registers.Checked.to_input target in
+        let%bind supply_increase =
+          Amount.Signed.Checked.to_input supply_increase
+        in
         let input =
           Array.reduce_exn ~f:Random_oracle.Input.Chunked.append
             [| Sok_message.Digest.Checked.to_input sok_digest
              ; source
              ; target
-             ; Amount.var_to_input supply_increase
+             ; supply_increase
              ; fee_excess
             |]
         in
@@ -345,7 +348,7 @@ module Statement = struct
     in
     let%map fee_excess = Fee_excess.combine s1.fee_excess s2.fee_excess
     and supply_increase =
-      Currency.Amount.add s1.supply_increase s2.supply_increase
+      Currency.Amount.Signed.add s1.supply_increase s2.supply_increase
       |> option "Error adding supply_increase"
     and () = registers_check_equal s1.target s2.source in
     ( { source = s1.source
@@ -364,7 +367,7 @@ module Statement = struct
     let%map source = Registers.gen
     and target = Registers.gen
     and fee_excess = Fee_excess.gen
-    and supply_increase = Currency.Amount.gen in
+    and supply_increase = Currency.Amount.Signed.gen in
     ({ source; target; fee_excess; supply_increase; sok_digest = () } : t)
 end
 
@@ -514,8 +517,8 @@ module Base = struct
         to the fee-payer if executing the user command will later fail.
     *)
     type 'bool t =
-      { predicate_failed : 'bool (* All *)
-      ; source_not_present : 'bool (* All *)
+      { predicate_failed : 'bool (* User commands *)
+      ; source_not_present : 'bool (* User commands *)
       ; receiver_not_present : 'bool (* Delegate, Mint_tokens *)
       ; amount_insufficient_to_create : 'bool (* Payment only *)
       ; token_cannot_create : 'bool (* Payment only, token<>default *)
@@ -2147,8 +2150,8 @@ module Base = struct
                statement.target.ledger ) ) ;
       with_label __LOC__ (fun () ->
           run_checked
-            (Amount.Checked.assert_equal statement.supply_increase
-               Amount.(var_of_t zero) ) ) ;
+            (Amount.Signed.Checked.assert_equal statement.supply_increase
+               Amount.(Signed.Checked.of_unsigned (var_of_t zero)) ) ) ;
       with_label __LOC__ (fun () ->
           run_checked
             (let expected = statement.fee_excess in
@@ -2250,6 +2253,20 @@ module Base = struct
         Mina_state.Protocol_state.Body.Value.t Snarky_backendless.Request.t
     | Init_stack : Pending_coinbase.Stack.t Snarky_backendless.Request.t
 
+  let%snarkydef add_burned_tokens acc_burned_tokens amount
+      ~is_coinbase_or_fee_transfer ~update_account =
+    let%bind accumulate_burned_tokens =
+      Boolean.all [ is_coinbase_or_fee_transfer; Boolean.not update_account ]
+    in
+    let%bind amt, `Overflow overflow =
+      Amount.Checked.add_flagged acc_burned_tokens amount
+    in
+    let%bind () =
+      Boolean.(Assert.any [ not accumulate_burned_tokens; not overflow ])
+    in
+    Amount.Checked.if_ accumulate_burned_tokens ~then_:amt
+      ~else_:acc_burned_tokens
+
   let%snarkydef apply_tagged_transaction
       ~(constraint_constants : Genesis_constants.Constraint_constants.t)
       (type shifted)
@@ -2336,7 +2353,7 @@ module Base = struct
       Mina_state.Protocol_state.Body.consensus_state state_body
       |> Consensus.Data.Consensus_state.global_slot_since_genesis_var
     in
-    (* Query user command predicted failure/success. *)
+    (* Query predicted failure/success. *)
     let%bind user_command_failure =
       User_command_failure.compute_as_prover ~constraint_constants
         ~txn_global_slot:current_global_slot txn
@@ -2479,6 +2496,7 @@ module Base = struct
       in
       Boolean.(is_coinbase_or_fee_transfer &&& fee_may_be_charged)
     in
+    let burned_tokens = ref Currency.Amount.(var_of_t zero) in
     let%bind root_after_fee_payer_update =
       [%with_label "Update fee payer"]
         (Frozen_ledger_hash.modify_account_send
@@ -2513,11 +2531,33 @@ module Base = struct
                Receipt.Chain_hash.Checked.if_ is_user_command ~then_:r
                  ~else_:current
              in
+             let permitted_to_send =
+               Account.Checked.has_permission ~to_:`Send account
+             in
+             let permitted_to_receive =
+               Account.Checked.has_permission ~to_:`Receive account
+             in
+             let%bind () =
+               [%with_label
+                 "Fee payer balance update should be permitted for all commands"]
+                 (Boolean.Assert.any
+                    [ Boolean.not is_user_command; permitted_to_send ] )
+             in
+             (*second fee receiver of a fee transfer and fee receiver of a coinbase transaction remain unchanged if
+                1. These accounts are not permitted to receive tokens and,
+                2. Receiver account that corresponds to first fee receiver of a fee transfer or coinbase receiver of a coinbase transaction, doesn't allow receiving tokens*)
+             let%bind update_account =
+               let%bind receiving_allowed =
+                 Boolean.all
+                   [ is_coinbase_or_fee_transfer; permitted_to_receive ]
+               in
+               Boolean.any [ is_user_command; receiving_allowed ]
+             in
              let%bind is_empty_and_writeable =
                (* If this is a coinbase with zero fee, do not create the
                   account, since the fee amount won't be enough to pay for it.
                *)
-               Boolean.(is_empty_and_writeable &&& not is_zero_fee)
+               Boolean.(all [ is_empty_and_writeable; not is_zero_fee ])
              in
              let%bind should_pay_to_create =
                (* Coinbases and fee transfers may create, or we may be creating
@@ -2549,8 +2589,17 @@ module Base = struct
                   Amount.Signed.Checked.(
                     add fee_payer_amount account_creation_fee) )
              in
+             let%bind () =
+               [%with_label "Burned tokens in fee payer"]
+                 (let%map amt =
+                    add_burned_tokens !burned_tokens
+                      (Amount.Checked.of_fee fee)
+                      ~is_coinbase_or_fee_transfer ~update_account
+                  in
+                  burned_tokens := amt )
+             in
              let txn_global_slot = current_global_slot in
-             let%bind `Min_balance _, timing =
+             let%bind timing =
                [%with_label "Check fee payer timing"]
                  (let%bind txn_amount =
                     let%bind sgn = Amount.Signed.Checked.sgn amount in
@@ -2568,12 +2617,20 @@ module Base = struct
                     [%with_label "Check fee payer timed balance"]
                       (Boolean.Assert.is_true ok)
                   in
-                  check_timing ~balance_check ~timed_balance_check ~account
-                    ~txn_amount:(Some txn_amount) ~txn_global_slot )
+                  let%bind `Min_balance _, timing =
+                    check_timing ~balance_check ~timed_balance_check ~account
+                      ~txn_amount:(Some txn_amount) ~txn_global_slot
+                  in
+                  Account_timing.if_ update_account ~then_:timing
+                    ~else_:account.timing )
              in
              let%bind balance =
                [%with_label "Check payer balance"]
-                 (Balance.Checked.add_signed_amount account.balance amount)
+                 (let%bind updated_balance =
+                    Balance.Checked.add_signed_amount account.balance amount
+                  in
+                  Balance.Checked.if_ update_account ~then_:updated_balance
+                    ~else_:account.balance )
              in
              let%map public_key =
                Public_key.Compressed.Checked.if_ is_empty_and_writeable
@@ -2630,6 +2687,7 @@ module Base = struct
          Amount.Checked.sub base_amount coinbase_receiver_fee )
     in
     let receiver_overflow = ref Boolean.false_ in
+    let receiver_balance_update_permitted = ref Boolean.true_ in
     let%bind root_after_receiver_update =
       [%with_label "Update receiver"]
         (Frozen_ledger_hash.modify_account_recv
@@ -2643,6 +2701,20 @@ module Base = struct
                 - the receiver for a coinbase
                 - the first receiver for a fee transfer
              *)
+             let permitted_to_receive =
+               Account.Checked.has_permission ~to_:`Receive account
+             in
+             (*Account remains unchanged if balance update is not permitted for payments, fee_transfers and coinbase transactions*)
+             let%bind payment_or_internal_command =
+               Boolean.any [ is_payment; is_coinbase_or_fee_transfer ]
+             in
+             let%bind update_account =
+               Boolean.any
+                 [ Boolean.not payment_or_internal_command
+                 ; permitted_to_receive
+                 ]
+             in
+             receiver_balance_update_permitted := permitted_to_receive ;
              let%bind is_empty_failure =
                let%bind must_not_be_empty =
                  Boolean.(is_stake_delegation ||| is_mint_tokens)
@@ -2654,11 +2726,8 @@ module Base = struct
                  (Boolean.Assert.( = ) is_empty_failure
                     user_command_failure.receiver_not_present )
              in
-             let is_empty_and_writeable =
-               (* is_empty_and_writable && not is_empty_failure *)
-               Boolean.Unsafe.of_cvar
-               @@ Field.Var.(
-                    sub (is_empty_and_writeable :> t) (is_empty_failure :> t))
+             let%bind is_empty_and_writeable =
+               Boolean.(all [ is_empty_and_writeable; not is_empty_failure ])
              in
              let%bind should_pay_to_create =
                Boolean.(is_empty_and_writeable &&& not is_create_account)
@@ -2743,12 +2812,29 @@ module Base = struct
                Balance.Checked.if_ overflow ~then_:account.balance
                  ~else_:balance
              in
+             let%bind () =
+               [%with_label "Burned tokens in receiver"]
+                 (let%map amt =
+                    add_burned_tokens !burned_tokens receiver_increase
+                      ~is_coinbase_or_fee_transfer
+                      ~update_account:permitted_to_receive
+                  in
+                  burned_tokens := amt )
+             in
              let%bind user_command_fails =
                Boolean.(!receiver_overflow ||| user_command_fails)
              in
              let%bind is_empty_and_writeable =
-               (* Do not create a new account if the user command will fail. *)
-               Boolean.(is_empty_and_writeable &&& not user_command_fails)
+               (* Do not create a new account if the user command will fail or if receiving is not permitted *)
+               Boolean.all
+                 [ is_empty_and_writeable
+                 ; Boolean.not user_command_fails
+                 ; update_account
+                 ]
+             in
+             let%bind balance =
+               Balance.Checked.if_ update_account ~then_:balance
+                 ~else_:account.balance
              in
              let%bind may_delegate =
                (* Only default tokens may participate in delegation. *)
@@ -2839,13 +2925,45 @@ module Base = struct
                     (assert_r1cs not_fee_payer_is_source num_failures
                        num_failures ) )
              in
+             let permitted_to_update_delegate =
+               Account.Checked.has_permission ~to_:`Set_delegate account
+             in
+             let permitted_to_send =
+               Account.Checked.has_permission ~to_:`Send account
+             in
+             let permitted_to_receive =
+               Account.Checked.has_permission ~to_:`Receive account
+             in
+             (*Account remains unchanged if not permitted to send, receive, or set delegate*)
+             let%bind payment_permitted =
+               Boolean.all
+                 [ is_payment
+                 ; permitted_to_send
+                 ; !receiver_balance_update_permitted
+                 ]
+             in
+             let%bind update_account =
+               let%bind delegation_permitted =
+                 Boolean.all
+                   [ is_stake_delegation; permitted_to_update_delegate ]
+               in
+               let%bind fee_receiver_update_permitted =
+                 Boolean.all
+                   [ is_coinbase_or_fee_transfer; permitted_to_receive ]
+               in
+               Boolean.any
+                 [ payment_permitted
+                 ; delegation_permitted
+                 ; fee_receiver_update_permitted
+                 ]
+             in
              let%bind amount =
                (* Only payments should affect the balance at this stage. *)
-               if_ is_payment ~typ:Amount.typ ~then_:payload.body.amount
+               if_ payment_permitted ~typ:Amount.typ ~then_:payload.body.amount
                  ~else_:Amount.(var_of_t zero)
              in
              let txn_global_slot = current_global_slot in
-             let%bind `Min_balance _, timing =
+             let%bind timing =
                [%with_label "Check source timing"]
                  (let balance_check ok =
                     [%with_label
@@ -2867,8 +2985,12 @@ module Base = struct
                        Boolean.Assert.( = ) not_ok
                          user_command_failure.source_bad_timing )
                   in
-                  check_timing ~balance_check ~timed_balance_check ~account
-                    ~txn_amount:(Some amount) ~txn_global_slot )
+                  let%bind `Min_balance _, timing =
+                    check_timing ~balance_check ~timed_balance_check ~account
+                      ~txn_amount:(Some amount) ~txn_global_slot
+                  in
+                  Account_timing.if_ update_account ~then_:timing
+                    ~else_:account.timing )
              in
              let%bind balance, `Underflow underflow =
                Balance.Checked.sub_amount_flagged account.balance amount
@@ -2882,7 +3004,10 @@ module Base = struct
                     user_command_failure.source_insufficient_balance )
              in
              let%map delegate =
-               Public_key.Compressed.Checked.if_ is_stake_delegation
+               let%bind may_delegate =
+                 Boolean.all [ is_stake_delegation; update_account ]
+               in
+               Public_key.Compressed.Checked.if_ may_delegate
                  ~then_:(Account_id.Checked.public_key receiver)
                  ~else_:account.delegate
              in
@@ -2938,8 +3063,19 @@ module Base = struct
              ~else_:user_command_excess )
     in
     let%bind supply_increase =
-      Amount.Checked.if_ is_coinbase ~then_:payload.body.amount
-        ~else_:Amount.(var_of_t zero)
+      [%with_label "Calculate supply increase"]
+        (let%bind expected_supply_increase =
+           Amount.Signed.Checked.if_ is_coinbase
+             ~then_:(Amount.Signed.Checked.of_unsigned payload.body.amount)
+             ~else_:Amount.(Signed.Checked.of_unsigned (var_of_t zero))
+         in
+         let%bind amt, `Overflow overflow =
+           Amount.Signed.Checked.(
+             add_flagged expected_supply_increase
+               (negate (of_unsigned !burned_tokens)))
+         in
+         let%map () = Boolean.Assert.is_true (Boolean.not overflow) in
+         amt )
     in
     let%map final_root =
       (* Ensure that only the fee-payer was charged if this was an invalid user
@@ -2969,7 +3105,7 @@ module Base = struct
         l1 : Frozen_ledger_hash.t,
         l2 : Frozen_ledger_hash.t,
         fee_excess : Amount.Signed.t,
-        supply_increase : Amount.t
+        supply_increase : Amount.Signed.t
         pc: Pending_coinbase_stack_state.t
   *)
   let%snarkydef main ~constraint_constants
@@ -3027,7 +3163,7 @@ module Base = struct
       [ [%with_label "equal roots"]
           (Frozen_ledger_hash.assert_equal root_after statement.target.ledger)
       ; [%with_label "equal supply_increases"]
-          (Currency.Amount.Checked.assert_equal supply_increase
+          (Currency.Amount.Signed.Checked.assert_equal supply_increase
              statement.supply_increase )
       ; [%with_label "equal fee excesses"]
           (Fee_excess.assert_equal_checked fee_excess statement.fee_excess)
@@ -3064,7 +3200,7 @@ end
 module Transition_data = struct
   type t =
     { proof : Proof_type.t
-    ; supply_increase : Amount.t
+    ; supply_increase : (Amount.t, Sgn.t) Signed_poly.t
     ; fee_excess : Fee_excess.t
     ; sok_digest : Sok_message.Digest.t
     ; pending_coinbase_stack_state : Pending_coinbase_stack_state.t
@@ -3126,7 +3262,7 @@ module Merge = struct
          Boolean.Assert.is_true valid_pending_coinbase_stack_transition )
     in
     let%bind supply_increase =
-      Amount.Checked.add s1.supply_increase s2.supply_increase
+      Amount.Signed.Checked.add s1.supply_increase s2.supply_increase
     in
     let%bind () =
       make_checked (fun () ->
@@ -3140,7 +3276,8 @@ module Merge = struct
         [ [%with_label "equal fee excesses"]
             (Fee_excess.assert_equal_checked fee_excess s.fee_excess)
         ; [%with_label "equal supply increases"]
-            (Amount.Checked.assert_equal supply_increase s.supply_increase)
+            (Amount.Signed.Checked.assert_equal supply_increase
+               s.supply_increase )
         ; [%with_label "equal source ledger hashes"]
             (Frozen_ledger_hash.assert_equal s.source.ledger s1.source.ledger)
         ; [%with_label "equal target, source ledger hashes"]
@@ -3273,17 +3410,16 @@ module type S = sig
     t -> t -> sok_digest:Sok_message.Digest.t -> t Async.Deferred.Or_error.t
 end
 
-let check_transaction_union ?(preeval = false) ~constraint_constants sok_message
-    source target init_stack pending_coinbase_stack_state transaction state_body
-    handler =
+let check_transaction_union ?(preeval = false) ~constraint_constants
+    ~supply_increase sok_message source target init_stack
+    pending_coinbase_stack_state transaction state_body handler =
   if preeval then failwith "preeval currently disabled" ;
   let sok_digest = Sok_message.digest sok_message in
   let handler =
     Base.transaction_union_handler handler transaction state_body init_stack
   in
   let statement : Statement.With_sok.t =
-    Statement.Poly.with_empty_local_state ~source ~target
-      ~supply_increase:(Transaction_union.supply_increase transaction)
+    Statement.Poly.with_empty_local_state ~source ~target ~supply_increase
       ~pending_coinbase_stack_state
       ~fee_excess:(Transaction_union.fee_excess transaction)
       ~sok_digest
@@ -3303,7 +3439,7 @@ let check_transaction_union ?(preeval = false) ~constraint_constants sok_message
 
 let check_transaction ?preeval ~constraint_constants ~sok_message ~source
     ~target ~init_stack ~pending_coinbase_stack_state ~zkapp_account1:_
-    ~zkapp_account2:_
+    ~zkapp_account2:_ ~supply_increase
     (transaction_in_block : Transaction.Valid.t Transaction_protocol_state.t)
     handler =
   let transaction =
@@ -3314,22 +3450,23 @@ let check_transaction ?preeval ~constraint_constants ~sok_message ~source
   | `Parties _ ->
       failwith "Called non-party transaction with parties transaction"
   | `Transaction t ->
-      check_transaction_union ?preeval ~constraint_constants sok_message source
-        target init_stack pending_coinbase_stack_state
+      check_transaction_union ?preeval ~constraint_constants ~supply_increase
+        sok_message source target init_stack pending_coinbase_stack_state
         (Transaction_union.of_transaction t)
         state_body handler
 
 let check_user_command ~constraint_constants ~sok_message ~source ~target
-    ~init_stack ~pending_coinbase_stack_state t_in_block handler =
+    ~init_stack ~pending_coinbase_stack_state ~supply_increase t_in_block
+    handler =
   let user_command = Transaction_protocol_state.transaction t_in_block in
   check_transaction ~constraint_constants ~sok_message ~source ~target
     ~init_stack ~pending_coinbase_stack_state ~zkapp_account1:None
-    ~zkapp_account2:None
+    ~zkapp_account2:None ~supply_increase
     { t_in_block with transaction = Command (Signed_command user_command) }
     handler
 
 let generate_transaction_union_witness ?(preeval = false) ~constraint_constants
-    sok_message source target transaction_in_block init_stack
+    ~supply_increase sok_message source target transaction_in_block init_stack
     pending_coinbase_stack_state handler =
   if preeval then failwith "preeval currently disabled" ;
   let transaction =
@@ -3341,8 +3478,7 @@ let generate_transaction_union_witness ?(preeval = false) ~constraint_constants
     Base.transaction_union_handler handler transaction state_body init_stack
   in
   let statement : Statement.With_sok.t =
-    Statement.Poly.with_empty_local_state ~source ~target
-      ~supply_increase:(Transaction_union.supply_increase transaction)
+    Statement.Poly.with_empty_local_state ~source ~target ~supply_increase
       ~pending_coinbase_stack_state
       ~fee_excess:(Transaction_union.fee_excess transaction)
       ~sok_digest
@@ -3355,7 +3491,7 @@ let generate_transaction_union_witness ?(preeval = false) ~constraint_constants
 
 let generate_transaction_witness ?preeval ~constraint_constants ~sok_message
     ~source ~target ~init_stack ~pending_coinbase_stack_state ~zkapp_account1:_
-    ~zkapp_account2:_
+    ~zkapp_account2:_ ~supply_increase
     (transaction_in_block : Transaction.Valid.t Transaction_protocol_state.t)
     handler =
   match
@@ -3367,7 +3503,7 @@ let generate_transaction_witness ?preeval ~constraint_constants ~sok_message
       failwith "Called non-party transaction with parties transaction"
   | `Transaction t ->
       generate_transaction_union_witness ?preeval ~constraint_constants
-        sok_message source target
+        ~supply_increase sok_message source target
         { transaction_in_block with
           transaction = Transaction_union.of_transaction t
         }
@@ -3960,7 +4096,7 @@ let parties_witnesses_exn ~constraint_constants ~state_body ~fee_excess ledger
                   ; ledger = Sparse_ledger.merkle_root target_local.ledger
                   }
               }
-          ; supply_increase = Amount.zero
+          ; supply_increase = Amount.Signed.zero
           ; fee_excess
           ; sok_digest = Sok_message.Digest.default
           }
diff --git a/src/lib/transaction_snark/transaction_snark.mli b/src/lib/transaction_snark/transaction_snark.mli
index 51f084dfcac..136e294077f 100644
--- a/src/lib/transaction_snark/transaction_snark.mli
+++ b/src/lib/transaction_snark/transaction_snark.mli
@@ -3,6 +3,7 @@ open Mina_base
 open Mina_transaction
 open Snark_params
 open Mina_state
+open Currency
 module Transaction_validator = Transaction_validator
 
 (** For debugging. Logs to stderr the inputs to the top hash. *)
@@ -136,7 +137,7 @@ module Statement : sig
     module V2 : sig
       type t =
         ( Frozen_ledger_hash.Stable.V1.t
-        , Currency.Amount.Stable.V1.t
+        , (Amount.Stable.V1.t, Sgn.Stable.V1.t) Signed_poly.Stable.V1.t
         , Pending_coinbase.Stack_versioned.Stable.V1.t
         , Fee_excess.Stable.V1.t
         , unit
@@ -152,7 +153,7 @@ module Statement : sig
       module V2 : sig
         type t =
           ( Frozen_ledger_hash.Stable.V1.t
-          , Currency.Amount.Stable.V1.t
+          , (Amount.Stable.V1.t, Sgn.Stable.V1.t) Signed_poly.Stable.V1.t
           , Pending_coinbase.Stack_versioned.Stable.V1.t
           , Fee_excess.Stable.V1.t
           , Sok_message.Digest.Stable.V1.t
@@ -164,7 +165,7 @@ module Statement : sig
 
     type var =
       ( Frozen_ledger_hash.var
-      , Currency.Amount.var
+      , Amount.Signed.var
       , Pending_coinbase.Stack.var
       , Fee_excess.var
       , Sok_message.Digest.Checked.t
@@ -253,6 +254,7 @@ val check_transaction :
   -> pending_coinbase_stack_state:Pending_coinbase_stack_state.t
   -> zkapp_account1:Zkapp_account.t option
   -> zkapp_account2:Zkapp_account.t option
+  -> supply_increase:Amount.Signed.t
   -> Transaction.Valid.t Transaction_protocol_state.t
   -> Tick.Handler.t
   -> unit
@@ -264,6 +266,7 @@ val check_user_command :
   -> target:Frozen_ledger_hash.t
   -> init_stack:Pending_coinbase.Stack.t
   -> pending_coinbase_stack_state:Pending_coinbase_stack_state.t
+  -> supply_increase:Amount.Signed.t
   -> Signed_command.With_valid_signature.t Transaction_protocol_state.t
   -> Tick.Handler.t
   -> unit
@@ -278,6 +281,7 @@ val generate_transaction_witness :
   -> pending_coinbase_stack_state:Pending_coinbase_stack_state.t
   -> zkapp_account1:Zkapp_account.t option
   -> zkapp_account2:Zkapp_account.t option
+  -> supply_increase:Amount.Signed.t
   -> Transaction.Valid.t Transaction_protocol_state.t
   -> Tick.Handler.t
   -> unit
diff --git a/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.ml b/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.ml
index 5fc958bdc24..0a2a44e0fc3 100644
--- a/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.ml
+++ b/src/lib/transaction_snark_scan_state/transaction_snark_scan_state.ml
@@ -105,7 +105,7 @@ module Job_view = struct
                   ; ("amount", Fee.Signed.to_yojson s.fee_excess.fee_excess_r)
                   ]
               ] )
-        ; ("Supply Increase", Currency.Amount.to_yojson s.supply_increase)
+        ; ("Supply Increase", Currency.Amount.Signed.to_yojson s.supply_increase)
         ]
     in
     let job_to_yojson =
@@ -192,7 +192,7 @@ let create_expected_statement ~constraint_constants
   let%bind protocol_state = get_state (fst state_hash) in
   let state_view = Mina_state.Protocol_state.Body.view protocol_state.body in
   let empty_local_state = Mina_state.Local_state.empty () in
-  let%bind after, _ =
+  let%bind after, applied_transaction =
     Or_error.try_with (fun () ->
         Sparse_ledger.apply_transaction ~constraint_constants
           ~txn_state_view:state_view ledger_witness transaction )
@@ -222,7 +222,9 @@ let create_expected_statement ~constraint_constants
         pending_coinbase_with_state
   in
   let%bind fee_excess = Transaction.fee_excess transaction in
-  let%map supply_increase = Transaction.supply_increase transaction in
+  let%map supply_increase =
+    Ledger.Transaction_applied.supply_increase applied_transaction
+  in
   { Transaction_snark.Statement.source =
       { ledger = source_merkle_root
       ; pending_coinbase_stack = statement.source.pending_coinbase_stack
@@ -259,7 +261,7 @@ let completed_work_to_scanable_work (job : job) (fee, current_proof, prover) :
       in
       let%map fee_excess = Fee_excess.combine s.fee_excess s'.fee_excess
       and supply_increase =
-        Amount.add s.supply_increase s'.supply_increase
+        Amount.Signed.add s.supply_increase s'.supply_increase
         |> option "Error adding supply_increases"
       and _valid_pending_coinbase_stack =
         if