Token minting (#5260)

* Carry next_available_token in Sparse_ledger.t

* Track the next_available_token in Blockchain_state.t

* Rename next_available_token to snarked_next_available_token

This makes it clear that the next_available_token is associated with the
snarked ledger, not the staged ledger. Credit to @psteckler for pointing
out the ambiguity.

* Add more informative logging to debug CI failure

* Use [%%versioned: ...] ppx for Sparse_ledger.t

* Disable next_available_token in Statement.gen

* Revert "Disable next_available_token in Statement.gen"

This reverts commit 95d0ee3.

* Log full transitions when there's an error

* Revert "Log full transitions when there's an error"

This reverts commit bf13182.

* Fix error: swap token for new_next_available_token

* Use fold rather than iter with a reference

* Add Create_new_token and Create_token_account commands

* Commit Coda_base.{New_account_payload,New_token_payload}

* Fix nonconsensus build for token account creation

* Enable account creation in the snark

* Allow Create_token_account to create default-token accounts

* Don't increment next_available_token in the snark if the command fails

* Lift curr_global_slot calculation in the profiler into a lazy global

* Remove unnecessary Lazy.force

* Replace mutability with folds

* Name a discarded variable

* Explode _ pattern

* Factor out charge_account_creation_fee_exn in transaction logic

* Use the new token in user command failure for token creation commands

* Give a discarded pattern a descriptive name

* Combine undo branches for Create_new_token, Create_token_account

* Check whether receiver account exists before creating it

* Fix copy/paste typo: receiver -> source

* Explicitly pass next_available_token_after for snarks, to handle failure

* Fix account fallthrough check for source when creating token accounts

* Charge fee-payer in snark for token account creation too

* Disable/defer predicate check for Create_new_token/Create_token_account

* Do not modify account's token_owner field except when creating

* Add unit tests for token/account creation commands

* Add Mint_tokens command

* Add unit tests for token minting

* Check-in minting payload

* Fix copy/paste typo: is_create_account -> is_mint_tokens

* Add Minting_payload in nonconsensus

* Remove unused function is_valid_user_command

src/app/archive/create_schema.sql

@@ -12,7 +12,7 @@ CREATE TABLE snarked_ledger_hashes
 
 CREATE INDEX idx_snarked_ledger_hashes_value ON snarked_ledger_hashes(value);
 
-CREATE TYPE user_command_type AS ENUM ('payment', 'delegation', 'create_account');
+CREATE TYPE user_command_type AS ENUM ('payment', 'delegation', 'create_account', 'mint_tokens');
 
 CREATE TABLE user_commands
 ( id           serial            PRIMARY KEY

src/app/cli/src/tests/coda_worker_testnet.ml

@@ -681,7 +681,10 @@ end = struct
           | Payment payment_payload ->
               ( Public_key.compress user_command.signer
               , payment_payload.receiver_pk )
-          | Stake_delegation _ | Create_new_token _ | Create_token_account _ ->
+          | Stake_delegation _
+          | Create_new_token _
+          | Create_token_account _
+          | Mint_tokens _ ->
               failwith "Expected a list of payments" )
       |> List.unzip
     in

src/lib/coda_base/ledger.mli

@@ -119,6 +119,7 @@ module Undo : sig
         | Stake_delegation of {previous_delegate: Public_key.Compressed.t}
         | Create_new_token of {created_token: Token_id.t}
         | Create_token_account
+        | Mint_tokens
         | Failed
       [@@deriving sexp]
     end

src/lib/coda_base/minting_payload.ml

@@ -0,0 +1,43 @@
+open Core_kernel
+open Import
+
+[%%versioned
+module Stable = struct
+  module V1 = struct
+    type t =
+      { token_id: Token_id.Stable.V1.t
+      ; token_owner_pk: Public_key.Compressed.Stable.V1.t
+      ; receiver_pk: Public_key.Compressed.Stable.V1.t
+      ; amount: Currency.Amount.Stable.V1.t }
+    [@@deriving compare, eq, sexp, hash, yojson]
+
+    let to_latest = Fn.id
+  end
+end]
+
+type t = Stable.Latest.t =
+  { token_id: Token_id.t
+  ; token_owner_pk: Public_key.Compressed.t
+  ; receiver_pk: Public_key.Compressed.t
+  ; amount: Currency.Amount.t }
+[@@deriving compare, eq, sexp, hash, yojson]
+
+let receiver_pk {receiver_pk; _} = receiver_pk
+
+let receiver {token_id; receiver_pk; _} =
+  Account_id.create receiver_pk token_id
+
+let source_pk {token_owner_pk; _} = token_owner_pk
+
+let source {token_id; token_owner_pk; _} =
+  Account_id.create token_owner_pk token_id
+
+let token {token_id; _} = token_id
+
+let gen =
+  let open Quickcheck.Generator.Let_syntax in
+  let%bind token_id = Token_id.gen_non_default in
+  let%bind token_owner_pk = Public_key.Compressed.gen in
+  let%bind receiver_pk = Public_key.Compressed.gen in
+  let%map amount = Currency.Amount.gen in
+  {token_id; token_owner_pk; receiver_pk; amount}

src/lib/coda_base/sparse_ledger.ml

@@ -219,7 +219,7 @@ let apply_user_command_exn ~constraint_constants ~txn_global_slot t
               false
             in
             predicate_result
-        | Payment _ | Stake_delegation _ ->
+        | Payment _ | Stake_delegation _ | Mint_tokens _ ->
             (* TODO(#4554): Hook predicate evaluation in here once implemented. *)
             failwith
               "The fee-payer is not authorised to issue commands for the \
@@ -387,6 +387,36 @@ let apply_user_command_exn ~constraint_constants ~txn_global_slot t
           [ (receiver_idx, receiver_account)
           ; (fee_payer_idx, fee_payer_account)
           ; (source_idx, source_account) ]
+    | Mint_tokens {token_id= token; amount; _} ->
+        assert (not (Token_id.(equal default) token)) ;
+        let receiver_idx = find_index_exn t receiver in
+        let action, receiver_account =
+          get_or_initialize_exn receiver t receiver_idx
+        in
+        assert (action = `Existed) ;
+        let receiver_account =
+          { receiver_account with
+            balance=
+              Balance.add_amount receiver_account.balance amount
+              |> Option.value_exn ?here:None ?error:None ?message:None }
+        in
+        let source_idx = find_index_exn t source in
+        let source_account =
+          let account =
+            if Account_id.equal source receiver then receiver_account
+            else get_exn t source_idx
+          in
+          (* Check that source account exists. *)
+          assert (not Public_key.Compressed.(equal empty account.public_key)) ;
+          (* Check that source account owns the token. *)
+          assert account.token_owner ;
+          { account with
+            timing=
+              Or_error.ok_exn
+              @@ Transaction_logic.validate_timing ~txn_amount:Amount.zero
+                   ~txn_global_slot:current_global_slot ~account }
+        in
+        [(receiver_idx, receiver_account); (source_idx, source_account)]
   in
   try
     let indexed_accounts = compute_updates () in

src/lib/coda_base/token_id.ml

@@ -46,6 +46,8 @@ let gen = gen_ge 1L
 
 let gen_non_default = gen_ge 2L
 
+let gen_with_invalid = gen_ge 0L
+
 let unpack = T.to_bits
 
 include Hashable.Make_binable (Stable.Latest)

src/lib/coda_base/token_id.mli

@@ -51,6 +51,11 @@ val gen : t Quickcheck.Generator.t
 *)
 val gen_non_default : t Quickcheck.Generator.t
 
+(** Generates a random token ID. This may be any value, including [default] or
+    [invalid].
+*)
+val gen_with_invalid : t Quickcheck.Generator.t
+
 val unpack : t -> bool list
 
 include Comparable.S_binable with type t := t

src/lib/coda_base/transaction_logic.ml

@@ -68,6 +68,7 @@ module Undo = struct
                 { previous_delegate: Public_key.Compressed.Stable.V1.t }
             | Create_new_token of {created_token: Token_id.Stable.V1.t}
             | Create_token_account
+            | Mint_tokens
             | Failed
           [@@deriving sexp]
 
@@ -80,6 +81,7 @@ module Undo = struct
         | Stake_delegation of {previous_delegate: Public_key.Compressed.t}
         | Create_new_token of {created_token: Token_id.t}
         | Create_token_account
+        | Mint_tokens
         | Failed
       [@@deriving sexp]
     end
@@ -194,6 +196,7 @@ module type S = sig
           | Stake_delegation of {previous_delegate: Public_key.Compressed.t}
           | Create_new_token of {created_token: Token_id.t}
           | Create_token_account
+          | Mint_tokens
           | Failed
         [@@deriving sexp]
       end
@@ -543,7 +546,7 @@ module Make (L : Ledger_intf) : S with type ledger := L.t = struct
                 false
               in
               return predicate_result
-          | Payment _ | Stake_delegation _ ->
+          | Payment _ | Stake_delegation _ | Mint_tokens _ ->
               (* TODO(#4554): Hook predicate evaluation in here once implemented. *)
               Or_error.errorf
                 "The fee-payer is not authorised to issue commands for the \
@@ -736,6 +739,58 @@ module Make (L : Ledger_intf) : S with type ledger := L.t = struct
           ( located_accounts
           , `Source_timing source_timing
           , Undo.User_command_undo.Body.Create_token_account )
+      | Mint_tokens {token_id= token; amount; _} ->
+          let%bind () =
+            if Token_id.(equal default) token then
+              Or_error.errorf "Cannot mint more of the default token"
+            else return ()
+          in
+          let%bind receiver_location, receiver_account =
+            get_with_location ledger receiver
+          in
+          let%bind () =
+            match receiver_location with
+            | `Existing _ ->
+                return ()
+            | `New ->
+                Or_error.errorf "The receiving account does not exist"
+          in
+          let%bind receiver_account =
+            let%map balance = add_amount receiver_account.balance amount in
+            {receiver_account with balance}
+          in
+          let%map source_location, source_timing, source_account =
+            let%bind location, account =
+              if Account_id.equal source receiver then
+                return (receiver_location, receiver_account)
+              else get_with_location ledger source
+            in
+            let%bind () =
+              match location with
+              | `Existing _ ->
+                  return ()
+              | `New ->
+                  Or_error.errorf "The token owner account does not exist"
+            in
+            let%bind () =
+              if account.token_owner then return ()
+              else
+                Or_error.errorf
+                  !"The claimed token owner %{sexp: Account_id.t} does not \
+                    own the token %{sexp: Token_id.t}"
+                  source token
+            in
+            let source_timing = account.timing in
+            let%map timing =
+              validate_timing ~txn_amount:Amount.zero
+                ~txn_global_slot:current_global_slot ~account
+            in
+            (location, source_timing, {account with timing})
+          in
+          ( [ (receiver_location, receiver_account)
+            ; (source_location, source_account) ]
+          , `Source_timing source_timing
+          , Undo.User_command_undo.Body.Mint_tokens )
     in
     match compute_updates () with
     | Ok (located_accounts, `Source_timing source_timing, undo_body) ->
@@ -1095,6 +1150,37 @@ module Make (L : Ledger_intf) : S with type ledger := L.t = struct
            the [next_available_token] did not change.
         *)
         set_next_available_token ledger next_available_token
+    | Mint_tokens {amount; _}, Mint_tokens ->
+        let receiver =
+          User_command.receiver ~next_available_token user_command
+        in
+        let%bind receiver_location, receiver_account =
+          let%bind location =
+            location_of_account' ledger "receiver" receiver
+          in
+          let%map account = get' ledger "receiver" location in
+          let balance =
+            Option.value_exn (Balance.sub_amount account.balance amount)
+          in
+          (location, {account with balance})
+        in
+        let%map source_location, source_account =
+          let%map location, account =
+            if Account_id.equal source receiver then
+              return (receiver_location, receiver_account)
+            else
+              let%bind location =
+                location_of_account' ledger "source" source
+              in
+              let%map account = get' ledger "source" location in
+              (location, account)
+          in
+          ( location
+          , { account with
+              timing= Option.value ~default:account.timing source_timing } )
+        in
+        set ledger receiver_location receiver_account ;
+        set ledger source_location source_account
     | _, _ ->
         failwith "Undo/command mismatch"
 

src/lib/coda_base/transaction_union_payload.ml

@@ -57,6 +57,12 @@ module Body = struct
         ; receiver_pk
         ; token_id
         ; amount= Currency.Amount.zero }
+    | Mint_tokens {token_id; token_owner_pk; receiver_pk; amount} ->
+        { tag= Tag.Mint_tokens
+        ; source_pk= token_owner_pk
+        ; receiver_pk
+        ; token_id
+        ; amount }
 
   let gen ~fee =
     let open Quickcheck.Generator.Let_syntax in
@@ -81,12 +87,26 @@ module Body = struct
              amount - fee should be defined. In other words,
              amount >= fee *)
             (Amount.of_fee fee, Amount.max_int)
+        | Mint_tokens ->
+            (Amount.zero, Amount.max_int)
       in
       Amount.gen_incl min max
     and source_pk = Public_key.Compressed.gen
     and receiver_pk = Public_key.Compressed.gen
     and token_id =
-      match tag with Payment -> Token_id.gen | _ -> return Token_id.default
+      match tag with
+      | Payment ->
+          Token_id.gen
+      | Stake_delegation ->
+          return Token_id.default
+      | Create_account ->
+          Token_id.gen_with_invalid
+      | Mint_tokens ->
+          Token_id.gen_non_default
+      | Fee_transfer ->
+          return Token_id.default
+      | Coinbase ->
+          return Token_id.default
     in
     {tag; source_pk; receiver_pk; token_id; amount}
 
@@ -211,11 +231,8 @@ let excess (payload : t) : Amount.Signed.t =
   let fee = payload.common.fee in
   let amount = payload.body.amount in
   match tag with
-  | Payment ->
-      Amount.Signed.of_unsigned (Amount.of_fee fee)
-  | Stake_delegation ->
-      Amount.Signed.of_unsigned (Amount.of_fee fee)
-  | Create_account ->
+  | Payment | Stake_delegation | Create_account | Mint_tokens ->
+      (* For all user commands, the fee excess is just the fee. *)
       Amount.Signed.of_unsigned (Amount.of_fee fee)
   | Fee_transfer ->
       Option.value_exn (Amount.add_fee amount fee)
@@ -225,7 +242,8 @@ let excess (payload : t) : Amount.Signed.t =
 
 let fee_excess ({body= {tag; amount; _}; common= {fee_token; fee; _}} : t) =
   match tag with
-  | Payment | Stake_delegation | Create_account ->
+  | Payment | Stake_delegation | Create_account | Mint_tokens ->
+      (* For all user commands, the fee excess is just the fee. *)
       Fee_excess.of_single (fee_token, Fee.Signed.of_unsigned fee)
   | Fee_transfer ->
       let excess =
@@ -241,12 +259,12 @@ let supply_increase (payload : payload) =
   match tag with
   | Coinbase ->
       payload.body.amount
-  | Payment | Stake_delegation | Create_account | Fee_transfer ->
+  | Payment | Stake_delegation | Create_account | Mint_tokens | Fee_transfer ->
       Amount.zero
 
 let next_available_token (payload : payload) tid =
   match payload.body.tag with
-  | Payment | Stake_delegation | Coinbase | Fee_transfer ->
+  | Payment | Stake_delegation | Mint_tokens | Coinbase | Fee_transfer ->
       tid
   | Create_account when Token_id.(equal invalid) payload.body.token_id ->
       (* Creating a new token. *)