Merge pull request #243 from Concordium/v1-contract-state

V1 contract state

CHANGELOG.md

@@ -26,7 +26,7 @@
   times a gRPC call can fail and keeps `node-collector` querying forever.
 - `GetAccountInfo` endpoint supports querying the account via the account index.
 - Mac installer: Users now can leave one (but not both) of the net configurations empty
-  when they don't want to configure a node for it. 
+  when they don't want to configure a node for it.
   - On the initial installation, leaving a net configuration empty means that
     the start/stop app shortcuts and the application support folder for that net won't be installed.
 - Implement baker pools and stake delegation for the P4 protocol version.
@@ -40,7 +40,7 @@
     - The mint distribution no longer includes the mint per slot rate.
     - Pool parameters are added, governed by the `poolParameters` keys, that determine
       commission rates and ranges, bounds and other factors affecting baker pools.
-    - Time parameters, governed by `timeParameters`, are added that determine the 
+    - Time parameters, governed by `timeParameters`, are added that determine the
       duration of a payday (in epochs) and the mint rate per payday.
     - Cooldown parameters, governed by `cooldownParameters`, are added that determine
       the required cooldown periods when bakers and delegators reduce their stakes.
@@ -53,6 +53,11 @@
     delegators to the baker's pool, with some commission being paid to the baker.
     Block rewards (i.e. transaction fee rewards), baking rewards and finalization rewards
     are accumulated over the reward period and paid out at the payday.
+- Implement V1 smart contracts with the following key features
+  - unlimited contract state size
+  - synchronous contract calls
+  - fallback entrypoints
+  - increased smart contract module size limit, 512kB
 
 ## concordium-node 3.0.1
 

concordium-consensus/src/Concordium/Afgjort/Finalize.hs

@@ -1062,7 +1062,7 @@ nextFinalizationRecord parentBlock = do
 -- |'ActiveFinalizationM' provides an implementation of 'FinalizationMonad' that
 -- actively participates in finalization.
 newtype ActiveFinalizationM (pv :: ProtocolVersion) r s m a = ActiveFinalizationM {runActiveFinalizationM :: m a}
-    deriving (Functor, Applicative, Monad, MonadState s, MonadReader r, TimerMonad, BlockStateTypes, BlockStateQuery, AccountOperations, BlockStateOperations, BlockStateStorage, BlockPointerMonad, PerAccountDBOperations, TreeStateMonad, SkovMonad, TimeMonad, MonadLogger, MonadIO, FinalizationOutputMonad, SkovQueryMonad)
+    deriving (Functor, Applicative, Monad, MonadState s, MonadReader r, TimerMonad, BlockStateTypes, BlockStateQuery, AccountOperations, ContractStateOperations, BlockStateOperations, BlockStateStorage, BlockPointerMonad, PerAccountDBOperations, TreeStateMonad, SkovMonad, TimeMonad, MonadLogger, MonadIO, FinalizationOutputMonad, SkovQueryMonad)
 
 deriving instance (MonadProtocolVersion m) => MonadProtocolVersion (ActiveFinalizationM pv r s m)
 deriving instance (BlockPointerData (BlockPointerType m)) => GlobalStateTypes (ActiveFinalizationM pv r s m)

concordium-consensus/src/Concordium/GlobalState.hs

@@ -133,6 +133,10 @@ deriving via PureBlockStateMonad pv m
     instance (Monad m, IsProtocolVersion pv)
              => AccountOperations (MemoryBlockStateM pv r g s m)
 
+deriving via PureBlockStateMonad pv m
+    instance Monad m
+             => ContractStateOperations (MemoryBlockStateM pv r g s m)
+
 deriving via PureBlockStateMonad pv m
     instance (Monad m,
               IsProtocolVersion pv,
@@ -153,6 +157,7 @@ deriving via PersistentBlockStateMonad pv
               PersistentBlockStateContext
               (FocusGlobalStateM PersistentBlockStateContext g m)
     instance (MonadIO m,
+              IsProtocolVersion pv,
               BlockStateQuery (PersistentBlockStateMonad pv
                                 PersistentBlockStateContext
                                 (FocusGlobalStateM PersistentBlockStateContext g m)))
@@ -167,6 +172,17 @@ deriving via PersistentBlockStateMonad pv
                                   (FocusGlobalStateM PersistentBlockStateContext g m)))
              => AccountOperations (PersistentBlockStateM pv r g s m)
 
+deriving via PersistentBlockStateMonad pv
+              PersistentBlockStateContext
+              (FocusGlobalStateM PersistentBlockStateContext g m)
+    instance (MonadIO m,
+              IsProtocolVersion pv,
+              ContractStateOperations (PersistentBlockStateMonad pv
+                                        PersistentBlockStateContext
+                                        (FocusGlobalStateM PersistentBlockStateContext g m)))
+             => ContractStateOperations (PersistentBlockStateM pv r g s m)
+
+
 deriving via PersistentBlockStateMonad pv
               PersistentBlockStateContext
               (FocusGlobalStateM PersistentBlockStateContext g m)
@@ -200,7 +216,7 @@ deriving via PersistentBlockStateMonad pv
 -- * If @s@ is 'SkovPersistentData pv ati bs', then the persistent Haskell tree state is used.
 newtype TreeStateM s m a = TreeStateM {runTreeStateM :: m a}
     deriving (Functor, Applicative, Monad, MonadState s, MonadIO, BlockStateTypes, BlockStateQuery,
-            AccountOperations, BlockStateOperations, BlockStateStorage)
+            AccountOperations, BlockStateOperations, BlockStateStorage, ContractStateOperations)
 
 deriving instance MonadProtocolVersion m => MonadProtocolVersion (TreeStateM s m)
 
@@ -287,6 +303,11 @@ deriving via BlockStateM pv c r g s m
               AccountOperations (BlockStateM pv c r g s m))
              => AccountOperations (GlobalStateM pv db c r g s m)
 
+deriving via BlockStateM pv c r g s m
+    instance (Monad m,
+              ContractStateOperations (BlockStateM pv c r g s m))
+             => ContractStateOperations (GlobalStateM pv db c r g s m)
+
 deriving via BlockStateM pv c r g s m
     instance (BlockStateQuery (GlobalStateM pv db c r g s m),
               BlockStateOperations (BlockStateM pv c r g s m))
@@ -502,4 +523,4 @@ instance GlobalStateConfig DiskTreeDiskBlockWithLogConfig where
         closeBlobStore pbscBlobStore
         destroyAllResources (connectionPool transactionLogContext)
         closeSkovPersistentData st
---}
+

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

@@ -2,6 +2,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -44,13 +45,16 @@ import qualified Concordium.GlobalState.Types as GT
 import Concordium.GlobalState.BakerInfo
 import Concordium.GlobalState.Parameters
 import Concordium.GlobalState.AccountTransactionIndex
+import Concordium.GlobalState.ContractStateFFIHelpers
 import Concordium.GlobalState.Basic.BlockState.Bakers
 import qualified Concordium.GlobalState.BlockState as BS
 import Concordium.GlobalState.Basic.BlockState.Account
+import qualified Concordium.Wasm as Wasm
 import qualified Concordium.GlobalState.Wasm as GSWasm
 import qualified Concordium.GlobalState.Basic.BlockState.Accounts as Accounts
 import qualified Concordium.GlobalState.Basic.BlockState.Modules as Modules
 import qualified Concordium.GlobalState.Basic.BlockState.Instances as Instances
+import qualified Concordium.GlobalState.Instance as Instance
 import qualified Concordium.GlobalState.Basic.BlockState.PoolRewards as PoolRewards
 import qualified Concordium.GlobalState.Basic.BlockState.LFMBTree as LFMBT
 import Concordium.GlobalState.CapitalDistribution
@@ -72,6 +76,8 @@ import Concordium.Kontrol.Bakers
 import Concordium.Utils
 import Concordium.Utils.BinarySearch
 import Concordium.Utils.Serialization
+import Concordium.GlobalState.BlockState (InstanceInfoTypeV(iiParameters), UpdatableContractState)
+import qualified Concordium.GlobalState.ContractStateV1 as StateV1
 
 data BasicBirkParameters (av :: AccountVersion) = BasicBirkParameters {
     -- |The active (i.e. currently-registered) bakers.
@@ -224,6 +230,13 @@ getHashedEpochBlocksV0 = do
     blocks <- replicateM numBlocks get
     return $! foldr' consEpochBlock emptyHashedEpochBlocks blocks
 
+-- |Freeze the contract state and compute its hash.
+freeze :: forall v . Wasm.IsWasmVersion v => UpdatableContractState v -> (H.Hash, Instance.InstanceStateV v)
+freeze cs = case Wasm.getWasmVersion @v of
+  Wasm.SV0 -> (getHash cs, Instance.InstanceStateV0 cs)
+  Wasm.SV1 -> let (hsh, persistent) = StateV1.freezeInMemoryPersistent cs
+             in (hsh, Instance.InstanceStateV1 persistent)
+
 data BlockRewardDetails (av :: AccountVersion) where
     BlockRewardDetailsV0 :: !HashedEpochBlocks -> BlockRewardDetails 'AccountV0
     BlockRewardDetailsV1 :: !(Hashed' Rewards.PoolRewardsHash PoolRewards.PoolRewards) -> BlockRewardDetails 'AccountV1
@@ -556,13 +569,25 @@ instance GT.BlockStateTypes (PureBlockStateMonad pv m) where
     type UpdatableBlockState (PureBlockStateMonad pv m) = BlockState pv
     type Account (PureBlockStateMonad pv m) = Account (AccountVersionFor pv)
     type BakerInfoRef (PureBlockStateMonad pv m) = BakerInfoEx (AccountVersionFor pv)
+    type ContractState (PureBlockStateMonad pv m) = Instance.InstanceStateV
 
 instance ATITypes (PureBlockStateMonad pv m) where
   type ATIStorage (PureBlockStateMonad pv m) = ()
 
 instance Monad m => PerAccountDBOperations (PureBlockStateMonad pv m)
   -- default implementation
 
+-- |Retrieve instance information from a basic instance.
+mkInstanceInfo :: Instance.Instance -> BS.InstanceInfoType Instance.InstanceStateV
+mkInstanceInfo = \case (Instance.InstanceV0 inst) -> BS.InstanceInfoV0 (mkInstanceInfoV inst)
+                       (Instance.InstanceV1 inst) -> BS.InstanceInfoV1 (mkInstanceInfoV inst)
+    where mkInstanceInfoV :: Instance.InstanceV v -> BS.InstanceInfoTypeV Instance.InstanceStateV v
+          mkInstanceInfoV Instance.InstanceV{..} = BS.InstanceInfoV{
+            iiParameters = _instanceVParameters,
+            iiState = _instanceVModel,
+            iiBalance = _instanceVAmount
+            }
+
 doGetIndexedAccount ::
     (Monad m, HasBlockState s pv, IsProtocolVersion pv) =>
     s ->
@@ -600,7 +625,8 @@ instance (IsProtocolVersion pv, Monad m) => BS.BlockStateQuery (PureBlockStateMo
         return $ bs ^. blockModules . to (Modules.getInterface mref)
 
     {-# INLINE getContractInstance #-}
-    getContractInstance bs caddr = return (Instances.getInstance caddr (bs ^. blockInstances))
+    getContractInstance bs caddr =
+      return $ mkInstanceInfo <$> Instances.getInstance caddr (bs ^. blockInstances) 
 
     {-# INLINE getAccount #-}
     getAccount = doGetIndexedAccount
@@ -631,7 +657,7 @@ instance (IsProtocolVersion pv, Monad m) => BS.BlockStateQuery (PureBlockStateMo
     getModuleList bs = return $ bs ^. blockModules . to Modules.moduleRefList
 
     {-# INLINE getContractInstanceList #-}
-    getContractInstanceList bs = return (bs ^.. blockInstances . Instances.foldInstances)
+    getContractInstanceList bs = return (map Instance.instanceAddress (bs ^.. blockInstances . Instances.foldInstances))
 
     {-# INLINE getAccountList #-}
     getAccountList bs =
@@ -902,13 +928,25 @@ redelegatePassive (DelegatorId accId) =
                 _ -> error "Invariant violation: active delegator is not a delegation account"
             )
 
+instance Monad m => BS.ContractStateOperations (PureBlockStateMonad pv m) where
+  thawContractState (Instance.InstanceStateV0 st) = return st
+  thawContractState (Instance.InstanceStateV1 st) = return (StateV1.thawInMemoryPersistent st)
+  stateSizeV0 (Instance.InstanceStateV0 cs) = return (Wasm.contractStateSize cs)
+  getV1StateContext = return errorLoadCallback
+  contractStateToByteString (Instance.InstanceStateV0 st) = return (Wasm.contractState st)
+  contractStateToByteString (Instance.InstanceStateV1 st) = return (encode st)
+  {-# INLINE thawContractState #-}
+  {-# INLINE stateSizeV0 #-}
+  {-# INLINE getV1StateContext #-}
+  {-# INLINE contractStateToByteString #-}
+
 instance (IsProtocolVersion pv, Monad m) => BS.BlockStateOperations (PureBlockStateMonad pv m) where
 
     {-# INLINE bsoGetModule #-}
     bsoGetModule bs mref = return $ bs ^. blockModules . to (Modules.getInterface mref)
 
     {-# INLINE bsoGetInstance #-}
-    bsoGetInstance bs caddr = return (Instances.getInstance caddr (bs ^. blockInstances))
+    bsoGetInstance bs caddr = return (mkInstanceInfo <$> Instances.getInstance caddr (bs ^. blockInstances))
 
     {-# INLINE bsoGetAccount #-}
     bsoGetAccount = doGetIndexedAccount
@@ -937,8 +975,39 @@ instance (IsProtocolVersion pv, Monad m) => BS.BlockStateOperations (PureBlockSt
             accounts = bs ^. blockAccounts
             newAccounts = Accounts.putAccountWithRegIds acct accounts
 
-    bsoPutNewInstance bs mkInstance = return (Instances.instanceAddress inst, bs')
+    bsoPutNewInstance :: forall v . Wasm.IsWasmVersion v
+                      => BlockState pv
+                      -> BS.NewInstanceData v
+                      -> PureBlockStateMonad pv m (ContractAddress, BlockState pv)
+    bsoPutNewInstance bs BS.NewInstanceData{..} = return (Instances.instanceAddress inst, bs')
         where
+            mkParams addr = Instance.InstanceParameters {
+              _instanceAddress = addr,
+              instanceOwner = nidOwner,
+              instanceInitName = nidInitName,
+              instanceReceiveFuns = nidEntrypoints,
+              instanceModuleInterface = nidInterface,
+              instanceParameterHash = Instance.makeInstanceParameterHash addr nidOwner (GSWasm.miModuleRef nidInterface) nidInitName 
+              }
+            mkInstance addr = case Wasm.getWasmVersion @v of
+                Wasm.SV0 ->
+                  let params = mkParams addr
+                      (_, state) = freeze nidInitialState
+                  in Instance.InstanceV0 Instance.InstanceV{
+                    _instanceVParameters = params,
+                    _instanceVModel = state,
+                    _instanceVAmount = nidInitialAmount,
+                    _instanceVHash = Instance.makeInstanceHashV0 params state nidInitialAmount
+                    }
+                Wasm.SV1 ->
+                  let params = mkParams addr
+                      (_, state) = freeze nidInitialState
+                  in Instance.InstanceV1 Instance.InstanceV{
+                    _instanceVParameters = params,
+                    _instanceVModel = state,
+                    _instanceVAmount = nidInitialAmount,
+                    _instanceVHash = Instance.makeInstanceHashV1 params state nidInitialAmount
+                    }
             (inst, instances') = Instances.createInstance mkInstance (bs ^. blockInstances)
             bs' = bs
                 -- Add the instance
@@ -950,7 +1019,7 @@ instance (IsProtocolVersion pv, Monad m) => BS.BlockStateOperations (PureBlockSt
           Just mods' -> (True, bs & blockModules .~ mods')
 
     bsoModifyInstance bs caddr delta model = return $!
-        bs & blockInstances %~ Instances.updateInstanceAt caddr delta model
+        bs & blockInstances %~ Instances.updateInstanceAt caddr delta (snd . freeze <$> model)
 
     bsoModifyAccount bs accountUpdates = return $!
         -- Update the account
@@ -1762,6 +1831,9 @@ instance (IsProtocolVersion pv, MonadIO m) => BS.BlockStateStorage (PureBlockSta
     {-# INLINE writeBlockState #-}
     writeBlockState h = PureBlockStateMonad . liftIO . hPutBuilder h . snd . runPutMBuilder . putBlockState . _unhashedBlockState
 
+    {-# INLINE blockStateLoadCallback #-}
+    blockStateLoadCallback = return errorLoadCallback -- basic block state is not written, so it never has to be loaded.
+
 -- |Initial block state.
 initialState :: forall pv
               . IsProtocolVersion pv

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

@@ -1,3 +1,6 @@
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GADTs #-}
 module Concordium.GlobalState.Basic.BlockState.Instances(
     InstanceParameters(..),
     Instance(..),
@@ -7,7 +10,6 @@ module Concordium.GlobalState.Basic.BlockState.Instances(
     Instances,
     emptyInstances,
     getInstance,
-    updateInstance,
     updateInstanceAt,
     updateInstanceAt',
     createInstance,
@@ -39,17 +41,38 @@ getInstance :: ContractAddress -> Instances -> Maybe Instance
 getInstance addr (Instances iss) = iss ^? ix addr
 
 -- |Update the instance at the specified address with an amount delta and
--- potentially a new state. If new state is not provided the state of the
--- instance is not changed. If there is no instance with the given address, this
--- does nothing.
-updateInstanceAt :: ContractAddress -> AmountDelta -> Maybe Wasm.ContractState -> Instances -> Instances
-updateInstanceAt ca amt val (Instances iss) = Instances (iss & ix ca %~ updateInstance amt val)
+-- potentially new state. If new state is not provided the state of the instance
+-- is not changed. If there is no instance with the given address, this does
+-- nothing. If the instance at the given address has a different version than
+-- given this function raises an exception.
+updateInstanceAt :: forall v .Wasm.IsWasmVersion v => ContractAddress -> AmountDelta -> Maybe (InstanceStateV v) -> Instances -> Instances
+updateInstanceAt ca amt val (Instances iss) = Instances (iss & ix ca %~ updateOnlyV)
+    where
+        -- only update if the instance matches the state version. Otherwise raise an exception.
+        updateOnlyV = case Wasm.getWasmVersion @v of
+                          Wasm.SV0 -> \case
+                            InstanceV0 i -> InstanceV0 $ updateInstanceV amt val i
+                            InstanceV1 _ -> error "Expected a V0 instance, but got V1."
+                          Wasm.SV1 -> \case
+                            InstanceV0 _ -> error "Expected a V1 instance, but got V0"
+                            InstanceV1 i -> InstanceV1 $ updateInstanceV amt val i
 
 -- |Update the instance at the specified address with a __new amount__ and
--- potentially a new state. If new state is not provided the state of the instance is not changed. If
--- there is no instance with the given address, this does nothing.
-updateInstanceAt' :: ContractAddress -> Amount -> Maybe Wasm.ContractState -> Instances -> Instances
-updateInstanceAt' ca amt val (Instances iss) = Instances (iss & ix ca %~ updateInstance' amt val)
+-- potentially new state. If new state is not provided the state of the instance
+-- is not changed. If there is no instance with the given address, this does
+-- nothing. If the instance at the given address has a different version than
+-- given this function raises an exception.
+updateInstanceAt' :: forall v . Wasm.IsWasmVersion v => ContractAddress -> Amount -> Maybe (InstanceStateV v) -> Instances -> Instances
+updateInstanceAt' ca amt val (Instances iss) = Instances (iss & ix ca %~ updateOnlyV)
+    where
+        -- only update if the instance matches the state version. Otherwise raise an exception.
+        updateOnlyV = case Wasm.getWasmVersion @v of
+                          Wasm.SV0 -> \case
+                            InstanceV0 i -> InstanceV0 $ updateInstanceV' amt val i
+                            InstanceV1 _ -> error "Expected a V0 instance, but got V1."
+                          Wasm.SV1 -> \case
+                            InstanceV0 _ -> error "Expected a V1 instance, but got V0"
+                            InstanceV1 i -> InstanceV1 $ updateInstanceV' amt val i
 
 -- |Create a new smart contract instance.
 createInstance :: (ContractAddress -> Instance) -> Instances -> (Instance, Instances)

concordium-consensus/src/Concordium/GlobalState/Basic/TreeState.hs

@@ -130,7 +130,7 @@ initialSkovData rp gd genState = do
 -- type used in the implementation.
 newtype PureTreeStateMonad bs m a = PureTreeStateMonad { runPureTreeStateMonad :: m a }
   deriving (Functor, Applicative, Monad, MonadIO, BlockStateTypes, BS.AccountOperations,
-            BS.BlockStateQuery, BS.BlockStateOperations, BS.BlockStateStorage, TimeMonad)
+            BS.BlockStateQuery, BS.BlockStateOperations, BS.BlockStateStorage, BS.ContractStateOperations, TimeMonad)
 
 deriving instance (MonadProtocolVersion m) => MonadProtocolVersion (PureTreeStateMonad bs m)