Sync calls

concordium-consensus/.diff-wat-wasm.sh

@@ -11,7 +11,7 @@ pushd testdata/contracts
 
 RET=0
 
-for wat in *wat;do
+for wat in $(find -name '*.wat'); do
    OUT=$(mktemp)
    wat2wasm $wat -o $OUT;
    if ! $(diff $OUT "${wat%.wat}.wasm")

concordium-consensus/package.yaml

@@ -74,7 +74,7 @@ default-extensions:
 flags:
   dynamic:
     manual: True
-    default: True
+    default: False
 
 library:
   source-dirs: src

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

@@ -116,7 +116,7 @@ lookup addr (AccountMap am) = case protocolVersion @pv of
   -- addresses with the same prefix created in protocol versions 1 and 2 we have
   -- a fallback. If such a situation does occur then those accounts can only be
   -- referred to by the exact address. This is what the logic below implements.
-  SP3 -> Trie.lookupPrefix (mkPrefix addr) am >>= \case
+  _ -> Trie.lookupPrefix (mkPrefix addr) am >>= \case
     [] -> return Nothing
     [(_, v)] -> return (Just v)
     fs -> case filter ((== addr) . fst) fs of
@@ -129,7 +129,7 @@ addressWouldClash :: forall pv fix m . (IsProtocolVersion pv, TrieGetContext fix
 addressWouldClash addr (AccountMap am) = case protocolVersion @pv of
   SP1 -> isJust <$> Trie.lookup addr am
   SP2 -> isJust <$> Trie.lookup addr am
-  SP3 -> not . null <$> Trie.lookupPrefix (mkPrefix addr) am
+  _ -> not . null <$> Trie.lookupPrefix (mkPrefix addr) am
 
 -- |Insert a new key value pair if it is fresh. If the key already exists in the
 -- map no changes are made and the existing 'AccountIndex' is returned.

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

@@ -221,6 +221,7 @@ hashBlockState = case protocolVersion :: SProtocolVersion pv of
   SP1 -> hashBlockStateP1
   SP2 -> hashBlockStateP1
   SP3 -> hashBlockStateP1
+  SP4 -> hashBlockStateP1
     -- For protocol versions P1, P2, and P3, convert a @BlockState pv@ to a
     -- @HashedBlockState pv@ by computing the state hash. The state and hashing
     -- is the same. This function was introduced in protocol version 1 which is
@@ -303,7 +304,7 @@ getBlockState = do
     (_blockAccounts :: Accounts.Accounts pv) <- Accounts.deserializeAccounts cryptoParams
     let resolveModule modRef initName = do
             mi <- Modules.getInterface modRef _blockModules
-            return (GSWasm.miExposedReceive mi ^. at initName . non Set.empty, mi)
+            return (GSWasm.exposedReceive mi ^. at initName . non Set.empty, mi)
     _blockInstances <- Instances.getInstancesV0 resolveModule
     _blockUpdates <- getUpdatesV0 
     _blockEpochBlocksBaked <- getHashedEpochBlocksV0
@@ -513,10 +514,9 @@ instance (IsProtocolVersion pv, Monad m) => BS.BlockStateOperations (PureBlockSt
             accounts = bs ^. blockAccounts
             newAccounts = Accounts.putAccountWithRegIds acct accounts
 
-    bsoPutNewInstance bs mkInstance = return (instanceAddress, bs')
+    bsoPutNewInstance bs mkInstance = return (Instances.instanceAddress inst, bs')
         where
             (inst, instances') = Instances.createInstance mkInstance (bs ^. blockInstances)
-            Instances.InstanceParameters{..} = Instances.instanceParameters inst
             bs' = bs
                 -- Add the instance
                 & blockInstances .~ instances'

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

@@ -46,6 +46,7 @@ showAccountPersisting spv = case spv of
   SP1 -> show
   SP2 -> show
   SP3 -> show
+  SP4 -> show
 
 -- |An (in-memory) account.
 data Account (pv :: ProtocolVersion) = Account {
@@ -163,6 +164,7 @@ instance (IsProtocolVersion pv) => HashableTo Hash.Hash (Account pv) where
       SP1 -> makeAccountHashP1 _accountNonce _accountAmount _accountEncryptedAmount (getHash _accountReleaseSchedule) (getHash _accountPersisting) bkrHash
       SP2 -> makeAccountHashP1 _accountNonce _accountAmount _accountEncryptedAmount (getHash _accountReleaseSchedule) (getHash _accountPersisting) bkrHash
       SP3 -> makeAccountHashP1 _accountNonce _accountAmount _accountEncryptedAmount (getHash _accountReleaseSchedule) (getHash _accountPersisting) bkrHash
+      SP4 -> makeAccountHashP1 _accountNonce _accountAmount _accountEncryptedAmount (getHash _accountReleaseSchedule) (getHash _accountPersisting) bkrHash
     where
       bkrHash = maybe nullAccountBakerHash getHash _accountBaker
 

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

@@ -82,7 +82,7 @@ type instance IxValue InstanceTable = Instance
 
 instance Ixed InstanceTable where
     ix _ _ t@Empty = pure t
-    ix i upd (Tree s t) = Tree s <$> (ix (contractIndex i) . filtered ((== i) . instanceAddress . instanceParameters)) upd t
+    ix i upd (Tree s t) = Tree s <$> (ix (contractIndex i) . filtered ((== i) . instanceAddress)) upd t
 
 -- |Determine if an 'IT' is a full binary tree.
 isFull :: IT -> Bool
@@ -127,7 +127,7 @@ deleteContractInstance _ Empty = Empty
 deleteContractInstance i0 (Tree s0 t0) = uncurry Tree $ dci i0 t0
     where
         dci i l@(Leaf inst)
-            | i == 0 = (s0 - 1, VacantLeaf $ contractSubindex $ instanceAddress $ instanceParameters inst)
+            | i == 0 = (s0 - 1, VacantLeaf $ contractSubindex $ instanceAddress inst)
             | otherwise = (s0, l)
         dci _ vl@(VacantLeaf _) = (s0, vl)
         dci i b@(Branch h f _ _ l r)
@@ -143,8 +143,8 @@ deleteContractInstanceExact _ Empty = Empty
 deleteContractInstanceExact addr (Tree s0 t0) = uncurry Tree $ dci (contractIndex addr) t0
     where
         dci i l@(Leaf inst)
-            | i == 0 && addr == instanceAddress (instanceParameters inst)
-                        = (s0 - 1, VacantLeaf $ contractSubindex $ instanceAddress $ instanceParameters inst)
+            | i == 0 && addr == instanceAddress inst
+                        = (s0 - 1, VacantLeaf $ contractSubindex $ instanceAddress inst)
             | otherwise = (s0, l)
         dci _ vl@(VacantLeaf _) = (s0, vl)
         dci i b@(Branch h f _ _ l r)

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

@@ -1,6 +1,8 @@
 module Concordium.GlobalState.Basic.BlockState.Instances(
     InstanceParameters(..),
     Instance(..),
+    InstanceV(..),
+    HasInstanceParameters(..),
     makeInstance,
     iaddress,
     Instances,
@@ -76,8 +78,13 @@ putInstancesV0 (Instances (Tree _ t)) = do
             putWord8 1
             put si
         putOptInstance (Right inst) = do
-            putWord8 2
-            putInstanceV0 inst
+            case inst of
+              InstanceV0 i -> do
+                putWord8 2
+                putInstanceV0 i
+              InstanceV1 i -> do
+                putWord8 3
+                putInstanceV1 i
 
 -- |Deserialize 'Instances' in V0 format.
 getInstancesV0
@@ -88,5 +95,6 @@ getInstancesV0 resolve = Instances <$> constructM buildInstance
         buildInstance idx = getWord8 >>= \case
             0 -> return Nothing
             1 -> Just . Left <$> get
-            2 -> Just . Right <$> getInstanceV0 resolve idx
+            2 -> Just . Right . InstanceV0 <$> getInstanceV0 resolve idx
+            3 -> Just . Right . InstanceV1 <$> getInstanceV1 resolve idx
             _ -> fail "Bad instance list"

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

@@ -80,7 +80,8 @@ invariantBlockState bs extraBalance = do
         checkEpochBakers EpochBakers{..} = do
             checkBinary (==) (Vec.length _bakerInfos) (Vec.length _bakerStakes) "==" "#baker infos" "#baker stakes"
             checkBinary (==) _bakerTotalStake (sum _bakerStakes) "==" "baker total stake" "sum of baker stakes"
-        checkInstance amount Instance{..} = return $! (amount + instanceAmount)
+        checkInstance amount (InstanceV0 InstanceV{..}) = return $! (amount + _instanceVAmount)
+        checkInstance amount (InstanceV1 InstanceV{..}) = return $! (amount + _instanceVAmount)
 
         -- check that the two credential maps are the same, the one recorded in block state and the model one.
         checkCredentialResults modelCreds actualCreds = do

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

@@ -1,6 +1,10 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE GADTs #-}
 module Concordium.GlobalState.Basic.BlockState.Modules
   ( Module(..),
+    ModuleV(..),
+    interface,
+    source,
     Modules,
     emptyModules,
     putInterface,
@@ -11,17 +15,18 @@ module Concordium.GlobalState.Basic.BlockState.Modules
     _modulesMap,
     -- * Serialization
     putModulesV0,
-    getModulesV0
+    getModulesV0,
   ) where
 
 import Concordium.Crypto.SHA256
-import Concordium.GlobalState.Wasm
 import Concordium.GlobalState.Basic.BlockState.LFMBTree (LFMBTree)
 import qualified Concordium.GlobalState.Basic.BlockState.LFMBTree as LFMB
 import Concordium.Types
 import Concordium.Types.HashableTo
 import Concordium.Wasm
-import Concordium.Scheduler.WasmIntegration
+import qualified Concordium.GlobalState.Wasm as GSWasm
+import qualified Concordium.Scheduler.WasmIntegration as V0
+import qualified Concordium.Scheduler.WasmIntegration.V1 as V1
 import Control.Monad
 import Data.Coerce
 import Data.Map.Strict (Map)
@@ -38,23 +43,54 @@ type ModuleIndex = Word64
 
 -- |A module contains both the module interface and the raw source code of the
 -- module.
-data Module = Module {
+data ModuleV v = ModuleV {
   -- | The instrumented module, ready to be instantiated.
-  interface :: !ModuleInterface,
+  moduleVInterface :: !(GSWasm.ModuleInterfaceV v),
   -- | The raw module binary source.
-  source :: !WasmModule
+  moduleVSource :: !WasmModule
   } deriving (Show)
 
+-- Create the class HasSource a with a function
+-- source :: Lens a WasmModule
+makeFields ''ModuleV
+
+data Module where
+  ModuleV0 :: ModuleV GSWasm.V0 -> Module
+  ModuleV1 :: ModuleV GSWasm.V1 -> Module
+  deriving(Show)
+
+fromModule :: Module -> GSWasm.ModuleInterface
+fromModule (ModuleV0 v) = GSWasm.ModuleInterfaceV0 (moduleVInterface v)
+fromModule (ModuleV1 v) = GSWasm.ModuleInterfaceV1 (moduleVInterface v)
+
+toModule :: GSWasm.ModuleInterface -> WasmModule -> Module
+toModule (GSWasm.ModuleInterfaceV0 moduleVInterface) moduleVSource = ModuleV0 ModuleV{..}
+toModule (GSWasm.ModuleInterfaceV1 moduleVInterface) moduleVSource = ModuleV1 ModuleV{..}
+
+instance HasSource Module WasmModule where
+  source f (ModuleV0 m) = ModuleV0 <$> source f m
+  source f (ModuleV1 m) = ModuleV1 <$> source f m
+
+instance GSWasm.HasModuleRef Module where
+  {-# INLINE moduleReference #-}
+  moduleReference (ModuleV0 v) = GSWasm.moduleReference . moduleVInterface $ v
+  moduleReference (ModuleV1 v) = GSWasm.moduleReference . moduleVInterface $ v
+
 instance HashableTo Hash Module where
-  getHash = coerce . miModuleRef . interface
+  getHash = coerce . GSWasm.moduleReference
 
 instance Serialize Module where
-  put = put . source
+  put = put . (^. source)
   get = do
-    source <- get
-    case processModule source of
-      Nothing -> fail "Invalid module"
-      Just interface -> return Module {..}
+    moduleVSource <- get
+    case wasmVersion moduleVSource of
+      0 -> case V0.processModule moduleVSource of
+            Nothing -> fail "Invalid V0 module"
+            Just moduleVInterface -> return (ModuleV0 ModuleV {..})
+      1 -> case V1.processModule moduleVSource of
+            Nothing -> fail "Invalid V1 module"
+            Just moduleVInterface -> return (ModuleV1 ModuleV{..})
+      v -> fail $ "Unsupported module version: " ++ show v
 
 --------------------------------------------------------------------------------
 
@@ -80,26 +116,26 @@ emptyModules = Modules LFMB.empty Map.empty
 
 -- |Try to add interfaces to the module table. If a module with the given
 -- reference exists returns @Nothing@.
-putInterface :: (ModuleInterface, WasmModule) -> Modules -> Maybe Modules
-putInterface (iface, source) m =
+putInterface :: (GSWasm.ModuleInterface, WasmModule) -> Modules -> Maybe Modules
+putInterface (iface, mSource) m =
   if Map.member mref (m ^. modulesMap)
   then Nothing
   else Just $ m & modulesTable .~ modulesTable'
                 & modulesMap %~ Map.insert mref idx
- where mref = miModuleRef iface
-       (idx, modulesTable') = LFMB.append (Module iface source) $ m ^. modulesTable
+ where mref = GSWasm.moduleReference iface
+       (idx, modulesTable') = LFMB.append (toModule iface mSource) $ m ^. modulesTable
 
 getModule :: ModuleRef -> Modules -> Maybe Module
 getModule ref mods = Map.lookup ref (mods ^. modulesMap) >>=
                        flip LFMB.lookup (mods ^. modulesTable)
 
 -- |Get an interface by module reference.
-getInterface :: ModuleRef -> Modules -> Maybe ModuleInterface
-getInterface ref mods = fmap interface $ getModule ref mods
+getInterface :: ModuleRef -> Modules -> Maybe GSWasm.ModuleInterface
+getInterface ref mods = fromModule <$> getModule ref mods
 
 -- |Get the source of a module by module reference.
 getSource :: ModuleRef -> Modules -> Maybe WasmModule
-getSource ref mods = fmap source $ getModule ref mods
+getSource ref mods = (^. source) <$> getModule ref mods
 
 moduleRefList :: Modules -> [ModuleRef]
 moduleRefList mods = Map.keys (mods ^. modulesMap)
@@ -123,6 +159,6 @@ getModulesV0 = do
     mtSize <- getWord64be
     _modulesTable <- LFMB.fromList <$> replicateM (fromIntegral mtSize) get
     let _modulesMap = Map.fromList
-            [(miModuleRef (interface iface), idx)
+            [(GSWasm.moduleReference iface, idx)
               | (idx, iface) <- LFMB.toAscPairList _modulesTable]
     return Modules{..}

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

@@ -112,6 +112,7 @@ blockVersion :: SProtocolVersion pv -> Version
 blockVersion SP1 = 2
 blockVersion SP2 = 2
 blockVersion SP3 = 2
+blockVersion SP4 = 2
 {-# INLINE blockVersion #-}
 
 -- |Type class that supports serialization of a block.