Merge pull request #1138 from Concordium/reduce-costs

Integrate new cost assignment version.

concordium-consensus/src/Concordium/Scheduler.hs

@@ -811,7 +811,7 @@ handleInitContract wtc initAmount modref initName param =
         case viface of
             GSWasm.ModuleInterfaceV0 iface -> do
                 let iSize = GSWasm.miModuleSize iface
-                tickEnergy $ Cost.lookupModule iSize
+                tickEnergy $ Cost.lookupModule (protocolVersion @(MPV m)) iSize
 
                 -- Then get the particular contract interface (in particular the type of the init method).
                 unless (Set.member initName (GSWasm.miExposedInit iface)) $ rejectTransaction $ InvalidInitMethod modref initName
@@ -842,7 +842,7 @@ handleInitContract wtc initAmount modref initName param =
                 return (Left (iface, result))
             GSWasm.ModuleInterfaceV1 iface -> do
                 let iSize = GSWasm.miModuleSize iface
-                tickEnergy $ Cost.lookupModule iSize
+                tickEnergy $ Cost.lookupModule (protocolVersion @(MPV m)) iSize
 
                 -- Then get the particular contract interface (in particular the type of the init method).
                 unless (Set.member initName (GSWasm.miExposedInit iface)) $ rejectTransaction $ InvalidInitMethod modref initName
@@ -1009,14 +1009,15 @@ handleUpdateContract wtc uAmount uAddress uReceiveName uMessage =
             InstanceInfoV0 ins ->
                 -- Now invoke the general handler for contract messages.
                 handleContractUpdateV0
+                    0
                     senderAddress
                     ins
                     checkAndGetBalanceV0
                     uAmount
                     uReceiveName
                     uMessage
             InstanceInfoV1 ins -> do
-                handleContractUpdateV1 senderAddress ins checkAndGetBalanceV1 uAmount uReceiveName uMessage >>= \case
+                handleContractUpdateV1 0 senderAddress ins checkAndGetBalanceV1 uAmount uReceiveName uMessage >>= \case
                     Left cer -> do
                         transactionReturnValue .= WasmV1.ccfToReturnValue cer
                         rejectTransaction (WasmV1.cerToRejectReasonReceive uAddress uReceiveName uMessage cer)
@@ -1102,6 +1103,8 @@ checkAndGetBalanceInstanceV0 ownerAccount istance transferAmount = do
 handleContractUpdateV1 ::
     forall r m.
     (StaticInformation m, AccountOperations m, ContractStateOperations m, ModuleQuery m, MonadProtocolVersion m) =>
+    -- | Current call depth. This call is being made in the context of this many interrupted contracts.
+    Word ->
     -- | The address that was used to send the top-level transaction.
     AccountAddress ->
     -- | The current state of the target contract of the transaction, which must exist.
@@ -1122,7 +1125,9 @@ handleContractUpdateV1 ::
     -- | The events resulting from processing the message and all recursively processed messages. For efficiency
     --  reasons the events are in **reverse order** of the actual effects.
     LocalT r m (Either WasmV1.ContractCallFailure (WasmV1.ReturnValue, [Event]))
-handleContractUpdateV1 originAddr istance checkAndGetSender transferAmount receiveName parameter = do
+handleContractUpdateV1 depth originAddr istance checkAndGetSender transferAmount receiveName parameter = do
+    unless (Cost.allowedContractCallDepth (protocolVersion @(MPV m)) depth) $
+        rejectTransaction RuntimeFailure
     -- Cover administrative costs.
     tickEnergy Cost.updateContractInstanceBaseCost
     let model = iiState istance
@@ -1163,7 +1168,7 @@ handleContractUpdateV1 originAddr istance checkAndGetSender transferAmount recei
             -- Now run the receive function on the message. This ticks energy during execution, failing when running out of energy.
 
             -- Charge for looking up the module.
-            tickEnergy $ Cost.lookupModule (GSWasm.miModuleSize moduleInterface)
+            tickEnergy $ Cost.lookupModule (protocolVersion @(MPV m)) (GSWasm.miModuleSize moduleInterface)
 
             -- we've covered basic administrative costs now.
             -- The @go@ function iterates until the end of execution, handling any interrupts by dispatching
@@ -1259,7 +1264,7 @@ handleContractUpdateV1 originAddr istance checkAndGetSender transferAmount recei
                                                 -- in this case we essentially treat this as a top-level transaction invoking that contract.
                                                 -- That is, we execute the entire tree that is potentially generated.
                                                 let rName = Wasm.uncheckedMakeReceiveName (instanceInitName (iiParameters targetInstance)) imcName
-                                                    runSuccess = handleContractUpdateV0 originAddr targetInstance (checkAndGetBalanceInstanceV0 ownerAccount istance) imcAmount rName imcParam
+                                                    runSuccess = handleContractUpdateV0 (depth + 1) originAddr targetInstance (checkAndGetBalanceInstanceV0 ownerAccount istance) imcAmount rName imcParam
                                                 -- If execution of the contract succeeds resume.
                                                 -- Otherwise rollback the state and report that to the caller.
                                                 runInnerTransaction runSuccess >>= \case
@@ -1283,7 +1288,7 @@ handleContractUpdateV1 originAddr istance checkAndGetSender transferAmount recei
                                                 -- to the caller.
                                                 -- Otherwise we roll back all the changes and return the return value, and the error code to the caller.
                                                 let rName = Wasm.uncheckedMakeReceiveName (instanceInitName (iiParameters targetInstance)) imcName
-                                                withRollback (handleContractUpdateV1 originAddr targetInstance (checkAndGetBalanceInstanceV1 ownerAccount istance) imcAmount rName imcParam) >>= \case
+                                                withRollback (handleContractUpdateV1 (depth + 1) originAddr targetInstance (checkAndGetBalanceInstanceV1 ownerAccount istance) imcAmount rName imcParam) >>= \case
                                                     Left cer ->
                                                         go (resumeEvent False : interruptEvent : events) =<< runInterpreter (return . WasmV1.resumeReceiveFun rrdInterruptedConfig rrdCurrentState False entryBalance (WasmV1.Error cer) (WasmV1.ccfToReturnValue cer))
                                                     Right (rVal, callEvents) -> do
@@ -1308,7 +1313,7 @@ handleContractUpdateV1 originAddr istance checkAndGetSender transferAmount recei
                                                 GSWasm.ModuleInterfaceV0 _ -> go (resumeEvent False : interruptEvent : events) =<< runInterpreter (return . WasmV1.resumeReceiveFun rrdInterruptedConfig rrdCurrentState False entryBalance (WasmV1.UpgradeInvalidVersion imuModRef GSWasm.V0) Nothing)
                                                 GSWasm.ModuleInterfaceV1 newModuleInterfaceAV1 -> do
                                                     -- Charge for the lookup of the new module.
-                                                    tickEnergy $ Cost.lookupModule $ GSWasm.miModuleSize newModuleInterfaceAV1
+                                                    tickEnergy $ Cost.lookupModule (protocolVersion @(MPV m)) $ GSWasm.miModuleSize newModuleInterfaceAV1
                                                     -- The contract must exist in the new module.
                                                     -- I.e. It must be the case that there exists an init function for the new module that matches the caller.
                                                     if Set.notMember (instanceInitName iParams) (GSWasm.miExposedInit newModuleInterfaceAV1)
@@ -1693,6 +1698,8 @@ handleContractUpdateV1 originAddr istance checkAndGetSender transferAmount recei
 handleContractUpdateV0 ::
     forall r m.
     (StaticInformation m, AccountOperations m, ContractStateOperations m, ModuleQuery m, MonadProtocolVersion m) =>
+    -- | Current call depth.
+    Word ->
     -- | The address that was used to send the top-level transaction.
     AccountAddress ->
     -- | The current state of the target contract of the transaction, which must exist.
@@ -1710,7 +1717,9 @@ handleContractUpdateV0 ::
     Wasm.Parameter ->
     -- | The events resulting from processing the message and all recursively processed messages.
     LocalT r m [Event]
-handleContractUpdateV0 originAddr istance checkAndGetSender transferAmount receiveName parameter = do
+handleContractUpdateV0 depth originAddr istance checkAndGetSender transferAmount receiveName parameter = do
+    unless (Cost.allowedContractCallDepth (protocolVersion @(MPV m)) depth) $
+        rejectTransaction RuntimeFailure
     -- Cover administrative costs.
     tickEnergy Cost.updateContractInstanceBaseCost
 
@@ -1749,7 +1758,7 @@ handleContractUpdateV0 originAddr istance checkAndGetSender transferAmount recei
     -- FIXME: Once errors can be caught in smart contracts update this to not terminate the transaction.
     let iface = instanceModuleInterface iParams
     -- charge for looking up the module
-    tickEnergy $ Cost.lookupModule (GSWasm.miModuleSize iface)
+    tickEnergy $ Cost.lookupModule (protocolVersion @(MPV m)) (GSWasm.miModuleSize iface)
 
     model <- getRuntimeReprV0 (iiState istance)
     artifact <- liftLocal $ getModuleArtifact (GSWasm.miModule iface)
@@ -1784,7 +1793,7 @@ handleContractUpdateV0 originAddr istance checkAndGetSender transferAmount recei
                           euContractVersion = Wasm.V0,
                           euEvents = Wasm.logs result
                         }
-            foldEvents originAddr (ownerAccount, istance) initEvent txOut
+            foldEvents depth originAddr (ownerAccount, istance) initEvent txOut
 
 -- Cost of a step in the traversal of the actions tree. We need to charge for
 -- this separately to prevent problems with exponentially sized trees
@@ -1799,6 +1808,8 @@ traversalStepCost = 10
 
 foldEvents ::
     (StaticInformation m, AccountOperations m, ContractStateOperations m, ModuleQuery m, MonadProtocolVersion m) =>
+    -- | Current call depth.
+    Word ->
     -- | Address that was used in the top-level transaction.
     AccountAddress ->
     -- | Instance that generated the events.
@@ -1809,12 +1820,13 @@ foldEvents ::
     Wasm.ActionsTree ->
     -- | List of events in order that transactions were traversed.
     LocalT r m [Event]
-foldEvents originAddr istance initEvent = fmap (initEvent :) . go
+foldEvents depth originAddr istance initEvent = fmap (initEvent :) . go
   where
     go Wasm.TSend{..} = do
         getCurrentContractInstanceTicking erAddr >>= \case
             InstanceInfoV0 cinstance ->
                 handleContractUpdateV0
+                    depth
                     originAddr
                     cinstance
                     (uncurry checkAndGetBalanceInstanceV0 istance)
@@ -1824,6 +1836,7 @@ foldEvents originAddr istance initEvent = fmap (initEvent :) . go
             InstanceInfoV1 cinstance ->
                 let c =
                         handleContractUpdateV1
+                            depth
                             originAddr
                             cinstance
                             (uncurry checkAndGetBalanceInstanceV1 istance)

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

@@ -166,8 +166,8 @@ invokeContract ContractContext{..} cm bs
                     Left err -> return (Left err, ccEnergy)
                     Right (invoker, addr, ai) -> do
                         let comp = do
-                                let onV0 i = handleContractUpdateV0 addr i invoker ccAmount ccMethod ccParameter
-                                let onV1 i = handleContractUpdateV1 addr i (fmap Right . invoker) ccAmount ccMethod ccParameter
+                                let onV0 i = handleContractUpdateV0 0 addr i invoker ccAmount ccMethod ccParameter
+                                let onV1 i = handleContractUpdateV1 0 addr i (fmap Right . invoker) ccAmount ccMethod ccParameter
                                 istance <- getCurrentContractInstanceTicking ccContract
                                 result <- case istance of
                                     BS.InstanceInfoV0 i -> Left <$> onV0 i

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

@@ -30,6 +30,8 @@ foreign import ccall "validate_and_process_v0"
         Ptr Word8 ->
         -- | Length of the module source.
         CSize ->
+        -- | Metering (cost assignment) version.
+        Word8 ->
         -- | Total length of the output.
         Ptr CSize ->
         -- | Length of the artifact.
@@ -292,13 +294,12 @@ processModule spv modl = do
 -- | Validate and compile a module. If successful return the artifact and serialization of module exports.
 {-# NOINLINE compileModule #-}
 compileModule :: CostSemanticsVersion -> WasmModuleV V0 -> Maybe (BS.ByteString, InstrumentedModuleV V0)
--- TODO: The unused spv argument will be used when new cost semantics are introduced.
-compileModule _spv modl = unsafePerformIO $ do
+compileModule csv modl = unsafePerformIO $ do
     unsafeUseModuleSourceAsCStringLen (wmvSource modl) $ \(wasmBytesPtr, wasmBytesLen) ->
         alloca $ \outputLenPtr ->
             alloca $ \artifactLenPtr ->
                 alloca $ \outputModuleArtifactPtr -> do
-                    outPtr <- validate_and_process (castPtr wasmBytesPtr) (fromIntegral wasmBytesLen) outputLenPtr artifactLenPtr outputModuleArtifactPtr
+                    outPtr <- validate_and_process (castPtr wasmBytesPtr) (fromIntegral wasmBytesLen) meteringVersion outputLenPtr artifactLenPtr outputModuleArtifactPtr
                     if outPtr == nullPtr
                         then return Nothing
                         else do
@@ -312,3 +313,5 @@ compileModule _spv modl = unsafePerformIO $ do
                                     (fromIntegral artifactLen)
                                     (rs_free_array_len artifactPtr (fromIntegral artifactLen))
                             return (Just (bs, instrumentedModuleFromBytes SV0 moduleArtifact))
+  where
+    meteringVersion = costSemanticsVersionToWord8 csv

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

@@ -85,6 +85,8 @@ foreign import ccall "validate_and_process_v1"
         Ptr Word8 ->
         -- | Length of the module source.
         CSize ->
+        -- | Metering (cost semantics) version.
+        Word8 ->
         -- | Total length of the output.
         Ptr CSize ->
         -- | Length of the artifact.
@@ -927,7 +929,7 @@ compileModule ValidationConfig{..} modl =
             alloca $ \outputLenPtr ->
                 alloca $ \artifactLenPtr ->
                     alloca $ \outputModuleArtifactPtr -> do
-                        outPtr <- validate_and_process (if vcSupportUpgrade then 1 else 0) (if vcAllowGlobals then 1 else 0) (if vcAllowSignExtensionInstr then 1 else 0) (castPtr wasmBytesPtr) (fromIntegral wasmBytesLen) outputLenPtr artifactLenPtr outputModuleArtifactPtr
+                        outPtr <- validate_and_process (if vcSupportUpgrade then 1 else 0) (if vcAllowGlobals then 1 else 0) (if vcAllowSignExtensionInstr then 1 else 0) (castPtr wasmBytesPtr) (fromIntegral wasmBytesLen) meteringVersion outputLenPtr artifactLenPtr outputModuleArtifactPtr
                         if outPtr == nullPtr
                             then return Nothing
                             else do
@@ -941,3 +943,5 @@ compileModule ValidationConfig{..} modl =
                                         (fromIntegral artifactLen)
                                         (rs_free_array_len artifactPtr (fromIntegral artifactLen))
                                 return (Just (bs, instrumentedModuleFromBytes SV1 moduleArtifact))
+  where
+    meteringVersion = costSemanticsVersionToWord8 vcCostSemantics

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

@@ -89,6 +89,7 @@ testCase1 _ pvString =
                 return $ do
                     Helpers.assertSuccess result
                     Helpers.assertUsedEnergyInitialization
+                        (Types.protocolVersion @pv)
                         fibSourceFile
                         (InitName "init_fib")
                         (Parameter "")
@@ -138,7 +139,7 @@ testCase1 _ pvString =
                         -- lower bound on the cost of the transaction, assuming no interpreter energy and the instance is not created.
                         -- the number of invocations of the smart contract is fibOne 10, see below for the definition of fibOne
                         -- the size of the contract state is 8 bytes (one u64)
-                        costLowerBound = baseTxCost + (fibOne 10) * Cost.updateContractInstanceCost 0 modLen 8 (Just 8)
+                        costLowerBound = baseTxCost + (fibOne 10) * Cost.updateContractInstanceCost (Types.protocolVersion @pv) 0 modLen 8 (Just 8)
                     unless (srUsedEnergy >= costLowerBound) $
                         assertFailure $
                             "Actual update cost " ++ show srUsedEnergy ++ " not more than lower bound " ++ show costLowerBound

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

@@ -57,6 +57,7 @@ import qualified Concordium.Scheduler.EnvironmentImplementation as EI
 import qualified Concordium.Scheduler.Runner as SchedTest
 import qualified Concordium.Scheduler.Types as Types
 import Concordium.TimeMonad
+import Concordium.Types (SProtocolVersion)
 
 getResults :: [(a, Types.TransactionSummary)] -> [(a, Types.ValidResult)]
 getResults = map (\(x, r) -> (x, Types.tsResult r))
@@ -822,13 +823,14 @@ assertUsedEnergyDeploymentV1 sourceFile result = do
 --  It is not practical to check the exact cost because the execution cost of the init function is hard to
 --  have an independent number for, other than executing.
 assertUsedEnergyInitialization ::
+    SProtocolVersion pv ->
     FilePath ->
     Wasm.InitName ->
     Wasm.Parameter ->
     Maybe Wasm.ByteSize ->
     SchedulerResult ->
     Assertion
-assertUsedEnergyInitialization sourceFile initName parameter initialStateSize result = do
+assertUsedEnergyInitialization spv sourceFile initName parameter initialStateSize result = do
     moduleSource <- ByteString.readFile sourceFile
     let modLen = fromIntegral $ ByteString.length moduleSource
         modRef = Types.ModuleRef (Hash.hash moduleSource)
@@ -839,7 +841,7 @@ assertUsedEnergyInitialization sourceFile initName parameter initialStateSize re
         -- transaction is signed with 1 signature
         baseTxCost = Cost.baseCost txSize 1
         -- lower bound on the cost of the transaction, assuming no interpreter energy
-        costLowerBound = baseTxCost + Cost.initializeContractInstanceCost 0 modLen initialStateSize
+        costLowerBound = baseTxCost + Cost.initializeContractInstanceCost spv 0 modLen initialStateSize
     unless (srUsedEnergy result >= costLowerBound) $
         assertFailure $
             "Actual initialization cost "

concordium-consensus/tests/scheduler/SchedulerTests/SmartContracts/V0/RelaxedRestrictions.hs

@@ -221,7 +221,7 @@ newLogLimitTest spv pvString =
                ]
 
 -- | Transactions and assertions for deploying and initializing the "relax" contract.
-deployAndInitTransactions :: [Helpers.TransactionAndAssertion pv]
+deployAndInitTransactions :: forall pv. (Types.IsProtocolVersion pv) => [Helpers.TransactionAndAssertion pv]
 deployAndInitTransactions =
     [ Helpers.TransactionAndAssertion
         { taaTransaction =
@@ -246,6 +246,7 @@ deployAndInitTransactions =
             return $ do
                 Helpers.assertSuccess result
                 Helpers.assertUsedEnergyInitialization
+                    (Types.protocolVersion @pv)
                     sourceFile
                     (InitName "init_relax")
                     (Parameter "")