diff --git a/CHANGELOG.md b/CHANGELOG.md index db73654f95..2bcbd3db9d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ ## Unreleased changes +- Add support for new `invoke` calls from smart contracts in protocol version 7: + - query the contract module reference for a given contract address + - query the contract name for a given contract address + ## 6.3.0 - Fix a bug where `GetBlockPendingUpdates` fails to report pending updates to the finalization diff --git a/concordium-base b/concordium-base index ff9f17ab70..e68e3c7766 160000 --- a/concordium-base +++ b/concordium-base @@ -1 +1 @@ -Subproject commit ff9f17ab704a3fe2b24ab11ae5e7993b8a2cc720 +Subproject commit e68e3c7766eef62fd8d00e4627d9ed1e4ba5b06a diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs index 34cc653cfd..83549979d7 100644 --- a/concordium-consensus/src/Concordium/Scheduler.hs +++ b/concordium-consensus/src/Concordium/Scheduler.hs @@ -1563,6 +1563,87 @@ handleContractUpdateV1 originAddr istance checkAndGetSender transferAmount recei WasmV1.SignatureCheckFailed Nothing ) + WasmV1.QueryContractModuleReference{..} -> do + -- Charge for querying the balance of a contract. + tickEnergy Cost.contractInstanceQueryContractModuleReferenceCost + -- Lookup contract balances. + maybeInstanceInfo <- getCurrentContractInstance imqcmrAddress + case maybeInstanceInfo of + Nothing -> + -- The Wasm execution does not reset contract events for queries, hence we do not have to + -- add them here via an interrupt. They will be retained until the next interrupt. + go events + =<< runInterpreter + ( return + . WasmV1.resumeReceiveFun + rrdInterruptedConfig + rrdCurrentState + False + entryBalance + (WasmV1.Error $ WasmV1.EnvFailure $ WasmV1.MissingContract imqcmrAddress) + Nothing + ) + Just instanceInfo -> do + let modRef = case instanceInfo of + InstanceInfoV0 ii -> GSWasm.miModuleRef $ instanceModuleInterface $ iiParameters ii + InstanceInfoV1 ii -> GSWasm.miModuleRef $ instanceModuleInterface $ iiParameters ii + -- Construct the return value. + let returnValue = WasmV1.byteStringToReturnValue $ S.encode modRef + -- The Wasm execution does not reset contract events for queries, hence we do not have to + -- add them here via an interrupt. They will be retained until the next interrupt. + go events + =<< runInterpreter + ( return + . WasmV1.resumeReceiveFun + rrdInterruptedConfig + rrdCurrentState + False + entryBalance + WasmV1.Success + (Just returnValue) + ) + WasmV1.QueryContractName{..} -> do + -- Charge for querying the balance of a contract. + tickEnergy Cost.contractInstanceQueryContractNameCost + -- Lookup contract balances. + maybeInstanceInfo <- getCurrentContractInstance imqcnAddress + case maybeInstanceInfo of + Nothing -> + -- The Wasm execution does not reset contract events for queries, hence we do not have to + -- add them here via an interrupt. They will be retained until the next interrupt. + go events + =<< runInterpreter + ( return + . WasmV1.resumeReceiveFun + rrdInterruptedConfig + rrdCurrentState + False + entryBalance + (WasmV1.Error $ WasmV1.EnvFailure $ WasmV1.MissingContract imqcnAddress) + Nothing + ) + Just instanceInfo -> do + let name = case instanceInfo of + InstanceInfoV0 ii -> instanceInitName $ iiParameters ii + InstanceInfoV1 ii -> instanceInitName $ iiParameters ii + -- Construct the return value. + let returnValue = + WasmV1.byteStringToReturnValue $ + GSWasm.initNameBytes name + -- The Wasm execution does not reset contract events for queries, hence we do not have to + -- add them here via an interrupt. They will be retained until the next interrupt. + go events + =<< runInterpreter + ( return + . WasmV1.resumeReceiveFun + rrdInterruptedConfig + rrdCurrentState + False + entryBalance + WasmV1.Success + (Just returnValue) + ) + -- start contract execution. -- transfer the amount from the sender to the contract at the start. This is so that the contract may immediately use it -- for, e.g., forwarding. @@ -1578,7 +1659,8 @@ handleContractUpdateV1 originAddr istance checkAndGetSender transferAmount recei -- Check whether the number of logs and the size of return values are limited in the current protocol version. rcLimitLogsAndRvs = Wasm.limitLogsAndReturnValues $ protocolVersion @(MPV m), rcFixRollbacks = demoteProtocolVersion (protocolVersion @(MPV m)) >= P6, - rcSupportAccountSignatureChecks = supportsAccountSignatureChecks $ protocolVersion @(MPV m) + rcSupportAccountSignatureChecks = supportsAccountSignatureChecks $ protocolVersion @(MPV m), + rcSupportContractInspectionQueries = supportsContractInspectionQueries $ protocolVersion @(MPV m) } transferAccountSync :: AccountAddress -> -- The target account address. diff --git a/concordium-consensus/src/Concordium/Scheduler/WasmIntegration/V1.hs b/concordium-consensus/src/Concordium/Scheduler/WasmIntegration/V1.hs index b3082830c7..8783f496e8 100644 --- a/concordium-consensus/src/Concordium/Scheduler/WasmIntegration/V1.hs +++ b/concordium-consensus/src/Concordium/Scheduler/WasmIntegration/V1.hs @@ -287,6 +287,8 @@ foreign import ccall "call_receive_v1" Word8 -> -- | Non-zero to enable support for account keys query and signature checks. Word8 -> + -- | Non-zero to enable support for contract module reference and name queries. + Word8 -> -- | New state, logs, and actions, if applicable, or null, signalling out-of-energy. IO (Ptr Word8) @@ -424,6 +426,14 @@ data InvokeMethod QueryAccountKeys { imqakAddress :: !AccountAddress } + | -- | Query the module reference of a contract. + QueryContractModuleReference + { imqcmrAddress :: !ContractAddress + } + | -- | Query the constructor name of a contract. + QueryContractName + { imqcnAddress :: !ContractAddress + } getInvokeMethod :: Get InvokeMethod getInvokeMethod = @@ -436,6 +446,8 @@ getInvokeMethod = 5 -> return QueryExchangeRates 6 -> CheckAccountSignature <$> get <*> getByteStringLen 7 -> QueryAccountKeys <$> get + 8 -> QueryContractModuleReference <$> get + 9 -> QueryContractName <$> get n -> fail $ "Unsupported invoke method tag: " ++ show n -- | Data return from the contract in case of successful initialization. @@ -668,7 +680,9 @@ data RuntimeConfig = RuntimeConfig rcLimitLogsAndRvs :: Bool, -- | Whether to support account key queries and account signature checks. -- Supported in P6 onward. - rcSupportAccountSignatureChecks :: Bool + rcSupportAccountSignatureChecks :: Bool, + -- | Whether to support querying smart contract module reference and name. + rcSupportContractInspectionQueries :: Bool } -- | Apply a receive function which is assumed to be part of the given module. @@ -728,6 +742,7 @@ applyReceiveFun miface cm receiveCtx rName useFallback param amnt initialState R stateWrittenToPtr (if rcSupportChainQueries then 1 else 0) (if rcSupportAccountSignatureChecks then 1 else 0) + (if rcSupportContractInspectionQueries then 1 else 0) if outPtr == nullPtr then return (Just (Left Trap, 0)) -- this case should not happen else do diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs b/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs index 8e7dca1f7a..99be70727f 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs @@ -229,6 +229,7 @@ data SchedulerResult = SchedulerResult -- | The total execution energy of the block. srUsedEnergy :: Types.Energy } + deriving (Show) -- | Run the scheduler on transactions in a test environment. runScheduler :: diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/SmartContracts/V1/InspectModuleReferenceAndContractName.hs b/concordium-consensus/tests/scheduler/SchedulerTests/SmartContracts/V1/InspectModuleReferenceAndContractName.hs new file mode 100644 index 0000000000..06f81c8b49 --- /dev/null +++ b/concordium-consensus/tests/scheduler/SchedulerTests/SmartContracts/V1/InspectModuleReferenceAndContractName.hs @@ -0,0 +1,365 @@ +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +-- | This module tests the contract inspection functionality of the invoke host function for +-- getting the module reference and contract name of an instance. +module SchedulerTests.SmartContracts.V1.InspectModuleReferenceAndContractName where + +import qualified Data.ByteString.Short as BSS +import Data.Serialize (Serialize (put), encode, putWord64le, runPut) +import Test.Hspec + +import qualified Concordium.Crypto.SignatureScheme as SigScheme +import qualified Concordium.GlobalState.Persistent.BlockState as BS +import qualified Concordium.ID.Types as ID +import Concordium.Scheduler.DummyData +import Concordium.Scheduler.Runner +import qualified Concordium.Scheduler.Types as Types +import Concordium.Wasm +import SchedulerTests.Helpers () +import qualified SchedulerTests.Helpers as Helpers +import System.IO.Unsafe (unsafePerformIO) +import Test.HUnit + +initialBlockState :: + (Types.IsProtocolVersion pv) => + Helpers.PersistentBSM pv (BS.HashedPersistentBlockState pv) +initialBlockState = + Helpers.createTestBlockStateWithAccountsM + [ Helpers.makeTestAccountFromSeed 100_000_000 0 + ] + +accountAddress0 :: ID.AccountAddress +accountAddress0 = Helpers.accountAddressFromSeed 0 + +keyPair0 :: SigScheme.KeyPair +keyPair0 = Helpers.keyPairFromSeed 0 + +-- | Source file for contracts that invoke the contract inspection queries. +srcQueriesContractInspection :: FilePath +srcQueriesContractInspection = "../concordium-base/smart-contracts/testdata/contracts/v1/queries-contract-inspection.wasm" + +-- | Another smart contract module that is used for deploying a contract that has a different +-- module reference. +srcQueriesAccountBalance :: FilePath +srcQueriesAccountBalance = "../concordium-base/smart-contracts/testdata/contracts/v1/queries-account-balance.wasm" + +-- | Compute the module reference of a module at a given source path. +modRefOf :: FilePath -> IO Types.ModuleRef +modRefOf modSrc = do + modl <- Helpers.readV1ModuleFile modSrc + return $! case modl of + WasmModuleV0 m -> getModuleRef m + WasmModuleV1 m -> getModuleRef m + +-- | Module reference of 'srcQueriesContractInspection'. +modRefQueriesContractInspection :: Types.ModuleRef +{-# NOINLINE modRefQueriesContractInspection #-} +modRefQueriesContractInspection = unsafePerformIO $ modRefOf srcQueriesContractInspection + +-- | Module reference of 'srcQueriesAccountBalance'. +modRefQueriesAccountBalance :: Types.ModuleRef +{-# NOINLINE modRefQueriesAccountBalance #-} +modRefQueriesAccountBalance = unsafePerformIO $ modRefOf srcQueriesAccountBalance + +-- | This test deploys three different smart contracts, from two different modules. +-- One of these contracts <0,0> has a function that queries and logs the module reference of a +-- specified contract address. Another <2,0> queries and logs the contract name of a specified +-- contract. Both functions are invoked for each instance, and for non-existant contract +-- addresses, ensuring the values are as expected. +-- +-- The entrypoints are designed to succeed in the case of a match, fail with code -1 if there is +-- a mismatch, and fail with code -2 if the contract address does not exist. If the protocol +-- version does not support the contract inspection functionality, then the call should fail with +-- a runtime exception. +-- +-- As well as testing the result of the queries, this also tests that the costs of the operations +-- are as expected. +testModuleRefAndName :: forall pv. (Types.IsProtocolVersion pv) => Types.SProtocolVersion pv -> [Char] -> SpecWith () +testModuleRefAndName spv pvString + | Types.supportsV1Contracts spv = + specify (pvString ++ ": inspect contract module reference and contract name") $ + Helpers.runSchedulerTestAssertIntermediateStates + @pv + Helpers.defaultTestConfig + initialBlockState + transactionsAndAssertions + | otherwise = return () + where + transactionsAndAssertions :: [Helpers.TransactionAndAssertion pv] + transactionsAndAssertions = + [ deployModHelper 1 srcQueriesContractInspection, + deployModHelper 2 srcQueriesAccountBalance, + initContractHelper 3 srcQueriesContractInspection "init_contract", + initContractHelper 4 srcQueriesAccountBalance "init_contract", + initContractHelper 5 srcQueriesContractInspection "init_contract2", + getModRefHelper 6 (Types.ContractAddress 0 0) (Just modRefQueriesContractInspection), + getModRefHelper 7 (Types.ContractAddress 1 0) (Just modRefQueriesAccountBalance), + getModRefHelper 8 (Types.ContractAddress 2 0) (Just modRefQueriesContractInspection), + getModRefHelper 9 (Types.ContractAddress 3 0) Nothing, + getModRefHelper 10 (Types.ContractAddress 0 1) Nothing, + getNameHelper 11 (Types.ContractAddress 0 0) (Just "init_contract") 754, + getNameHelper 12 (Types.ContractAddress 1 0) (Just "init_contract") 754, + getNameHelper 13 (Types.ContractAddress 2 0) (Just "init_contract2") 755, + getNameHelper 14 (Types.ContractAddress 3 0) Nothing 741, + getNameHelper 15 (Types.ContractAddress 0 1) Nothing 741 + ] + deployModHelper nce src = + Helpers.TransactionAndAssertion + { taaTransaction = + TJSON + { payload = DeployModule V1 src, + metadata = makeDummyHeader accountAddress0 nce 100_000, + keys = [(0, [(0, keyPair0)])] + }, + taaAssertion = \result _ -> + return $ do + Helpers.assertSuccess result + Helpers.assertUsedEnergyDeploymentV1 src result + } + initContractHelper nce src constructor = + Helpers.TransactionAndAssertion + { taaTransaction = + TJSON + { payload = InitContract 0 V1 src constructor "", + metadata = makeDummyHeader accountAddress0 nce 100_000, + keys = [(0, [(0, keyPair0)])] + }, + taaAssertion = \result _ -> + return $ do + Helpers.assertSuccess result + Helpers.assertUsedEnergyInitialization + src + (InitName constructor) + (Parameter mempty) + Nothing + result + } + getModRefHelper :: + Types.Nonce -> + Types.ContractAddress -> + Maybe Types.ModuleRef -> + Helpers.TransactionAndAssertion pv + getModRefHelper nce scAddr mExpectModRef = + Helpers.TransactionAndAssertion + { taaTransaction = + TJSON + { payload = Update 0 (Types.ContractAddress 0 0) "contract.get_module_reference" params, + metadata = makeDummyHeader accountAddress0 nce 100_000, + keys = [(0, [(0, keyPair0)])] + }, + taaAssertion = \result _ -> + return $ + if Types.supportsContractInspectionQueries spv + then case mExpectModRef of + Nothing -> do + Helpers.assertRejectWhere + ( \case + Types.RejectedReceive{rejectReason = -1} -> return () + _ -> assertFailure "Rejected for incorrect reason" + ) + result + assertEqual + "Energy usage (non-existing instance)" + 743 + (Helpers.srUsedEnergy result) + Just modRef -> do + Helpers.assertSuccessWhere (checkEvents modRef) result + assertEqual + "Energy usage (existing instance)" + 775 + (Helpers.srUsedEnergy result) + else do + Helpers.assertRejectWithReason Types.RuntimeFailure result + assertEqual + "Energy usage (unsupported protocol version)" + 543 + (Helpers.srUsedEnergy result) + } + where + params = case scAddr of + (Types.ContractAddress i si) -> BSS.toShort $ runPut $ do + putWord64le $ fromIntegral i + putWord64le $ fromIntegral si + checkEvents modRef [Types.Updated{euEvents = [ContractEvent ce]}] = + assertEqual "Module reference" (BSS.toShort $ encode modRef) ce + checkEvents _ _ = assertFailure "Expected exactly one event" + getNameHelper :: + Types.Nonce -> + Types.ContractAddress -> + Maybe BSS.ShortByteString -> + Types.Energy -> + Helpers.TransactionAndAssertion pv + getNameHelper nce scAddr mExpectName expectEnergy = + Helpers.TransactionAndAssertion + { taaTransaction = + TJSON + { payload = Update 0 (Types.ContractAddress 2 0) "contract2.get_contract_name" params, + metadata = makeDummyHeader accountAddress0 nce 100_000, + keys = [(0, [(0, keyPair0)])] + }, + taaAssertion = \result _ -> + return $ do + if Types.supportsContractInspectionQueries spv + then do + case mExpectName of + Nothing -> do + Helpers.assertRejectWhere + ( \case + Types.RejectedReceive{rejectReason = -1} -> return () + _ -> assertFailure "Rejected for incorrect reason" + ) + result + Just name -> do + Helpers.assertSuccessWhere (checkEvents name) result + assertEqual "Energy usage" expectEnergy (Helpers.srUsedEnergy result) + else do + Helpers.assertRejectWithReason Types.RuntimeFailure result + assertEqual "Energy usage" 541 (Helpers.srUsedEnergy result) + } + where + params = case scAddr of + (Types.ContractAddress i si) -> BSS.toShort $ runPut $ do + putWord64le $ fromIntegral i + putWord64le $ fromIntegral si + checkEvents name [Types.Updated{euEvents = [ContractEvent ce]}] = + assertEqual "Contract name" name ce + checkEvents _ _ = assertFailure "Expected exactly one event" + +-- | First source file for contract upgrade and query module reference interaction test. +srcUpgrade0 :: FilePath +srcUpgrade0 = "../concordium-base/smart-contracts/testdata/contracts/v1/upgrading-inspect-module0.wasm" + +-- | Second source file for contract upgrade and query module reference interaction test. +srcUpgrade1 :: FilePath +srcUpgrade1 = "../concordium-base/smart-contracts/testdata/contracts/v1/upgrading-inspect-module1.wasm" + +-- | Module reference of 'srcUpgrade0'. +modUpgrade0 :: Types.ModuleRef +{-# NOINLINE modUpgrade0 #-} +modUpgrade0 = unsafePerformIO $ modRefOf srcUpgrade0 + +-- | Module reference of 'srcUpgrade1'. +modUpgrade1 :: Types.ModuleRef +{-# NOINLINE modUpgrade1 #-} +modUpgrade1 = unsafePerformIO $ modRefOf srcUpgrade1 + +testUpgradeModuleRef :: forall pv. (Types.IsProtocolVersion pv) => Types.SProtocolVersion pv -> [Char] -> SpecWith () +testUpgradeModuleRef spv pvString + | Types.supportsV1Contracts spv && Types.supportsUpgradableContracts spv = + specify (pvString ++ ": upgrade contract and inspect module reference") $ + Helpers.runSchedulerTestAssertIntermediateStates + @pv + Helpers.defaultTestConfig + initialBlockState + transactionsAndAssertions + | otherwise = return () + where + addr0 = Types.ContractAddress 0 0 + transactionsAndAssertions :: [Helpers.TransactionAndAssertion pv] + transactionsAndAssertions = + [ deployModHelper 1 srcUpgrade0, + deployModHelper 2 srcUpgrade1, + initContractHelper 3 srcUpgrade0 "init_contract", + checkModRefHelper 4 addr0 modUpgrade0 Nothing, + checkModRefHelper 5 addr0 modUpgrade1 (Just (-1)), + upgradeHelper 6 addr0 modUpgrade1 Nothing, + checkModRefHelper 7 addr0 modUpgrade0 (Just (-1)), + checkModRefHelper 8 addr0 modUpgrade1 Nothing + ] + deployModHelper nce src = + Helpers.TransactionAndAssertion + { taaTransaction = + TJSON + { payload = DeployModule V1 src, + metadata = makeDummyHeader accountAddress0 nce 100_000, + keys = [(0, [(0, keyPair0)])] + }, + taaAssertion = \result _ -> + return $ do + Helpers.assertSuccess result + Helpers.assertUsedEnergyDeploymentV1 src result + } + initContractHelper nce src constructor = + Helpers.TransactionAndAssertion + { taaTransaction = + TJSON + { payload = InitContract 0 V1 src constructor "", + metadata = makeDummyHeader accountAddress0 nce 100_000, + keys = [(0, [(0, keyPair0)])] + }, + taaAssertion = \result _ -> + return $ do + Helpers.assertSuccess result + Helpers.assertUsedEnergyInitialization + src + (InitName constructor) + (Parameter mempty) + Nothing + result + } + checkModRefHelper nce scAddr expectModRef mreject = + Helpers.TransactionAndAssertion + { taaTransaction = + TJSON + { payload = + Update + 0 + (Types.ContractAddress 0 0) + "contract.check_module_reference" + (params scAddr expectModRef), + metadata = makeDummyHeader accountAddress0 nce 100_000, + keys = [(0, [(0, keyPair0)])] + }, + taaAssertion = \result _ -> + return $ + if Types.supportsContractInspectionQueries spv + then case mreject of + Nothing -> Helpers.assertSuccess result + Just reject -> + Helpers.assertRejectWhere + ( \case + Types.RejectedReceive{..} + | rejectReason == reject -> return () + _ -> assertFailure "Rejected for incorrect reason" + ) + result + else Helpers.assertRejectWithReason Types.RuntimeFailure result + } + where + params (Types.ContractAddress i si) modRef = BSS.toShort $ runPut $ do + putWord64le $ fromIntegral i + putWord64le $ fromIntegral si + put modRef + upgradeHelper nce scAddr toModRef mreject = + Helpers.TransactionAndAssertion + { taaTransaction = + TJSON + { payload = Update 0 scAddr "contract.upgrade" (BSS.toShort $ encode toModRef), + metadata = makeDummyHeader accountAddress0 nce 100_000, + keys = [(0, [(0, keyPair0)])] + }, + taaAssertion = \result _ -> + return $ + if Types.supportsContractInspectionQueries spv + then case mreject of + Nothing -> Helpers.assertSuccess result + Just reject -> + Helpers.assertRejectWhere + ( \case + Types.RejectedReceive{..} + | rejectReason == reject -> return () + _ -> assertFailure "Rejected for incorrect reason" + ) + result + else Helpers.assertRejectWithReason Types.RuntimeFailure result + } + +tests :: Spec +tests = describe "V1: Contract inspection queries" . sequence_ $ + Helpers.forEveryProtocolVersion $ \spv pvString -> do + testModuleRefAndName spv pvString + testUpgradeModuleRef spv pvString diff --git a/concordium-consensus/tests/scheduler/Spec.hs b/concordium-consensus/tests/scheduler/Spec.hs index 268f5c788b..54c8d97c08 100644 --- a/concordium-consensus/tests/scheduler/Spec.hs +++ b/concordium-consensus/tests/scheduler/Spec.hs @@ -38,6 +38,7 @@ import qualified SchedulerTests.SmartContracts.V1.CrossMessaging (tests) import qualified SchedulerTests.SmartContracts.V1.CustomSectionSize (tests) import qualified SchedulerTests.SmartContracts.V1.ErrorCodes (tests) import qualified SchedulerTests.SmartContracts.V1.Fallback (tests) +import qualified SchedulerTests.SmartContracts.V1.InspectModuleReferenceAndContractName (tests) import qualified SchedulerTests.SmartContracts.V1.Iterator (tests) import qualified SchedulerTests.SmartContracts.V1.P6WasmFeatures (tests) import qualified SchedulerTests.SmartContracts.V1.Queries (tests) @@ -103,3 +104,4 @@ main = hspec $ do SchedulerTests.SmartContracts.V1.P6WasmFeatures.tests SchedulerTests.SmartContracts.V1.CustomSectionSize.tests SchedulerTests.SmartContracts.V1.AccountSignatureChecks.tests + SchedulerTests.SmartContracts.V1.InspectModuleReferenceAndContractName.tests