Documentation and preparation for lowering costs.

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

@@ -3715,7 +3715,7 @@ migrateBlockPointers migration BlockStatePointers{..} = do
             StateMigrationParametersP6ToP7{} -> RSMNewToNew
     newReleaseSchedule <- migrateReleaseSchedule rsMigration bspReleaseSchedule
     newAccounts <- Accounts.migrateAccounts migration bspAccounts
-    newModules <- migrateHashedBufferedRef Modules.migrateModules bspModules
+    newModules <- migrateHashedBufferedRef (Modules.migrateModules migration) bspModules
     modules <- refLoad newModules
     newInstances <- Instances.migrateInstances modules bspInstances
     let newBank = bspBank

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

@@ -31,6 +31,7 @@ module Concordium.GlobalState.Persistent.BlockState.Modules (
 ) where
 
 import Concordium.Crypto.SHA256
+import Concordium.Genesis.Data (StateMigrationParameters (..))
 import Concordium.GlobalState.BlockState (ModulesHash (..))
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.Cache
@@ -197,19 +198,19 @@ instance (MonadBlobStore m, MonadProtocolVersion m) => DirectBlobStorable m Modu
                         return $! ModuleV1 (ModuleV{..})
         case runGet getModule bs of
             Left e -> error (e ++ " :: " ++ show bs)
-            Right mv@(ModuleV0 (ModuleV{moduleVInterface = GSWasm.ModuleInterface{miModule = PIMVPtr artPtr}, ..})) -> do
+            Right mv@(ModuleV0 (ModuleV{moduleVInterface = GSWasm.ModuleInterface{miModule = PIMVPtr artPtr}, ..})) | potentialLegacyArtifacts -> do
                 artBS <- loadBlobPtr artPtr
-                if GSWasm.isLegacyArtifact artBS
+                if GSWasm.isV0LegacyArtifact artBS
                     then do
                         source <- loadRef moduleVSource
-                        case WasmV0.processModule source of
+                        case WasmV0.processModule (protocolVersion @(MPV m)) source of
                             Nothing -> error "Stored module that is not valid."
                             Just iface -> do
                                 return $! ModuleV0 (ModuleV{moduleVInterface = makePersistentInstrumentedModuleV <$> iface, ..})
                     else return mv
-            Right mv@(ModuleV1 (ModuleV{moduleVInterface = GSWasm.ModuleInterface{miModule = PIMVPtr artPtr}, ..})) -> do
+            Right mv@(ModuleV1 (ModuleV{moduleVInterface = GSWasm.ModuleInterface{miModule = PIMVPtr artPtr}, ..})) | potentialLegacyArtifacts -> do
                 artBS <- loadBlobPtr artPtr
-                if GSWasm.isLegacyArtifact artBS
+                if GSWasm.isV0LegacyArtifact artBS
                     then do
                         source <- loadRef moduleVSource
                         case WasmV1.processModule (protocolVersion @(MPV m)) source of
@@ -218,6 +219,10 @@ instance (MonadBlobStore m, MonadProtocolVersion m) => DirectBlobStorable m Modu
                                 return $! ModuleV1 (ModuleV{moduleVInterface = makePersistentInstrumentedModuleV <$> iface, ..})
                     else return mv
             Right mv -> return mv
+      where
+        -- When a node is running protocol 6 or lower it might have been started prior to the new notion of Wasm
+        -- artifacts, which needs to be recompiled on load.
+        potentialLegacyArtifacts = demoteProtocolVersion (protocolVersion @(MPV m)) <= P6
 
     storeUpdateDirect mdl = do
         case mdl of
@@ -406,9 +411,10 @@ migrateModules ::
       SupportsPersistentModule (t m),
       SupportMigration m t
     ) =>
+    StateMigrationParameters (MPV m) (MPV (t m)) ->
     Modules ->
     t m Modules
-migrateModules mods = do
+migrateModules migration mods = do
     newModulesTable <- LFMB.migrateLFMBTree migrateCachedModule (_modulesTable mods)
     return
         Modules
@@ -425,19 +431,32 @@ migrateModules mods = do
 
     migrateModuleV :: forall v. (IsWasmVersion v) => ModuleV v -> t m CachedModule
     migrateModuleV ModuleV{..} = do
-        -- TODO: Recompile stuff that needs to be updated
-        newModuleVSource <- do
+        (newModuleVSource, wasmMod) <- do
             -- Load the module source from the old context.
             s <- lift (loadRef moduleVSource)
             -- and store it in the new context, returning a reference to it.
-            storeRef s
+            (,s) <$> storeRef s
         -- load the module artifact into memory from the old state. This is
         -- cheap since the artifact, which is the big part, is neither copied,
         -- nor deserialized.
-        newArtifact <- lift (loadInstrumentedModuleV (GSWasm.miModule moduleVInterface))
-        -- construct the new module interface by loading the artifact. The
-        -- remaining fields have no blob references, so are just copied over.
-        let newModuleVInterface = moduleVInterface{GSWasm.miModule = PIMVMem newArtifact}
+        artifact <- lift (loadInstrumentedModuleV (GSWasm.miModule moduleVInterface))
+        newModuleVInterface <-
+            -- If it is a legacy artifact then we want to migrate it over to the new
+            -- version by recompiling since execution no longer supports the old format.
+            if GSWasm.isV0LegacyArtifact (GSWasm.imWasmArtifactBytes artifact)
+                then recompile wasmMod
+                else -- If it is not a legacy module then we don't have to recompile
+                -- unless we're migrating from P6 to P7 where the new reduced
+                -- execution costs were introduced.
+                case migration of
+                    StateMigrationParametersTrivial -> return $! moduleVInterface{GSWasm.miModule = PIMVMem artifact}
+                    StateMigrationParametersP1P2 -> return $! moduleVInterface{GSWasm.miModule = PIMVMem artifact}
+                    StateMigrationParametersP2P3 -> return $! moduleVInterface{GSWasm.miModule = PIMVMem artifact}
+                    StateMigrationParametersP3ToP4{} -> return $! moduleVInterface{GSWasm.miModule = PIMVMem artifact}
+                    StateMigrationParametersP4ToP5{} -> return $! moduleVInterface{GSWasm.miModule = PIMVMem artifact}
+                    StateMigrationParametersP5ToP6{} -> return $! moduleVInterface{GSWasm.miModule = PIMVMem artifact}
+                    StateMigrationParametersP6ToP7{} -> recompile wasmMod -- always recompile to lower transaction costs.
+
         -- store the module into the new state, and remove it from memory
         makeFlushedHashedCachedRef $!
             mkModule (getWasmVersion @v) $!
@@ -449,3 +468,19 @@ migrateModules mods = do
     mkModule :: SWasmVersion v -> ModuleV v -> Module
     mkModule SV0 = ModuleV0
     mkModule SV1 = ModuleV1
+
+    -- Recompile a wasm module from the given source for the **target** protocol
+    -- version (i.e., the protocol version of @t m@).
+    recompile :: forall v. (IsWasmVersion v) => WasmModuleV v -> t m (GSWasm.ModuleInterfaceA (PersistentInstrumentedModuleV v))
+    recompile wasmMod = do
+        case getWasmVersion @v of
+            SV0 ->
+                case WasmV0.processModule (protocolVersion @(MPV (t m))) wasmMod of
+                    Nothing -> error "Stored V0 module that is not valid."
+                    Just iface -> do
+                        return $! makePersistentInstrumentedModuleV <$> iface
+            SV1 ->
+                case WasmV1.processModule (protocolVersion @(MPV (t m))) wasmMod of
+                    Nothing -> error "Stored V1 module that is not valid."
+                    Just iface -> do
+                        return $! makePersistentInstrumentedModuleV <$> iface

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

@@ -27,7 +27,7 @@ module Concordium.GlobalState.Wasm (
     BasicModuleInterface,
     HasModuleRef (..),
     HasEntrypoints (..),
-    isLegacyArtifact,
+    isV0LegacyArtifact,
 )
 where
 
@@ -227,7 +227,13 @@ foreign import ccall "is_legacy_artifact"
         -- | 1 for true, 0 for false
         IO Word8
 
-isLegacyArtifact :: BS.ByteString -> Bool
-isLegacyArtifact artifactBS = unsafePerformIO $
+-- | Return whether the bytestring is a serialization of a legacy "V0" artifact.
+--  These were artifact that only exist for P1-P6 for Wasm modules deployed
+--  before node version 7.
+--
+-- This assumes that the bytestring is a valid serialization of a V0 or V1
+-- artifact and will not validate this.
+isV0LegacyArtifact :: BS.ByteString -> Bool
+isV0LegacyArtifact artifactBS = unsafePerformIO $
     BSU.unsafeUseAsCStringLen artifactBS $ \(wasmArtifactPtr, wasmArtifactLen) ->
         (== 1) <$> is_legacy_artifact (castPtr wasmArtifactPtr) (fromIntegral wasmArtifactLen)

concordium-consensus/src/Concordium/Scheduler.hs

@@ -700,7 +700,7 @@ handleDeployModule wtc mod =
         case mod of
             Wasm.WasmModuleV0 moduleV0 -> do
                 tickEnergy (Cost.deployModuleCost (Wasm.moduleSourceLength (Wasm.wmvSource moduleV0)))
-                case WasmV0.processModule moduleV0 of
+                case WasmV0.processModule (protocolVersion @(MPV m)) moduleV0 of
                     Nothing -> rejectTransaction ModuleNotWF
                     Just iface -> do
                         let mhash = GSWasm.moduleReference iface

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

@@ -257,8 +257,9 @@ applyReceiveFun miface cm receiveCtx rName param maxParamLen limitLogsAndRvs amn
 --  compilation or instrumentation) that is needed to apply the exported
 --  functions from it in an efficient way.
 {-# NOINLINE processModule #-}
-processModule :: WasmModuleV V0 -> Maybe (ModuleInterfaceV V0)
-processModule modl = do
+processModule :: SProtocolVersion spv -> WasmModuleV V0 -> Maybe (ModuleInterfaceV V0)
+-- TODO: The unused spv argument will be used when new cost semantics are introduced.
+processModule _spv modl = do
     (bs, miModule) <- ffiResult
     case getExports bs of
         Left _ -> Nothing

concordium-consensus/tests/globalstate/GlobalStateTests/Instances.hs

@@ -55,7 +55,7 @@ validContractArtifactsV0 = mapMaybe packModule contractSourcesV0
   where
     packModule (_, sourceBytes) =
         let source = Wasm.ModuleSource sourceBytes
-        in  (source,) <$> WasmV0.processModule (Wasm.WasmModuleV source)
+        in  (source,) <$> WasmV0.processModule SP1 (Wasm.WasmModuleV source)
 
 contractSourcesV1 :: [(FilePath, BS.ByteString)]
 contractSourcesV1 = $(makeRelativeToProject "../concordium-base/smart-contracts/testdata/contracts/v1" >>= embedDir)

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

@@ -275,7 +275,7 @@ tests = do
                 (const BS.bsoGetActiveBakers)
                 txs
         let feeTotal = sum $ Helpers.srExecutionCosts . fst <$> outcomes
-        _ <- liftIO =<< Helpers.assertBlockStateInvariants endState feeTotal
+        liftIO =<< Helpers.assertBlockStateInvariants endState feeTotal
         return outcomes
     let results = first (Helpers.getResults . Sch.ftAdded . Helpers.srTransactions) <$> outcomes
 

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

@@ -16,6 +16,7 @@ import Data.Maybe
 import Concordium.GlobalState.Wasm
 import Concordium.ID.Types
 import Concordium.Scheduler.WasmIntegration
+import Concordium.Types (SProtocolVersion (..))
 import Concordium.Wasm
 
 import Concordium.Scheduler.DummyData
@@ -26,7 +27,7 @@ setup :: String -> IO (ModuleInterfaceV V0)
 setup errString = do
     source <- BS.readFile "../concordium-base/smart-contracts/testdata/contracts/context_test.wasm"
     let wasmMod = WasmModuleV (ModuleSource source)
-    let miface = processModule wasmMod
+    let miface = processModule SP1 wasmMod
     assertBool ("Module not valid " ++ errString) (isJust miface)
     return (fromJust miface)
 

concordium-consensus/tests/scheduler/SchedulerTests/SmartContracts/V1/InvokeHelpers.hs

@@ -61,7 +61,7 @@ deployModuleV0 ::
 deployModuleV0 sourceFile bs = do
     ws <- liftIO $ BS.readFile sourceFile
     let wm = WasmModuleV (ModuleSource ws)
-    case WasmV0.processModule wm of
+    case WasmV0.processModule Types.SP4 wm of
         Nothing -> liftIO $ assertFailure "Invalid module."
         Just miv -> do
             (_, modState) <- BS.bsoPutNewModule bs (miv, wm)

concordium-consensus/tests/scheduler/SchedulerTests/SmartContracts/V1/ValidInvalidModules.hs

@@ -29,7 +29,7 @@ testModule1 = do
             let expectedReceive = Map.singleton (InitName "init_contract") (Set.singleton (ReceiveName "contract.call"))
             assertEqual "Only valid receive functions should be exposed" expectedReceive miExposedReceive
     let wm0 = WasmModuleV (ModuleSource ws)
-    case WasmV0.processModule wm0 of
+    case WasmV0.processModule Types.SP1 wm0 of
         Nothing -> return ()
         Just _ -> assertFailure "Extra exports are not allowed for V0 modules."