COR-1651: Add touch kernel method (#1441)

* implementation of `touch`

Adds definitions and implementation of the `touchTokenAccount` operation
in the token kernel and the block state operations.

The interface in the kernel is

```
touch :: PLTAccount m -> m Bool
```

The return value indicates whether the account already had a token
balance associated (False) or if a zero account balance was newly
created (True).

* `touch` account before `setAccountState`

* extend trace tests

* added changelog entry

* address review

Added a new function `updateTokenAccountState` to Persistent/Account.hs
that deals with updating the token account state table. The function is
then used in Persistent/BlockState.hs abstractions for the persistent
account versions.

* format

* Update concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs

Co-authored-by: Thomas Dinsdale-Young <td202@users.noreply.github.com>

* move updateTokenAccountState to Account.ProtocolLevelTokens

---------

Co-authored-by: drsk <rsk@concordium.com>
Co-authored-by: Thomas Dinsdale-Young <td202@users.noreply.github.com>

Author: 3 people

CHANGELOG.md

@@ -2,10 +2,15 @@
 
 ## Unreleased changes
 
-- Change energy charging to occur as early as possible in the token module.
 - Add P8 -> P9 update.
 - Update GHC version to 9.10.2 (lts-24.0).
 
+- Protocol-level tokens:
+  - Change energy charging to occur as early as possible in the token module.
+  - Added `touch` kernel method. The `touch` method initializes the token state
+    of an account by setting its balance to zero. This method only affects
+    accounts that have no existing state for the token.
+
 ## 9.0.6 (DevNet)
 
 - Protocol-level tokens:

concordium-consensus/src/Concordium/GlobalState/BlockState.hs

@@ -1689,6 +1689,21 @@ class (BlockStateQuery m, PLTQuery (UpdatableBlockState m) (MutableTokenState m)
         GSAccount.TokenAmountDelta ->
         m (Maybe (UpdatableBlockState m))
 
+    -- Touch the token account. This initializes a token account state with a
+    -- balance of zero. This only affects an account if its state for the token
+    -- is empty.
+    --
+    -- Returns nothing, if the account already contained a token account state,
+    -- otherwise the updated block state.
+    bsoTouchTokenAccount ::
+        (PVSupportsPLT (MPV m)) =>
+        UpdatableBlockState m ->
+        -- | The token index to update
+        TokenIndex ->
+        -- | The account to update
+        AccountIndex ->
+        m (Maybe (UpdatableBlockState m))
+
     -- | A snapshot of the block state that can be used to roll back to a previous state.
     type StateSnapshot m
 
@@ -2060,6 +2075,7 @@ instance (Monad (t m), MonadTrans t, BlockStateOperations m) => BlockStateOperat
     bsoSetTokenCirculatingSupply s tokIx = lift . bsoSetTokenCirculatingSupply s tokIx
     bsoCreateToken s = lift . bsoCreateToken s
     bsoUpdateTokenAccountBalance s tokIx accIx = lift . bsoUpdateTokenAccountBalance s tokIx accIx
+    bsoTouchTokenAccount s tokIx = lift . bsoTouchTokenAccount s tokIx
     type StateSnapshot (MGSTrans t m) = StateSnapshot m
     bsoSnapshotState = lift . bsoSnapshotState
     bsoRollback s = lift . bsoRollback s
@@ -2121,6 +2137,7 @@ instance (Monad (t m), MonadTrans t, BlockStateOperations m) => BlockStateOperat
     {-# INLINE bsoSetTokenCirculatingSupply #-}
     {-# INLINE bsoCreateToken #-}
     {-# INLINE bsoUpdateTokenAccountBalance #-}
+    {-# INLINE bsoTouchTokenAccount #-}
     {-# INLINE bsoSetTokenState #-}
     {-# INLINE bsoSuspendValidators #-}
     {-# INLINE bsoSnapshotState #-}

concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs

@@ -427,6 +427,27 @@ updateAccount upd (PAV3 acc) = PAV3 <$> V1.updateAccount upd acc
 updateAccount upd (PAV4 acc) = PAV4 <$> V1.updateAccount upd acc
 updateAccount upd (PAV5 acc) = PAV5 <$> V1.updateAccount upd acc
 
+-- | Apply an update to a token account state.
+updateTokenAccountState ::
+    (AVSupportsPLT av, MonadBlobStore m) =>
+    -- | The token index
+    BlockState.TokenIndex ->
+    -- | How to update the token account state if present (Just) and if not present (Nothing) in the token account state table.
+    (Maybe BlockState.TokenAccountState -> m BlockState.TokenAccountState) ->
+    -- | The account to update
+    PersistentAccount av ->
+    m (PersistentAccount av)
+updateTokenAccountState tokenIx upd (PAV5 acc) =
+    PAV5 <$> case V1.accountTokenStateTable acc of
+        CTrue (Some ref) -> doUpdate ref
+        CTrue Null -> do
+            ref <- refMake BlockState.emptyTokenAccountStateTable
+            doUpdate ref
+  where
+    doUpdate ref = do
+        ref' <- BlockState.updateTokenAccountStateTable ref tokenIx (upd Nothing) (upd . Just)
+        return acc{V1.accountTokenStateTable = CTrue $ Some ref'}
+
 -- | Add or remove credentials on an account.
 --  The caller must ensure the following, which are not checked:
 --

concordium-consensus/src/Concordium/GlobalState/Persistent/Account/ProtocolLevelTokens.hs

@@ -66,6 +66,35 @@ emptyTokenAccountState =
         { tasBalance = TokenRawAmount 0
         }
 
+-- | Helper function to update a reference to a token account state table.
+updateTokenAccountStateTable ::
+    (MonadBlobStore m, Reference m ref TokenAccountStateTable) =>
+    -- | The token account state table to update
+    ref TokenAccountStateTable ->
+    -- | The index of the token in question
+    TokenIndex ->
+    -- | How to create a new token account state if the token doesn't have a token account state associated yet
+    m TokenAccountState ->
+    -- | How to update an existing token account state
+    (TokenAccountState -> m TokenAccountState) ->
+    m (ref TokenAccountStateTable)
+updateTokenAccountStateTable ref tokIx createNewState updateExisting = do
+    TokenAccountStateTable tst <- refLoad ref
+    tst' <-
+        Map.alterF
+            ( \case
+                Nothing -> do
+                    newState <- createNewState
+                    Just <$> refMake newState
+                Just sRef -> do
+                    s <- refLoad sRef
+                    s' <- updateExisting s
+                    Just <$> refMake s'
+            )
+            tokIx
+            tst
+    refMake $ TokenAccountStateTable{tokenAccountStateTable = tst'}
+
 -- | Token state at the account level
 newtype TokenAccountState = TokenAccountState
     { -- | The available balance for the account.

concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs

@@ -58,7 +58,6 @@ import Concordium.GlobalState.Persistent.Account
 import Concordium.GlobalState.Persistent.Account.CooldownQueue (NextCooldownChange (..))
 import qualified Concordium.GlobalState.Persistent.Account.MigrationState as MigrationState
 import Concordium.GlobalState.Persistent.Account.ProtocolLevelTokens
-import qualified Concordium.GlobalState.Persistent.Account.StructureV1 as StructureV1
 import Concordium.GlobalState.Persistent.Accounts (SupportsPersistentAccount)
 import qualified Concordium.GlobalState.Persistent.Accounts as Accounts
 import qualified Concordium.GlobalState.Persistent.Accounts as LMDBAccountMap
@@ -4367,30 +4366,6 @@ doSetTokenState pbs tokenIndex mutableState = do
     newPLTs <- PLT.setTokenState tokenIndex mutableState (bspProtocolLevelTokens bsp)
     storePBS pbs bsp{bspProtocolLevelTokens = newPLTs}
 
--- | Helper function to update a reference to a token account state table.
-updateTokenAccountStateTable ::
-    (Monad m, MonadBlobStore m, Reference m ref TokenAccountStateTable) =>
-    ref TokenAccountStateTable ->
-    PLT.TokenIndex ->
-    (TokenAccountState -> m TokenAccountState) ->
-    m (ref TokenAccountStateTable)
-updateTokenAccountStateTable ref tokIx update = do
-    TokenAccountStateTable tst <- refLoad ref
-    tst' <-
-        Map.alterF
-            ( \case
-                Nothing -> do
-                    newState <- update emptyTokenAccountState
-                    Just <$> refMake newState
-                Just sRef -> do
-                    s <- refLoad sRef
-                    s' <- update s
-                    Just <$> refMake s'
-            )
-            tokIx
-            tst
-    refMake $ TokenAccountStateTable{tokenAccountStateTable = tst'}
-
 -- | Update the token balance.
 doUpdateTokenAccountBalance ::
     forall pv m.
@@ -4405,15 +4380,13 @@ doUpdateTokenAccountBalance pbs tokIx accIx (TokenAmountDelta delta) = runMaybeT
     newAccounts <- Accounts.updateAccountsAtIndex' upd accIx (bspAccounts bsp)
     storePBS pbs bsp{bspAccounts = newAccounts}
   where
-    upd (PAV5 acc) = case StructureV1.accountTokenStateTable acc of
-        CTrue (Some ref) -> doUpdate ref
-        CTrue Null -> do
-            ref <- refMake emptyTokenAccountStateTable
-            doUpdate ref
-      where
-        doUpdate ref = do
-            ref' <- updateTokenAccountStateTable ref tokIx updateBalance
-            return (PAV5 $ acc{StructureV1.accountTokenStateTable = CTrue $ Some ref'})
+    upd =
+        updateTokenAccountState
+            tokIx
+            ( \case
+                Nothing -> updateBalance emptyTokenAccountState
+                Just tas -> updateBalance tas
+            )
 
     updateBalance :: TokenAccountState -> MaybeT m TokenAccountState
     updateBalance tas
@@ -4423,6 +4396,28 @@ doUpdateTokenAccountBalance pbs tokIx accIx (TokenAmountDelta delta) = runMaybeT
       where
         newBalanceInteger = fromIntegral (tasBalance tas) + delta
 
+-- | Touch a token account, i.e. set the balance of the given token to zero if
+--  the account didn't have a balance before.
+doTouchTokenAccount ::
+    forall pv m.
+    (SupportsPersistentState pv m, PVSupportsPLT pv) =>
+    PersistentBlockState pv ->
+    PLT.TokenIndex ->
+    AccountIndex ->
+    m (Maybe (PersistentBlockState pv))
+doTouchTokenAccount pbs tokIx accIx = runMaybeT $ do
+    bsp <- lift $ loadPBS pbs
+    newAccounts <- Accounts.updateAccountsAtIndex' upd accIx (bspAccounts bsp)
+    storePBS pbs bsp{bspAccounts = newAccounts}
+  where
+    upd =
+        updateTokenAccountState
+            tokIx
+            ( \case
+                Nothing -> return emptyTokenAccountState
+                Just _tas -> hoistMaybe Nothing
+            )
+
 -- | Context that supports the persistent block state.
 data PersistentBlockStateContext pv = PersistentBlockStateContext
     { -- | The 'BlobStore' used for storing the persistent state.
@@ -4738,6 +4733,7 @@ instance (IsProtocolVersion pv, PersistentState av pv r m) => BlockStateOperatio
     bsoCreateToken = doCreateToken
     bsoSetTokenState = doSetTokenState
     bsoUpdateTokenAccountBalance = doUpdateTokenAccountBalance
+    bsoTouchTokenAccount = doTouchTokenAccount
     type StateSnapshot (PersistentBlockStateMonad pv r m) = BlockStatePointers pv
     bsoSnapshotState = loadPBS
     bsoRollback = storePBS

concordium-consensus/src/Concordium/Scheduler/EnvironmentImplementation.hs

@@ -652,6 +652,17 @@ instance (BS.BlockStateOperations m, PVSupportsPLT (MPV m)) => PLTKernelUpdate (
         tokenId <- asks (_pltTokenId . _pltecConfiguration)
         plteEvents %= (TokenModuleEvent tokenId eventType eventDetails :)
 
+    touch (accIx, _) = do
+        context <- ask
+        let tokenIx = _pltecTokenIndex context
+        bs0 <- use plteBlockState
+        mbBs1 <- lift $ BS.bsoTouchTokenAccount bs0 tokenIx accIx
+        case mbBs1 of
+            Nothing -> return False
+            Just bs1 -> do
+                plteBlockState .= bs1
+                return True
+
 instance (BS.BlockStateOperations m, PVSupportsPLT (MPV m)) => PLTKernelPrivilegedUpdate (KernelT fail ret m) where
     mint (accIx, accAddr) amount = do
         context <- ask

concordium-consensus/src/Concordium/Scheduler/ProtocolLevelTokens/Kernel.hs

@@ -51,6 +51,15 @@ class (PLTKernelQuery m) => PLTKernelUpdate m where
     -- | Log a token module event with the specified type and details.
     logTokenEvent :: TokenEventType -> TokenEventDetails -> m ()
 
+    -- | Update the balance of the given account to zero if it didn't have a
+    --  balance before.
+    touch ::
+        -- | The account to update
+        PLTAccount m ->
+        -- | Returns 'True' if the balance wasn't present on the given account
+        --  and 'False' otherwise.
+        m Bool
+
 class (PLTKernelUpdate m) => PLTKernelPrivilegedUpdate m where
     -- | Mint a specified amount and deposit it in the specified account.
     --  The return value indicates if this was successful.

concordium-consensus/src/Concordium/Scheduler/ProtocolLevelTokens/Module.hs

@@ -455,6 +455,10 @@ accountStateKey accountIndex subkey = runPut $ do
 -- | Set the value in the account state.
 setAccountState :: (Monad m, PLTKernelUpdate m) => PLTAccount m -> TokenStateKey -> Maybe TokenStateValue -> m ()
 setAccountState account key maybeValue = do
+    -- make sure that the account state contains a balance. Otherwise the
+    -- updated account state might not be displayed in future queries.
+    void $ touch account
+
     accountIndex <- getAccountIndex account
     let accountKey = accountStateKey accountIndex key
     void $ Kernel.setTokenState accountKey maybeValue

concordium-consensus/tests/scheduler/SchedulerTests/TokenModule.hs

@@ -92,6 +92,7 @@ data PLTKernelUpdateCall acct ret where
     SetTokenState :: TokenStateKey -> Maybe TokenStateValue -> PLTKernelUpdateCall acct (Maybe Bool)
     Transfer :: acct -> acct -> TokenRawAmount -> Maybe Memo -> PLTKernelUpdateCall acct Bool
     LogTokenEvent :: TokenEventType -> TokenEventDetails -> PLTKernelUpdateCall acct ()
+    Touch :: acct -> PLTKernelUpdateCall acct Bool
 
 deriving instance (Show acct) => Show (PLTKernelUpdateCall acct ret)
 deriving instance (Eq acct) => Eq (PLTKernelUpdateCall acct ret)
@@ -282,6 +283,7 @@ instance
     setTokenState key mValue = handleEvent $ PLTU $ SetTokenState key mValue
     transfer sender receiver amount mMemo = handleEvent $ PLTU $ Transfer sender receiver amount mMemo
     logTokenEvent eventType details = handleEvent $ PLTU $ LogTokenEvent eventType details
+    touch acc = handleEvent $ PLTU $ Touch acc
 
 instance
     (Eq e, Eq acct, Show e, Show acct, Show ret, Typeable e, Typeable acct, Typeable ret) =>
@@ -1143,6 +1145,7 @@ testLists = do
                             :>>: (PLTQ (GetAccountIndex 0) :-> AccountIndex 0)
                             :>>: (PLTQ (getModuleStateCall (ltcFeature listConf)) :-> Just "")
                             :>>: (PLTQ (GetAccount (dummyAccountAddress 1)) :-> Just 4)
+                            :>>: (PLTU (Touch 4) :-> False)
                             :>>: (PLTQ (GetAccountIndex 4) :-> 4)
                             :>>: (PLTU (setAccountStateCall 4 (ltcFeature listConf) (ltcNewValue listConf)) :-> Just False)
                             :>>: ( PLTU