V1 contract state

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

@@ -1059,7 +1059,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 pv, SkovMonad pv, TimeMonad, MonadLogger, MonadIO, FinalizationOutputMonad, SkovQueryMonad pv)
+    deriving (Functor, Applicative, Monad, MonadState s, MonadReader r, TimerMonad, BlockStateTypes, BlockStateQuery, AccountOperations, ContractStateOperations, BlockStateOperations, BlockStateStorage, BlockPointerMonad, PerAccountDBOperations, TreeStateMonad pv, SkovMonad pv, TimeMonad, MonadLogger, MonadIO, FinalizationOutputMonad, SkovQueryMonad pv)
 
 deriving instance (BlockPointerData (BlockPointerType m)) => GlobalStateTypes (ActiveFinalizationM pv r s m)
 deriving instance (CanExtend (ATIStorage m), CanRecordFootprint (Footprint (ATIStorage m))) => ATITypes (ActiveFinalizationM pv r s m)

concordium-consensus/src/Concordium/GlobalState.hs

@@ -127,6 +127,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,
@@ -161,6 +165,16 @@ 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,
+              ContractStateOperations (PersistentBlockStateMonad pv
+                                        PersistentBlockStateContext
+                                        (FocusGlobalStateM PersistentBlockStateContext g m)))
+             => ContractStateOperations (PersistentBlockStateM pv r g s m)
+
+
 deriving via PersistentBlockStateMonad pv
               PersistentBlockStateContext
               (FocusGlobalStateM PersistentBlockStateContext g m)
@@ -191,7 +205,7 @@ deriving via PersistentBlockStateMonad pv
 -- * If @s@ is 'SkovData pv bs', then the in-memory, Haskell tree state is used.
 -- * 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)
+    deriving (Functor, Applicative, Monad, MonadState s, MonadIO, BlockStateTypes, BlockStateQuery, AccountOperations, BlockStateOperations, BlockStateStorage, ContractStateOperations)
 
 -- * Specializations
 type MemoryTreeStateM pv bs m = TreeStateM (SkovData pv bs) m
@@ -269,6 +283,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))

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

@@ -1,6 +1,8 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -38,13 +40,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.AccountMap as AccountMap
 import qualified Concordium.GlobalState.Rewards as Rewards
 import qualified Concordium.Types.IdentityProviders as IPS
@@ -57,6 +62,8 @@ import Concordium.ID.Types (credId, ArIdentity, IdentityProviderIdentity)
 import qualified Concordium.Crypto.SHA256 as H
 import Concordium.Types.HashableTo
 import Concordium.Utils.Serialization
+import Concordium.GlobalState.BlockState (InstanceInfoTypeV(iiParameters), UpdatableContractState)
+import qualified Concordium.GlobalState.ContractStateV1 as StateV1
 
 data BasicBirkParameters = BasicBirkParameters {
     -- |The currently-registered bakers.
@@ -169,6 +176,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 BlockState (pv :: ProtocolVersion) = BlockState {
     _blockAccounts :: !(Accounts.Accounts pv),
     _blockInstances :: !Instances.Instances,
@@ -342,13 +356,25 @@ instance GT.BlockStateTypes (PureBlockStateMonad pv m) where
     type BlockState (PureBlockStateMonad pv m) = HashedBlockState pv
     type UpdatableBlockState (PureBlockStateMonad pv m) = BlockState pv
     type Account (PureBlockStateMonad pv m) = Account 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 -> AccountAddress -> m (Maybe (AccountIndex, Account pv))
 doGetIndexedAccount bs aaddr = return $! Accounts.getAccountWithIndex aaddr (bs ^. blockAccounts)
 
@@ -382,7 +408,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
@@ -405,7 +432,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 =
@@ -525,13 +552,25 @@ instance (Monad m, IsProtocolVersion pv) => BS.AccountOperations (PureBlockState
 
   getAccountBaker acc = return $ acc ^. accountBaker
 
+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
@@ -557,8 +596,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
@@ -570,7 +640,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
@@ -886,6 +956,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 :: (IsProtocolVersion pv)
              => SeedState

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

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