diff --git a/.github/workflows/build-test.yaml b/.github/workflows/build-test.yaml index 20ea47c249..d7b656309b 100644 --- a/.github/workflows/build-test.yaml +++ b/.github/workflows/build-test.yaml @@ -227,9 +227,14 @@ jobs: ${{ runner.os }}-${{ env.dummy }}-stack-work-${{ matrix.plan.ghc }} # Compile Haskell sources. This must be done before running checks or tests on the Rust sources. - - name: Build consensus and run tests + - name: Build consensus and run tests (with code coverage) run: | - stack build concordium-consensus --test --bench --force-dirty --no-run-benchmarks --ghc-options "-Werror" --ghc-options -j + stack build concordium-consensus --test --bench --force-dirty --no-run-benchmarks --ghc-options "-Werror" --ghc-options -j --coverage + + - name: Generate Haskell codecov report + run: | + stack install hpc-codecov + hpc-codecov stack:all -o codecov-haskell.json # RUST # @@ -284,3 +289,4 @@ jobs: fail_ci_if_error: false token: ${{ secrets.CODECOV_TOKEN }} verbose: true + files: lcov.info,codecov-haskell.json diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index f6e4e3f170..53b5a78f6a 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -268,7 +268,7 @@ jobs: - name: Install DigiCert Client tools (Windows only) id: digicert_client - uses: digicert/ssm-code-signing@v1.0.0 + uses: digicert/code-signing-software-trust-action@v1.0.0 - name: Import Windows certificate (Windows only) id: windows_certificate diff --git a/.gitignore b/.gitignore index 0ccf8a9467..b4e95ca100 100644 --- a/.gitignore +++ b/.gitignore @@ -65,3 +65,6 @@ xcuserdata/ /scripts/distribution/macOS-package/NodeConfigurationInstallerPlugin/*.gcno # Code coverage report lcov.info +# Test artefacts +.stack-work-coverage* +*.blob \ No newline at end of file diff --git a/CHANGELOG.md b/CHANGELOG.md index e32a5b24ac..b8ecc9f9c0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ ## Unreleased changes +## 10.0.0 (DevNet) + - Updated the token module interface in accordance with adjustments to the PLT specification where token name, metadata and governance account are now optional in the token module initialization parameterts and @@ -9,6 +11,8 @@ without the parameters set will be rejected, so there are no observable changes to PLT behaviour. - Fixed the `build_catchup_url` in the Ubuntu build release pipeline. - Added boilerplate code for the upcoming P10. +- Extended the GRPC API to support submitting sponsored transactions. +- Support for sponsored transactions from protocol version 10. ## 9.0.7 diff --git a/concordium-base b/concordium-base index 3b735e1012..e1b1814de2 160000 --- a/concordium-base +++ b/concordium-base @@ -1 +1 @@ -Subproject commit 3b735e1012411208ec20d7bb2b2d224239a21150 +Subproject commit e1b1814de2d1e6b27a0ca5dcc058366718f09371 diff --git a/concordium-consensus/benchmarks/transactions/SchedulerBench/Helpers.hs b/concordium-consensus/benchmarks/transactions/SchedulerBench/Helpers.hs index 80826bbdfc..fe63bbc095 100644 --- a/concordium-consensus/benchmarks/transactions/SchedulerBench/Helpers.hs +++ b/concordium-consensus/benchmarks/transactions/SchedulerBench/Helpers.hs @@ -50,7 +50,7 @@ import qualified Concordium.Scheduler.Types as Types import Concordium.TimeMonad import qualified Data.Bifunctor as Bifunctor -getResults :: [(a, Types.TransactionSummary)] -> [(a, Types.ValidResult)] +getResults :: [(a, Types.TransactionSummary tov)] -> [(a, Types.ValidResult)] getResults = map $ Bifunctor.second Types.tsResult -- | The cost for processing a simple transfer (account to account) @@ -187,9 +187,9 @@ defaultContextState = } -- | Result from running the scheduler in a test environment. -data SchedulerResult = SchedulerResult +data SchedulerResult (tov :: Types.TransactionOutcomesVersion) = SchedulerResult { -- | The outcome for constructing a block. - srTransactions :: FilteredTransactions, + srTransactions :: FilteredTransactions tov, -- | The total execution cost of the block. srExecutionCosts :: Types.Amount, -- | The total execution energy of the block. @@ -204,7 +204,7 @@ runScheduler :: TestConfig -> BS.HashedPersistentBlockState pv -> Types.GroupedTransactions -> - PersistentBSM pv (SchedulerResult, BS.PersistentBlockState pv) + PersistentBSM pv (SchedulerResult (Types.TransactionOutcomesVersionFor pv), BS.PersistentBlockState pv) runScheduler TestConfig{..} stateBefore transactions = do blockStateBefore <- BS.thawBlockState stateBefore let txs = filterTransactions tcBlockSize (Time.timestampToUTCTime tcBlockTimeout) transactions @@ -226,16 +226,16 @@ runScheduler TestConfig{..} stateBefore transactions = do -- running transactions and the extractor, meaning the result of the extractor should not retain any -- references and should be fully evaluated. runSchedulerTest :: - forall pv a. - (Types.IsProtocolVersion pv) => + forall tov pv a. + (Types.IsProtocolVersion pv, tov ~ Types.TransactionOutcomesVersionFor pv) => TestConfig -> PersistentBSM pv (BS.HashedPersistentBlockState pv) -> - (SchedulerResult -> BS.PersistentBlockState pv -> PersistentBSM pv a) -> + (SchedulerResult tov -> BS.PersistentBlockState pv -> PersistentBSM pv a) -> Types.GroupedTransactions -> - IO (SchedulerResult, a) + IO (SchedulerResult tov, a) runSchedulerTest config constructState extractor transactions = runTestBlockState computation where - computation :: PersistentBSM pv (SchedulerResult, a) + computation :: PersistentBSM pv (SchedulerResult tov, a) computation = do blockStateBefore <- constructState (result, blockStateAfter) <- runScheduler config blockStateBefore transactions diff --git a/concordium-consensus/benchmarks/transactions/TransactionsBench.hs b/concordium-consensus/benchmarks/transactions/TransactionsBench.hs index 800376c519..ae3b5eaf55 100644 --- a/concordium-consensus/benchmarks/transactions/TransactionsBench.hs +++ b/concordium-consensus/benchmarks/transactions/TransactionsBench.hs @@ -40,7 +40,7 @@ initialBlockState = Helpers.makeTestAccountFromSeed 1_000_000 1 ] -assertApplied :: Bool -> Int -> Helpers.SchedulerResult -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv () +assertApplied :: Bool -> Int -> Helpers.SchedulerResult (TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv () assertApplied assertSuccess txnCount result _state = do let results = Helpers.getResults $ ftAdded (Helpers.srTransactions result) if length results /= txnCount diff --git a/concordium-consensus/src-lib/Concordium/External.hs b/concordium-consensus/src-lib/Concordium/External.hs index ef0ff94fbb..711576b429 100644 --- a/concordium-consensus/src-lib/Concordium/External.hs +++ b/concordium-consensus/src-lib/Concordium/External.hs @@ -757,6 +757,12 @@ stopBaker cptr = mask_ $ do -- +-------+---------------------------------------------+-----------------------------------------------------------------------------------------------+----------+ -- | 32 | ResultConsensusFailure | The consensus has thrown an exception and entered an unrecoverable state. | No | -- +-------+---------------------------------------------+-----------------------------------------------------------------------------------------------+----------+ +-- | 33 | ResultNonexistingSponsorAccount | No account corresponding to the transaction's sponsor exists. | No | +-- +-------+---------------------------------------------+-----------------------------------------------------------------------------------------------+----------+ +-- | 34 | ResultMissingSponsorAccount | The transaction includes a sponsor signature but no sponsor account. | No | +-- +-------+---------------------------------------------+-----------------------------------------------------------------------------------------------+----------+ +-- | 35 | ResultMissingSponsorSignature | The transaction includes a sponsor account but no sponsor signature. | No | +-- +-------+---------------------------------------------+-----------------------------------------------------------------------------------------------+----------+ type ReceiveResult = Int64 -- | Convert an 'UpdateResult' to the corresponding 'ReceiveResult' value. @@ -794,6 +800,9 @@ toReceiveResult ResultEnergyExceeded = 29 toReceiveResult ResultInsufficientFunds = 30 toReceiveResult ResultDoubleSign = 31 toReceiveResult ResultConsensusFailure = 32 +toReceiveResult ResultNonexistingSponsorAccount = 33 +toReceiveResult ResultMissingSponsorAccount = 34 +toReceiveResult ResultMissingSponsorSignature = 35 -- | Handle receipt of a block. -- The possible return codes are @ResultSuccess@, @ResultSerializationFail@, @@ -891,7 +900,8 @@ receiveFinalizationRecord bptr genIndex msg msgLen = do -- @ResultCredentialDeploymentInvalidIP@, @ResultCredentialDeploymentInvalidAR@, -- @ResultCredentialDeploymentExpired@, @ResultChainUpdateInvalidSequenceNumber@, -- @ResultChainUpdateInvalidEffectiveTime@, @ResultChainUpdateInvalidSignatures@, --- @ResultEnergyExceeded@. +-- @ResultEnergyExceeded@, @ResultNonexistingSponsorAccount@, +-- @ResultMissingSponsorAccount@, @ResultMissingSponsorSignature@. -- Additionally @ResultConsensusFailure@ is returned if an exception occurs. receiveTransaction :: StablePtr ConsensusRunner -> CString -> Int64 -> Ptr Word8 -> IO ReceiveResult receiveTransaction bptr transactionData transactionLen outPtr = do diff --git a/concordium-consensus/src-lib/Concordium/External/DryRun.hs b/concordium-consensus/src-lib/Concordium/External/DryRun.hs index 095d3ac5c8..cad90e55c2 100644 --- a/concordium-consensus/src-lib/Concordium/External/DryRun.hs +++ b/concordium-consensus/src-lib/Concordium/External/DryRun.hs @@ -755,12 +755,12 @@ dryRunTransaction dryRunPtr senderPtr energyLimit payloadPtr payloadLen sigPairs dreAvailableAmount = accBalance } shiQuotaRem - - lift (Scheduler.dispatchTransactionBody transaction src cost) >>= \case + let checkHeaderResult = Scheduler.CheckHeaderResult src src cost + lift (Scheduler.dispatchTransactionBody transaction checkHeaderResult) >>= \case Nothing -> do lift . lift . liftIO $ writeIORef shiQuotaRef 0 return $ Left OutOfEnergyQuota - Just (res :: TransactionSummary' ValidResultWithReturn) -> do + Just (res :: TransactionSummary' tov ValidResultWithReturn) -> do let newQuotaRem = shiQuotaRem - tsEnergyCost res lift . lift . liftIO $ writeIORef shiQuotaRef newQuotaRem diff --git a/concordium-consensus/src/Concordium/Birk/Bake.hs b/concordium-consensus/src/Concordium/Birk/Bake.hs index 19bd7be861..0a88d6c7ab 100644 --- a/concordium-consensus/src/Concordium/Birk/Bake.hs +++ b/concordium-consensus/src/Concordium/Birk/Bake.hs @@ -57,7 +57,7 @@ processTransactions :: BlockPointerType m -> Maybe FinalizerInfo -> BakerId -> - m (FilteredTransactions, ExecutionResult m) + m (FilteredTransactions (TransactionOutcomesVersionFor (MPV m)), ExecutionResult m) processTransactions slot ss bh mfinInfo bid = do -- update the focus block to the parent block (establish invariant needed by constructBlock) updateFocusBlockTo bh diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs index b7f49d4b8d..f64c31df5f 100644 --- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs @@ -441,7 +441,9 @@ class (Monad m, BlockStateTypes m) => ModuleQuery m where -- | We create a wrapper here so we can -- derive another 'HashableTo' instance which omits -- the exact 'RejectReason' in the resulting hash. -newtype TransactionSummaryV1 = TransactionSummaryV1 {_transactionSummaryV1 :: TransactionSummary' ValidResult} +newtype TransactionSummaryV1 (tov :: TransactionOutcomesVersion) = TransactionSummaryV1 + { _transactionSummaryV1 :: TransactionSummary' tov ValidResult + } deriving (Eq, Show) -- | A 'HashableTo' instance for a 'TransactionSummary'' which omits the exact @@ -452,12 +454,13 @@ newtype TransactionSummaryV1 = TransactionSummaryV1 {_transactionSummaryV1 :: Tr -- bytestring. The downside is more foreign calls to the hashing function, so -- there might be opportunities for small-scale optimizations here, but this -- needs careful benchmarks. -instance HashableTo H.Hash TransactionSummaryV1 where +instance HashableTo H.Hash (TransactionSummaryV1 tov) where getHash (TransactionSummaryV1 summary) = H.hashLazy $! S.runPutLazy $! S.putShortByteString "TransactionOutcomeHashV1" <> encodeSender (tsSender summary) + <> mapM_ (putMaybe S.put) (tsSponsorDetails summary) <> S.put (tsHash summary) <> S.put (tsCost summary) <> S.put (tsEnergyCost summary) @@ -485,14 +488,14 @@ instance HashableTo H.Hash TransactionSummaryV1 where S.putWord8 1 S.put sender -instance (MonadBlobStore m, MonadProtocolVersion m) => BlobStorable m TransactionSummaryV1 where +instance (MonadBlobStore m, MonadProtocolVersion m, tov ~ TransactionOutcomesVersionFor (MPV m)) => BlobStorable m (TransactionSummaryV1 tov) where storeUpdate s@(TransactionSummaryV1 ts) = return (putTransactionSummary ts, s) load = do s <- getTransactionSummary (protocolVersion @(MPV m)) return . return $! TransactionSummaryV1 s -- Generic instance based on the HashableTo instance -instance (Monad m) => MHashableTo m H.Hash TransactionSummaryV1 +instance (Monad m) => MHashableTo m H.Hash (TransactionSummaryV1 tov) -- | Operations on mutable token state. -- Note that 'updateTokenState' can only fail if a key is locked by an iterator. @@ -655,7 +658,7 @@ class getRewardStatus :: BlockState m -> m (RewardStatus' Epoch) -- | Get the outcome of a transaction in the given block. - getTransactionOutcome :: BlockState m -> TransactionIndex -> m (Maybe TransactionSummary) + getTransactionOutcome :: BlockState m -> TransactionIndex -> m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) -- | Get the transactionOutcomesHash of a given block. getTransactionOutcomesHash :: BlockState m -> m TransactionOutcomesHash @@ -664,7 +667,7 @@ class getStateHash :: BlockState m -> m StateHash -- | Get all transaction outcomes for this block. - getOutcomes :: BlockState m -> m (Vec.Vector TransactionSummary) + getOutcomes :: BlockState m -> m (Vec.Vector (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) -- | Get special transactions outcomes (for administrative transactions, e.g., baker reward) -- They should be returned in the order that they were emitted. @@ -1518,7 +1521,7 @@ class (BlockStateQuery m, PLTQuery (UpdatableBlockState m) (MutableTokenState m) bsoSetPaydayMintRate :: (PVSupportsDelegation (MPV m)) => UpdatableBlockState m -> MintRate -> m (UpdatableBlockState m) -- | Set the transaction outcomes for the block. - bsoSetTransactionOutcomes :: UpdatableBlockState m -> [TransactionSummary] -> m (UpdatableBlockState m) + bsoSetTransactionOutcomes :: UpdatableBlockState m -> [TransactionSummary (TransactionOutcomesVersionFor (MPV m))] -> m (UpdatableBlockState m) -- | Add a special transaction outcome. bsoAddSpecialTransactionOutcome :: UpdatableBlockState m -> SpecialTransactionOutcome -> m (UpdatableBlockState m) diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs index 3737c7b3ad..fed5d36d9f 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs @@ -693,16 +693,16 @@ emptyBlockRewardDetails = type PersistentBlockState (pv :: ProtocolVersion) = IORef (BufferedRef (BlockStatePointers pv)) -- | Transaction outcomes stored in a merkle binary tree. -data MerkleTransactionOutcomes = MerkleTransactionOutcomes +data MerkleTransactionOutcomes (tov :: TransactionOutcomesVersion) = MerkleTransactionOutcomes { -- | Normal transaction outcomes - mtoOutcomes :: LFMBT.LFMBTree TransactionIndex HashedBufferedRef TransactionSummaryV1, + mtoOutcomes :: LFMBT.LFMBTree TransactionIndex HashedBufferedRef (TransactionSummaryV1 tov), -- | Special transaction outcomes mtoSpecials :: LFMBT.LFMBTree TransactionIndex HashedBufferedRef Transactions.SpecialTransactionOutcome } deriving (Show) -- | Create an empty 'MerkleTransactionOutcomes' -emptyMerkleTransactionOutcomes :: MerkleTransactionOutcomes +emptyMerkleTransactionOutcomes :: MerkleTransactionOutcomes tov emptyMerkleTransactionOutcomes = MerkleTransactionOutcomes { mtoOutcomes = LFMBT.empty, @@ -720,9 +720,10 @@ emptyMerkleTransactionOutcomes = -- the hashing scheme is not a hash list but a merkle tree, so it is the root hash that is -- used in the final 'BlockHash'. data PersistentTransactionOutcomes (tov :: TransactionOutcomesVersion) where - PTOV0 :: TransactionOutcomes.TransactionOutcomes -> PersistentTransactionOutcomes 'TOV0 - PTOV1 :: MerkleTransactionOutcomes -> PersistentTransactionOutcomes 'TOV1 - PTOV2 :: MerkleTransactionOutcomes -> PersistentTransactionOutcomes 'TOV2 + PTOV0 :: TransactionOutcomes.TransactionOutcomes 'TOV0 -> PersistentTransactionOutcomes 'TOV0 + PTOV1 :: MerkleTransactionOutcomes 'TOV1 -> PersistentTransactionOutcomes 'TOV1 + PTOV2 :: MerkleTransactionOutcomes 'TOV2 -> PersistentTransactionOutcomes 'TOV2 + PTOV3 :: MerkleTransactionOutcomes 'TOV3 -> PersistentTransactionOutcomes 'TOV3 -- | Create an empty persistent transaction outcome emptyPersistentTransactionOutcomes :: forall tov. (IsTransactionOutcomesVersion tov) => PersistentTransactionOutcomes tov @@ -730,9 +731,10 @@ emptyPersistentTransactionOutcomes = case transactionOutcomesVersion @tov of STOV0 -> PTOV0 TransactionOutcomes.emptyTransactionOutcomesV0 STOV1 -> PTOV1 emptyMerkleTransactionOutcomes STOV2 -> PTOV2 emptyMerkleTransactionOutcomes + STOV3 -> PTOV3 emptyMerkleTransactionOutcomes instance - (BlobStorable m TransactionSummaryV1) => + (BlobStorable m (TransactionSummaryV1 tov), MonadProtocolVersion m, (TransactionOutcomesVersionFor (MPV m) ~ tov)) => MHashableTo m (TransactionOutcomes.TransactionOutcomesHashV tov) (PersistentTransactionOutcomes tov) where getHashM (PTOV0 bto) = return (getHash bto) @@ -750,6 +752,12 @@ instance return $! TransactionOutcomes.TransactionOutcomesHashV $ H.hashOfHashes (LFMBT.theLFMBTreeHash out) (LFMBT.theLFMBTreeHash special) + getHashM (PTOV3 MerkleTransactionOutcomes{..}) = do + out <- getHashM @_ @(LFMBT.LFMBTreeHash' 'BlockHashVersion1) mtoOutcomes + special <- getHashM @_ @(LFMBT.LFMBTreeHash' 'BlockHashVersion1) mtoSpecials + return $! + TransactionOutcomes.TransactionOutcomesHashV $ + H.hashOfHashes (LFMBT.theLFMBTreeHash out) (LFMBT.theLFMBTreeHash special) instance ( TransactionOutcomesVersionFor (MPV m) ~ tov, @@ -762,6 +770,7 @@ instance storeUpdate out = case out of PTOV1 mto -> (_2 %~ PTOV1) <$> inner mto PTOV2 mto -> (_2 %~ PTOV2) <$> inner mto + PTOV3 mto -> (_2 %~ PTOV3) <$> inner mto where inner MerkleTransactionOutcomes{..} = do (pout, mtoOutcomes') <- storeUpdate mtoOutcomes @@ -787,6 +796,13 @@ instance mtoOutcomes <- mout mtoSpecials <- mspecials return $! PTOV2 MerkleTransactionOutcomes{..} + STOV3 -> do + mout <- load + mspecials <- load + return $! do + mtoOutcomes <- mout + mtoSpecials <- mspecials + return $! PTOV3 MerkleTransactionOutcomes{..} -- | Create an empty 'PersistentTransactionOutcomes' based on the 'ProtocolVersion'. emptyTransactionOutcomes :: @@ -798,6 +814,7 @@ emptyTransactionOutcomes Proxy = case transactionOutcomesVersion @(TransactionOu STOV0 -> PTOV0 TransactionOutcomes.emptyTransactionOutcomesV0 STOV1 -> PTOV1 emptyMerkleTransactionOutcomes STOV2 -> PTOV2 emptyMerkleTransactionOutcomes + STOV3 -> PTOV3 emptyMerkleTransactionOutcomes -- | References to the components that make up the block state. -- @@ -3412,13 +3429,14 @@ doGetPoolStatus pbs psBakerId@(BakerId aid) = case delegationChainParameters @pv then return $ Just BakerPoolStatus{..} else return Nothing -doGetTransactionOutcome :: forall pv m. (SupportsPersistentState pv m) => PersistentBlockState pv -> Transactions.TransactionIndex -> m (Maybe TransactionSummary) +doGetTransactionOutcome :: forall tov pv m. (SupportsPersistentState pv m, TransactionOutcomesVersionFor pv ~ tov) => PersistentBlockState pv -> Transactions.TransactionIndex -> m (Maybe (TransactionSummary tov)) doGetTransactionOutcome pbs transHash = do bsp <- loadPBS pbs case bspTransactionOutcomes bsp of PTOV0 bto -> return $! bto ^? ix transHash PTOV1 bto -> fmap _transactionSummaryV1 <$> LFMBT.lookup transHash (mtoOutcomes bto) PTOV2 bto -> fmap _transactionSummaryV1 <$> LFMBT.lookup transHash (mtoOutcomes bto) + PTOV3 bto -> fmap _transactionSummaryV1 <$> LFMBT.lookup transHash (mtoOutcomes bto) doGetTransactionOutcomesHash :: forall pv m. @@ -3430,7 +3448,7 @@ doGetTransactionOutcomesHash pbs = do TransactionOutcomes.toTransactionOutcomesHash @(TransactionOutcomesVersionFor pv) <$> getHashM (bspTransactionOutcomes bsp) -doSetTransactionOutcomes :: forall pv m. (SupportsPersistentState pv m) => PersistentBlockState pv -> [TransactionSummary] -> m (PersistentBlockState pv) +doSetTransactionOutcomes :: forall tov pv m. (SupportsPersistentState pv m, tov ~ TransactionOutcomesVersionFor pv) => PersistentBlockState pv -> [TransactionSummary tov] -> m (PersistentBlockState pv) doSetTransactionOutcomes pbs transList = do bsp <- loadPBS pbs case bspTransactionOutcomes bsp of @@ -3447,8 +3465,11 @@ doSetTransactionOutcomes pbs transList = do PTOV2 _ -> do mto <- makeMTO storePBS pbs bsp{bspTransactionOutcomes = PTOV2 mto} + PTOV3 _ -> do + mto <- makeMTO + storePBS pbs bsp{bspTransactionOutcomes = PTOV3 mto} where - makeMTO :: m MerkleTransactionOutcomes + makeMTO :: m (MerkleTransactionOutcomes tov) makeMTO = do mtoOutcomes <- LFMBT.fromAscList . map TransactionSummaryV1 $ transList return MerkleTransactionOutcomes{mtoSpecials = LFMBT.empty, ..} @@ -3465,14 +3486,16 @@ doGetSpecialOutcomes pbs = do PTOV0 bto -> return (bto ^. TransactionOutcomes.outcomeSpecial) PTOV1 bto -> Seq.fromList <$> LFMBT.toAscList (mtoSpecials bto) PTOV2 bto -> Seq.fromList <$> LFMBT.toAscList (mtoSpecials bto) + PTOV3 bto -> Seq.fromList <$> LFMBT.toAscList (mtoSpecials bto) -doGetOutcomes :: (SupportsPersistentState pv m, MonadProtocolVersion m) => PersistentBlockState pv -> m (Vec.Vector TransactionSummary) +doGetOutcomes :: (SupportsPersistentState pv m, MonadProtocolVersion m) => PersistentBlockState pv -> m (Vec.Vector (TransactionSummary (TransactionOutcomesVersionFor pv))) doGetOutcomes pbs = do bsp <- loadPBS pbs case bspTransactionOutcomes bsp of PTOV0 bto -> return (TransactionOutcomes.outcomeValues bto) PTOV1 bto -> Vec.fromList . map _transactionSummaryV1 <$> LFMBT.toAscList (mtoOutcomes bto) PTOV2 bto -> Vec.fromList . map _transactionSummaryV1 <$> LFMBT.toAscList (mtoOutcomes bto) + PTOV3 bto -> Vec.fromList . map _transactionSummaryV1 <$> LFMBT.toAscList (mtoOutcomes bto) doAddSpecialTransactionOutcome :: (SupportsPersistentState pv m, MonadProtocolVersion m) => PersistentBlockState pv -> Transactions.SpecialTransactionOutcome -> m (PersistentBlockState pv) doAddSpecialTransactionOutcome pbs !o = do @@ -3490,6 +3513,9 @@ doAddSpecialTransactionOutcome pbs !o = do PTOV2 bto -> do (_, newSpecials) <- LFMBT.append o (mtoSpecials bto) storePBS pbs $! bsp{bspTransactionOutcomes = PTOV2 (bto{mtoSpecials = newSpecials})} + PTOV3 bto -> do + (_, newSpecials) <- LFMBT.append o (mtoSpecials bto) + storePBS pbs $! bsp{bspTransactionOutcomes = PTOV3 (bto{mtoSpecials = newSpecials})} doGetElectionDifficulty :: ( SupportsPersistentState pv m, diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs index bd373ac419..f702ccc302 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs @@ -902,12 +902,17 @@ instance mAcc <- getAccount lfbState $ transactionSender tr nonce <- maybe (pure minNonce) getAccountNonce (snd <$> mAcc) return $! nonce <= transactionNonce tr + ExtendedTransaction tr -> do + lfbState <- use (skovPersistentData . lastFinalized . to _bpState) + mAcc <- getAccount lfbState $ transactionSender tr + nonce <- maybe (pure minNonce) getAccountNonce (snd <$> mAcc) + return $! nonce <= transactionNonce tr -- We need to check here that the nonce is still ok with respect to the last finalized block, -- because it could be that a block was finalized thus the next account nonce being incremented -- after this transaction was received and pre-verified. CredentialDeployment{} -> not <$> memberTransactionTable wmdHash -- the sequence number will be checked by @Impl.addTransaction@. - _ -> return True + ChainUpdate{} -> return True if mayAddTransaction then do let ~(added, newTT) = addTransaction bi 0 verRes tt @@ -929,7 +934,7 @@ instance type FinTrans (PersistentTreeStateMonad state m) = [(TransactionHash, FinalizedTransactionStatus)] finalizeTransactions bh slot txs = mapM finTrans txs where - finTrans WithMetadata{wmdData = NormalTransaction tr, ..} = do + finAccountTrans WithMetadata{wmdData = tr, ..} = do let nonce = transactionNonce tr sender = accountAddressEmbed (transactionSender tr) anft <- use (skovPersistentData . transactionTable . ttNonFinalizedTransactions . at' sender . non emptyANFT) @@ -950,6 +955,8 @@ instance return ss else do logErrorAndThrowTS $ "Tried to finalize transaction which is not known to be in the set of non-finalized transactions for the sender " ++ show sender + finTrans WithMetadata{wmdData = NormalTransaction tr, ..} = + finAccountTrans WithMetadata{wmdData = TransactionV0 tr, ..} finTrans WithMetadata{wmdData = CredentialDeployment{}, ..} = deleteAndFinalizeStatus wmdHash finTrans WithMetadata{wmdData = ChainUpdate cu, ..} = do @@ -976,6 +983,8 @@ instance . at' uty ?= (nfcu & (nfcuMap . at' sn .~ Nothing) & (nfcuNextSequenceNumber .~ sn + 1)) return ss + finTrans WithMetadata{wmdData = ExtendedTransaction tr, ..} = + finAccountTrans WithMetadata{wmdData = TransactionV1 tr, ..} deleteAndFinalizeStatus txHash = do status <- preuse (skovPersistentData . transactionTable . ttHashMap . ix txHash . _2) diff --git a/concordium-consensus/src/Concordium/GlobalState/PurgeTransactions.hs b/concordium-consensus/src/Concordium/GlobalState/PurgeTransactions.hs index 341bff0e81..b5f095536e 100644 --- a/concordium-consensus/src/Concordium/GlobalState/PurgeTransactions.hs +++ b/concordium-consensus/src/Concordium/GlobalState/PurgeTransactions.hs @@ -225,7 +225,7 @@ filterTables :: -- | 'BlockHash' of block that transactions were added in BlockHash -> -- | Filtered transactions as a result of constructing the block. - FilteredTransactions -> + FilteredTransactions tov -> -- | Transaction table to update TransactionTable -> -- | Pending transaction table to update diff --git a/concordium-consensus/src/Concordium/GlobalState/TransactionTable.hs b/concordium-consensus/src/Concordium/GlobalState/TransactionTable.hs index 6f6a5d587c..f9d633f4a7 100644 --- a/concordium-consensus/src/Concordium/GlobalState/TransactionTable.hs +++ b/concordium-consensus/src/Concordium/GlobalState/TransactionTable.hs @@ -265,18 +265,26 @@ addTransaction blockItem@WithMetadata{..} cp !verRes tt0 = senderANFT = ttNonFinalizedTransactions . at' sender . non anft anft = emptyANFT nonce = transactionNonce tr - wmdtr = WithMetadata{wmdData = tr, ..} + wmdtr = WithMetadata{wmdData = TransactionV0 tr, ..} CredentialDeployment{} -> (True, tt1) ChainUpdate cu | tt0 ^. utNFCU . nfcuNextSequenceNumber <= sn -> (True, tt1 & utNFCU . nfcuMap . at' sn . non Map.empty . at' wmdcu ?~ verRes) + | otherwise -> (False, tt0) where uty = updateType (uiPayload cu) sn = updateSeqNumber (uiHeader cu) utNFCU :: Lens' TransactionTable NonFinalizedChainUpdates utNFCU = ttNonFinalizedChainUpdates . at' uty . non emptyNFCU wmdcu = WithMetadata{wmdData = cu, ..} - _ -> (False, tt0) + ExtendedTransaction tr -> (True, tt1 & senderANFT . anftMap . at' nonce . non Map.empty . at' wmdtr ?~ verRes) + where + sender = accountAddressEmbed (transactionSender tr) + senderANFT :: Lens' TransactionTable AccountNonFinalizedTransactions + senderANFT = ttNonFinalizedTransactions . at' sender . non anft + anft = emptyANFT + nonce = transactionNonce tr + wmdtr = WithMetadata{wmdData = TransactionV1 tr, ..} where tt1 = tt0 & ttHashMap . at' wmdHash ?~ (blockItem, Received cp verRes) @@ -414,6 +422,14 @@ forwardPTT trs ptt0 = foldl' forward1 ptt0 trs assert (low == updateSeqNumber (uiHeader biUpdate)) $ assert (low <= high) $ if low == high then Nothing else Just (low + 1, high) + forward1 ptt WithMetadata{wmdData = ExtendedTransaction tr} = ptt & pttWithSender . at' sender %~ upd + where + sender = accountAddressEmbed (transactionSender tr) + upd Nothing = error "forwardPTT : forwarding transaction that is not pending" + upd (Just (low, high)) = + assert (low == transactionNonce tr) $ + assert (low <= high) $ + if low == high then Nothing else Just (low + 1, high) -- | Update the pending transaction table by considering the supplied 'BlockItem's -- pending again. The 'BlockItem's must be ordered correctly with respect @@ -429,6 +445,13 @@ reversePTT trs ptt0 = foldr reverse1 ptt0 trs upd (Just (low, high)) = assert (low == transactionNonce tr + 1) $ Just (low - 1, high) + reverse1 WithMetadata{wmdData = ExtendedTransaction tr} = pttWithSender . at' sender %~ upd + where + sender = accountAddressEmbed (transactionSender tr) + upd Nothing = Just (transactionNonce tr, transactionNonce tr) + upd (Just (low, high)) = + assert (low == transactionNonce tr + 1) $ + Just (low - 1, high) reverse1 WithMetadata{wmdData = CredentialDeployment{}, ..} = pttDeployCredential %~ upd where upd ps = assert (not (HS.member wmdHash ps)) $ HS.insert wmdHash ps diff --git a/concordium-consensus/src/Concordium/GlobalState/TreeState.hs b/concordium-consensus/src/Concordium/GlobalState/TreeState.hs index e98fd2086c..55373b2964 100644 --- a/concordium-consensus/src/Concordium/GlobalState/TreeState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/TreeState.hs @@ -428,7 +428,7 @@ class -- | Hash of the block being constructed. BlockHash -> -- | Filtered transactions as a result of constructing the block. - FilteredTransactions -> + FilteredTransactions (TransactionOutcomesVersionFor (MPV m)) -> m () -- | Mark a transaction as no longer on a given block. This is used when a block is diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs index f83b7d8dc4..e9ad4e5e44 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs @@ -557,7 +557,7 @@ constructBlockTransactions :: Timestamp -> -- | Block state. UpdatableBlockState m -> - m (FilteredTransactions, TransactionExecutionResult m) + m (FilteredTransactions (TransactionOutcomesVersionFor (MPV m)), TransactionExecutionResult m) constructBlockTransactions runtimeParams startTime transTable pendingTable blockTimestamp theState0 = do -- The block energy limit and account creation limit are taken from the current chain parameters. chainParams <- bsoGetChainParameters theState0 @@ -726,7 +726,7 @@ constructBlockState :: TransactionTable -> PendingTransactionTable -> BlockExecutionData pv -> - m (FilteredTransactions, PBS.HashedPersistentBlockState pv, Energy) + m (FilteredTransactions (TransactionOutcomesVersionFor pv), PBS.HashedPersistentBlockState pv, Energy) constructBlockState runtimeParams transactionTable pendingTable execData@BlockExecutionData{..} = do seedState <- getSeedState bedParentState if seedState ^. shutdownTriggered diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Transactions.hs b/concordium-consensus/src/Concordium/KonsensusV1/Transactions.hs index 31e1c9e45a..65e7417f29 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Transactions.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Transactions.hs @@ -120,13 +120,8 @@ addPendingTransaction :: m () addPendingTransaction bi = do case wmdData bi of - NormalTransaction tx -> do - fbState <- bpState <$> (Impl._focusBlock <$> gets' Impl._skovPendingTransactions) - macct <- getAccount fbState $! transactionSender tx - nextNonce <- fromMaybe minNonce <$> mapM (getAccountNonce . snd) macct - when (nextNonce <= transactionNonce tx) $ do - Impl.pendingTransactionTable %=! TT.addPendingTransaction nextNonce tx - Impl.purgeTransactionTable False =<< currentTime + NormalTransaction tx -> addPendingAccountTransaction (TransactionV0 tx) + ExtendedTransaction tx -> addPendingAccountTransaction (TransactionV1 tx) CredentialDeployment _ -> do Impl.pendingTransactionTable %=! TT.addPendingDeployCredential txHash Impl.purgeTransactionTable False =<< currentTime @@ -138,6 +133,13 @@ addPendingTransaction bi = do Impl.purgeTransactionTable False =<< currentTime where txHash = getHash bi + addPendingAccountTransaction tx = do + fbState <- bpState <$> (Impl._focusBlock <$> gets' Impl._skovPendingTransactions) + macct <- getAccount fbState $! transactionSender tx + nextNonce <- fromMaybe minNonce <$> mapM (getAccountNonce . snd) macct + when (nextNonce <= transactionNonce tx) $ do + Impl.pendingTransactionTable %=! TT.addPendingTransaction nextNonce tx + Impl.purgeTransactionTable False =<< currentTime -- | Attempt to put the 'BlockItem' into the tree state. -- If the the 'BlockItem' was successfully added then it will be diff --git a/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Implementation.hs b/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Implementation.hs index e0d26eb09f..e6524875e8 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Implementation.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Implementation.hs @@ -845,7 +845,7 @@ finalizeTransactions :: m () finalizeTransactions = mapM_ removeTrans where - removeTrans WithMetadata{wmdData = NormalTransaction tr, ..} = do + removeAccountTrans WithMetadata{wmdData = tr, ..} = do let nonce = transactionNonce tr sender = accountAddressEmbed (transactionSender tr) anft <- use (transactionTable . TT.ttNonFinalizedTransactions . at' sender . non TT.emptyANFT) @@ -865,6 +865,10 @@ finalizeTransactions = mapM_ removeTrans -- If there are no non-finalized transactions left then remove the entry -- for the sender in @ttNonFinalizedTransactions@. transactionTable %=! TT.finalizeTransactionAt sender nonce + removeTrans WithMetadata{wmdData = NormalTransaction tr, ..} = do + removeAccountTrans (WithMetadata{wmdData = TransactionV0 tr, ..}) + removeTrans WithMetadata{wmdData = ExtendedTransaction tr, ..} = do + removeAccountTrans (WithMetadata{wmdData = TransactionV1 tr, ..}) removeTrans WithMetadata{wmdData = CredentialDeployment{}, ..} = do transactionTable . TT.ttHashMap . at' wmdHash .= Nothing removeTrans WithMetadata{wmdData = ChainUpdate cu, ..} = do diff --git a/concordium-consensus/src/Concordium/MultiVersion.hs b/concordium-consensus/src/Concordium/MultiVersion.hs index f2264f8c03..022a31e8c9 100644 --- a/concordium-consensus/src/Concordium/MultiVersion.hs +++ b/concordium-consensus/src/Concordium/MultiVersion.hs @@ -2115,6 +2115,7 @@ receiveTransaction transactionBS = handleMVRExceptionsWith (Nothing, Skov.Result _ -> return $! Skov.transactionVerificationResultToUpdateResult verRes (EVersionedConfigurationV1 (vc :: VersionedConfigurationV1 finconf pv)) -> withDeserializedTransaction (protocolVersion @pv) now $ \transaction -> do + logEvent Runner LLDebug $ "Transaction: " ++ show transaction st <- liftIO $ readIORef $ vc1State vc (known, verRes) <- SkovV1.evalSkovT (SkovV1.preverifyTransaction transaction) (vc1Context vc) st @@ -2132,7 +2133,9 @@ receiveTransaction transactionBS = handleMVRExceptionsWith (Nothing, Skov.Result else do -- A protocol update has occurred. receiveUnverified (Vec.last vvec') transaction - _ -> return $! Skov.transactionVerificationResultToUpdateResult verRes + _ -> do + logEvent Runner LLWarning $ "Transaction received: " ++ show transaction ++ " gave result " ++ show verRes + return $! Skov.transactionVerificationResultToUpdateResult verRes where withDeserializedTransaction :: SProtocolVersion spv -> diff --git a/concordium-consensus/src/Concordium/Queries.hs b/concordium-consensus/src/Concordium/Queries.hs index 37539cf830..9a976bdd79 100644 --- a/concordium-consensus/src/Concordium/Queries.hs +++ b/concordium-consensus/src/Concordium/Queries.hs @@ -39,7 +39,6 @@ import Concordium.Types.Conditionally import Concordium.Types.Execution ( Payload (..), SupplementEvents (..), - SupplementedTransactionSummary, TransactionIndex, TransactionSummary, addInitializeParameter, @@ -834,7 +833,7 @@ getBlockTransactionSummaries = return $! supplementOutcomes (protocolVersion @pv) outcomes transactions supplementOutcomes :: SProtocolVersion pv -> - Vec.Vector TransactionSummary -> + Vec.Vector (TransactionSummary (TransactionOutcomesVersionFor pv)) -> [BlockItem] -> Either String (Vec.Vector SupplementedTransactionSummary) supplementOutcomes spv outcomes transactions = @@ -844,7 +843,7 @@ getBlockTransactionSummaries = Right (_, _) -> Left "Block has more transactions than outcomes" supplement :: SProtocolVersion pv -> - TransactionSummary -> + TransactionSummary (TransactionOutcomesVersionFor pv) -> State.StateT [BlockItem] (Either String) SupplementedTransactionSummary supplement spv ts = do items <- State.get @@ -853,14 +852,15 @@ getBlockTransactionSummaries = (item : items') -> do State.put items' let mInitParam = do - accTransaction <- case wmdData item of - NormalTransaction t -> return t + payload <- case wmdData item of + NormalTransaction t -> return (transactionPayload t) + ExtendedTransaction t -> return (transactionPayload t) _ -> Left "Initialization event is not for an account transaction" - decoded <- decodePayload spv (atrPayload accTransaction) + decoded <- decodePayload spv payload case decoded of InitContract{..} -> return icParam _ -> Left "Initialization event is not for a contract initialization" - lift $ supplementEvents (addInitializeParameter mInitParam) ts + lift $ toSupplementedTransactionSummary <$> supplementEvents (addInitializeParameter mInitParam) ts -- | Get the transaction outcomes in the block. getBlockSpecialEvents :: forall finconf. BlockHashInput -> MVR finconf (BHIQueryResponse (Seq.Seq SpecialTransactionOutcome)) @@ -1646,14 +1646,17 @@ getTransactionStatus trHash = -- Helper to convert a 'TransactionSummary' to a 'SupplementedTransactionSummary' given the -- 'BlockItem' corresponding to the originating transaction. supplementTransactionSummary :: - SProtocolVersion pv -> Maybe BlockItem -> Maybe TransactionSummary -> Maybe SupplementedTransactionSummary + SProtocolVersion pv -> + Maybe BlockItem -> + Maybe (TransactionSummary (TransactionOutcomesVersionFor pv)) -> + Maybe SupplementedTransactionSummary supplementTransactionSummary spv mbi mts = do ts <- mts let mip = do (NormalTransaction acctTransaction) <- wmdData <$> mbi (InitContract{..}) <- decodePayload spv (atrPayload acctTransaction) ^? _Right return icParam - supplementEvents (addInitializeParameter mip) ts + toSupplementedTransactionSummary <$> supplementEvents (addInitializeParameter mip) ts -- * Smart contract invocations invokeContract :: BlockHashInput -> InvokeContract.ContractContext -> MVR finconf (BHIQueryResponse InvokeContract.InvokeContractResult) diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs index f83c324ca8..e2d9663731 100644 --- a/concordium-consensus/src/Concordium/Scheduler.hs +++ b/concordium-consensus/src/Concordium/Scheduler.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE EmptyCase #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -36,6 +37,7 @@ module Concordium.Scheduler ( filterTransactions, runTransactions, execTransactions, + CheckHeaderResult (..), dispatchTransactionBody, handleContractUpdateV1, handleContractUpdateV0, @@ -104,13 +106,25 @@ import Concordium.GlobalState.Persistent.BlockState.ProtocolLevelTokens (PLTConf import qualified Concordium.Scheduler.ProtocolLevelTokens.Module as TokenModule import Concordium.Scheduler.WasmIntegration.V1 (ReceiveResultData (rrdCurrentState)) import Concordium.Types.Accounts +import Concordium.Types.Option import Concordium.Wasm (IsWasmVersion) import qualified Concordium.Wasm as GSWasm import Data.Either (isLeft) import Data.Proxy import Prelude hiding (exp, mod) +data CheckHeaderResult m = CheckHeaderResult + { -- | The sender account for the transaction. + chrSenderAccount :: !(IndexedAccount m), + -- | The account that is paying the transaction fees for the transaction. + -- For a sponsored transaction, this is the sponsor. Otherwise, it is the sender. + chrPayerAccount :: !(IndexedAccount m), + -- | The energy cost to charge for checking the header. + chrCheckHeaderCost :: !Energy + } + -- | The function asserts the following +-- * if the transaction is an 'AccountTransactionV1', then the protocol version supports sponsored transactions. -- * the transaction has a valid sender, -- * the amount corresponding to the deposited energy is on the sender account, -- * the transaction is not expired, @@ -125,12 +139,22 @@ import Prelude hiding (exp, mod) -- Important! If @mVerRes@ is `Just VerificationResult` then it MUST be the `VerificationResult` matching the provided transaction. -- -- Returns the sender account and the cost to be charged for checking the header. -checkHeader :: forall msg m. (TransactionData msg, SchedulerMonad m) => msg -> Maybe TVer.VerificationResult -> ExceptT (Maybe FailureKind) m (IndexedAccount m, Energy) +checkHeader :: + forall msg m. + (TransactionData msg, SchedulerMonad m) => + msg -> + Maybe TVer.VerificationResult -> + ExceptT (Maybe FailureKind) m (CheckHeaderResult m) checkHeader meta mVerRes = do + case sSupportsSponsoredTransactions (protocolVersion @(MPV m)) of + SFalse + | transactionIsExtended meta -> + throwError $ Just NotSupportedAtCurrentProtocolVersion + _ -> return () unless (validatePayloadSize (protocolVersion @(MPV m)) (thPayloadSize (transactionHeader meta))) $ throwError $ Just InvalidPayloadSize -- Before even checking the header we calculate the cost that will be charged for this -- and check that at least that much energy is deposited and remaining from the maximum block energy. - let cost = Cost.baseCost (getTransactionHeaderPayloadSize $ transactionHeader meta) (getTransactionNumSigs (transactionSignature meta)) + let cost = transactionBaseCost meta remainingBlockEnergy <- lift getRemainingEnergy -- check that enough energy is remaining for the block. unless (remainingBlockEnergy >= cost) $ throwError Nothing @@ -139,52 +163,72 @@ checkHeader meta mVerRes = do cm <- lift getChainMetadata when (transactionExpired (thExpiry $ transactionHeader meta) $ slotTime cm) $ throwError . Just $ ExpiredTransaction - let addr = transactionSender meta - miacc <- lift (getStateAccount addr) - case miacc of - -- check if the sender is present on the chain. - Nothing -> throwError (Just $ UnknownAccount addr) - Just iacc -> do - -- The sender exists and thus we continue verifying the transaction. - - -- We check if we previously have deemed the transaction valid and check if the - -- current account information matches with one at the point of verification. - -- Also we check that the nonce is valid and that the sender has enough funds to cover his transfer. - let acc = snd iacc - case mVerRes of - Just (TVer.Ok (TVer.NormalTransactionSuccess keysHash _)) -> do - currentKeys <- lift (TVer.getAccountVerificationKeys acc) - -- Check that the keys match from initial verification. - -- If they match we skip checking the signature as it has already been verified. - if ID.matchesAccountInformation currentKeys keysHash - then do - checkNonceAndFunds acc - return (iacc, cost) - -- the account information has changed, so we re-verify the signature. - else do - unless (verifyTransaction currentKeys meta) (throwError $ Just IncorrectSignature) - checkNonceAndFunds acc - return (iacc, cost) - -- An invalid verification result or `Nothing` was supplied to this function. - -- In either case we verify the transaction now. - -- Note: we do not have special handling for 'TVer.TrustedSuccess'. - -- Since the case is uncommon, it is reasonable to redo the verification. - _ -> do - newVerRes <- lift (TVer.verifyNormalTransaction meta) - case checkTransactionVerificationResult newVerRes of - Left failure -> throwError . Just $ failure - Right _ -> return (iacc, cost) - where - -- check that the nonce is ok and that the sender has enough funds to cover the transaction fee deposit. - checkNonceAndFunds acc = do - -- Check that the nonce is still 'Ok'. - nextNonce <- lift (TVer.getNextAccountNonce acc) - let nonce = transactionNonce meta - unless (nonce == nextNonce) $ throwError (Just $ NonSequentialNonce nonce) - -- Check that the account still has enough funds to cover the deposit - amnt <- lift (TVer.getAccountAvailableAmount acc) - depositedAmount <- lift (TVer.energyToCcd (transactionGasAmount meta)) - unless (depositedAmount <= amnt) $ throwError $ Just InsufficientFunds + let senderAddr = transactionSender meta + -- Check that the sender is present on the chain. + senderAccount <- + lift (getStateAccount senderAddr) >>= \case + Nothing -> throwError (Just $ UnknownAccount senderAddr) + Just senderAccount -> return senderAccount + -- Check that the sponsor (if any) is present on the chain. + -- If there is no sponsor, payerAccount will be the senderAccount. + payerAccount <- case transactionSponsor meta of + Nothing -> return senderAccount + Just sponsorAddr -> + lift (getStateAccount sponsorAddr) >>= \case + Nothing -> throwError (Just $ UnknownAccount sponsorAddr) + Just sponsorAccount -> return sponsorAccount + -- The sender exists and thus we continue verifying the transaction. + + -- We check if we previously have deemed the transaction valid and check if the + -- current account information matches with one at the point of verification. + -- Also we check that the nonce is valid and that the sender has enough funds to cover his transfer. + let bodyHash = transactionSignHashToByteString (transactionSignHash meta) + -- Raise an error if the account keys have changed since the previous verification and + -- the signature cannot be verified with the updated keys. + validateAccountKeys account expectedKeys signature = do + actualKeys <- lift (TVer.getAccountVerificationKeys (snd account)) + unless (ID.matchesAccountInformation actualKeys expectedKeys) $ do + -- The account keys have changed, so we re-verify the signature. + -- Note, the keys changing does not automatically mean the signature is invalid, + -- since it could be a subset of keys that have not changed. + unless (verifyAccountSignature bodyHash (tsSignatures signature) actualKeys) $ + throwError (Just IncorrectSignature) + -- Raise an error if the sender's nonce is incorrect or the payer has insufficient funds. + checkNonceAndFunds = do + -- Check that the sender's nonce is OK. + nextNonce <- lift (TVer.getNextAccountNonce (snd senderAccount)) + let nonce = transactionNonce meta + unless (nonce == nextNonce) $ throwError (Just $ NonSequentialNonce nonce) + -- Check that the payer account still has enough funds to cover the deposit + amnt <- lift (TVer.getAccountAvailableAmount (snd payerAccount)) + depositedAmount <- lift (TVer.energyToCcd (transactionGasAmount meta)) + unless (depositedAmount <= amnt) $ throwError $ Just InsufficientFunds + case mVerRes of + Just (TVer.Ok (TVer.NormalTransactionSuccess keysHash _)) + | Nothing <- transactionSponsorSignature meta -> do + validateAccountKeys senderAccount keysHash (transactionSignature meta) + checkNonceAndFunds + Just (TVer.Ok (TVer.ExtendedTransactionSuccess{sponsorKeysHash = Absent, ..})) + | Nothing <- transactionSponsorSignature meta -> do + validateAccountKeys senderAccount senderKeysHash (transactionSignature meta) + checkNonceAndFunds + Just (TVer.Ok (TVer.ExtendedTransactionSuccess{sponsorKeysHash = Present sponsorHash, ..})) + | Just sponsorSig <- transactionSponsorSignature meta -> do + validateAccountKeys senderAccount senderKeysHash (transactionSignature meta) + validateAccountKeys payerAccount sponsorHash sponsorSig + checkNonceAndFunds + -- An invalid verification result or `Nothing` was supplied to this function. + -- In either case we verify the transaction now. + -- Note: we do not have special handling for 'TVer.TrustedSuccess'. + -- Since the case is uncommon, it is reasonable to redo the verification. + _ -> do + -- Although the transaction may be a normal (non-extended) transaction, we verify it + -- as an extended transaction, which should produce the same result + newVerRes <- lift (TVer.verifyExtendedTransaction meta) + case checkTransactionVerificationResult newVerRes of + Left failure -> throwError . Just $ failure + Right _ -> return () + return (CheckHeaderResult senderAccount payerAccount cost) -- | Maps transaction verification results into Either `FailureKind`s. or `OkResult`s checkTransactionVerificationResult :: TVer.VerificationResult -> Either FailureKind TVer.OkResult @@ -200,6 +244,7 @@ checkTransactionVerificationResult (TVer.MaybeOk (TVer.NormalTransactionInvalidN checkTransactionVerificationResult (TVer.MaybeOk TVer.NormalTransactionInvalidSignatures) = Left IncorrectSignature checkTransactionVerificationResult (TVer.MaybeOk TVer.NormalTransactionInsufficientFunds) = Left InsufficientFunds checkTransactionVerificationResult (TVer.MaybeOk TVer.NormalTransactionEnergyExceeded) = Left ExceedsMaxBlockEnergy +checkTransactionVerificationResult (TVer.MaybeOk (TVer.ExtendedTransactionInvalidSponsor aaddr)) = Left $ UnknownAccount aaddr -- 'NotOk' mappings checkTransactionVerificationResult (TVer.NotOk (TVer.CredentialDeploymentDuplicateAccountRegistrationID regId)) = Left $ DuplicateAccountRegistrationID regId checkTransactionVerificationResult (TVer.NotOk TVer.CredentialDeploymentInvalidSignatures) = Left AccountCredentialInvalid @@ -211,6 +256,8 @@ checkTransactionVerificationResult (TVer.NotOk (TVer.NormalTransactionDuplicateN checkTransactionVerificationResult (TVer.NotOk TVer.Expired) = Left ExpiredTransaction checkTransactionVerificationResult (TVer.NotOk TVer.InvalidPayloadSize) = Left InvalidPayloadSize checkTransactionVerificationResult (TVer.NotOk TVer.ChainUpdateEffectiveTimeNonZeroForCreatePLT) = Left InvalidUpdateTime +checkTransactionVerificationResult (TVer.NotOk TVer.SponsoredTransactionMissingSponsor) = Left MissingSponsorAccount +checkTransactionVerificationResult (TVer.NotOk TVer.SponsoredTransactionMissingSponsorSignature) = Left MissingSponsorSignature -- | Execute a transaction on the current block state, charging valid accounts -- for the resulting energy cost. @@ -229,14 +276,14 @@ checkTransactionVerificationResult (TVer.NotOk TVer.ChainUpdateEffectiveTimeNonZ -- * @Nothing@ if the transaction would exceed the remaining block energy. -- * @Just result@ if the transaction failed ('TxInvalid') or was successfully committed -- ('TxValid', with either 'TxSuccess' or 'TxReject'). -dispatch :: forall msg m. (TransactionData msg, SchedulerMonad m) => (msg, Maybe TVer.VerificationResult) -> m (Maybe TxResult) +dispatch :: forall msg m. (TransactionData msg, SchedulerMonad m) => (msg, Maybe TVer.VerificationResult) -> m (Maybe (TxResult (TransactionOutcomesVersionFor (MPV m)))) dispatch (msg, mVerRes) = do validMeta <- runExceptT (checkHeader msg mVerRes) case validMeta of Left (Just fk) -> return $ Just (TxInvalid fk) Left Nothing -> return Nothing - Right (senderAccount, checkHeaderCost) -> do - res <- dispatchTransactionBody msg senderAccount checkHeaderCost + Right checkHeaderRes -> do + res <- dispatchTransactionBody msg checkHeaderRes case res of -- The remaining block energy is not sufficient for the handler to execute the transaction. Nothing -> return Nothing @@ -261,35 +308,34 @@ dispatchTransactionBody :: (TransactionData msg, SchedulerMonad m, TransactionResult res) => -- | Transaction to execute. msg -> - -- | Sender account. - IndexedAccount m -> - -- | Energy cost to be charged for checking the transaction header. - Energy -> - m (Maybe (TransactionSummary' res)) -dispatchTransactionBody msg senderAccount checkHeaderCost = do + -- | Sender/sponsor account and header check energy cost. + CheckHeaderResult m -> + m (Maybe (TransactionSummary' (TransactionOutcomesVersionFor (MPV m)) res)) +dispatchTransactionBody msg CheckHeaderResult{..} = do let meta = transactionHeader msg -- At this point the transaction is going to be committed to the block. -- It could be that the execution exceeds maximum block energy allowed, but in that case -- the whole block state will be removed, and thus this operation will have no effect anyhow. -- Hence we can increase the account nonce of the sender account. - increaseAccountNonce senderAccount + increaseAccountNonce chrSenderAccount tsIndex <- bumpTransactionIndex -- Payload is not parametrised by the protocol version, but decodePayload only returns -- payloads appropriate to the protocol version. case decodePayload (protocolVersion @(MPV m)) (transactionPayload msg) of Left _ -> do - -- In case of serialization failure we charge the sender for checking + -- In case of serialization failure we charge the payer for checking -- the header and reject the transaction; we have checked that the amount -- exists on the account with 'checkHeader'. - payment <- energyToGtu checkHeaderCost - chargeExecutionCost senderAccount payment + payment <- energyToGtu chrCheckHeaderCost + chargeExecutionCost chrPayerAccount payment return $ Just $ TransactionSummary - { tsEnergyCost = checkHeaderCost, + { tsEnergyCost = chrCheckHeaderCost, tsCost = payment, tsSender = Just (thSender meta), -- the sender of the transaction is as specified in the transaction. + tsSponsorDetails = conditionally cHasSponsorDetails Nothing, tsResult = transactionReject SerializationFailure, tsHash = transactionHash msg, tsType = TSTAccountTransaction Nothing, @@ -299,13 +345,15 @@ dispatchTransactionBody msg senderAccount checkHeaderCost = do usedBlockEnergy <- getUsedEnergy let mkWTC _wtcTransactionType = WithDepositContext - { _wtcSenderAccount = senderAccount, + { _wtcSenderAccount = chrSenderAccount, + _wtcPayerAccount = chrPayerAccount, _wtcTransactionHash = transactionHash msg, _wtcSenderAddress = thSender meta, + _wtcSponsorAddress = transactionSponsor msg, _wtcEnergyAmount = thEnergyAmount meta, - _wtcTransactionCheckHeaderCost = checkHeaderCost, + _wtcTransactionCheckHeaderCost = chrCheckHeaderCost, -- NB: We already account for the cost we used here. - _wtcCurrentlyUsedBlockEnergy = usedBlockEnergy + checkHeaderCost, + _wtcCurrentlyUsedBlockEnergy = usedBlockEnergy + chrCheckHeaderCost, _wtcTransactionIndex = tsIndex, .. } @@ -413,6 +461,7 @@ dispatchTransactionBody msg senderAccount checkHeaderCost = do onlyWithPLT c = case sSupportsPLT (accountVersion @(AccountVersionFor (MPV m))) of SFalse -> error "Operation unsupported at this protocol version." STrue -> c + cHasSponsorDetails = (sHasSponsorDetails (sTransactionOutcomesVersionFor (protocolVersion @(MPV m)))) handleTransferWithSchedule :: forall m. @@ -422,7 +471,7 @@ handleTransferWithSchedule :: [(Timestamp, Amount)] -> -- | Nothing in case of a TransferWithSchedule and Just in case of a TransferWithScheduleAndMemo Maybe Memo -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleTransferWithSchedule wtc twsTo twsSchedule maybeMemo = withDeposit wtc c k where senderAccount = wtc ^. wtcSenderAccount @@ -489,23 +538,17 @@ handleTransferWithSchedule wtc twsTo twsSchedule maybeMemo = withDeposit wtc c k withScheduledAmount senderAccount targetAccount transferAmount twsSchedule txHash $ return () k ls () = do - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost commitChanges (ls ^. changeSet) let eventList = TransferredWithSchedule{etwsFrom = senderAddress, etwsTo = twsTo, etwsAmount = twsSchedule} : (TransferMemo <$> maybeToList maybeMemo) - return - ( TxSuccess eventList, - energyCost, - usedEnergy - ) + return (TxSuccess eventList) handleTransferToPublic :: (SchedulerMonad m) => WithDepositContext m -> SecToPubAmountTransferData -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleTransferToPublic wtc transferData@SecToPubAmountTransferData{..} = do cryptoParams <- TVer.getCryptographicParameters withDeposit wtc (c cryptoParams) k @@ -537,12 +580,10 @@ handleTransferToPublic wtc transferData@SecToPubAmountTransferData{..} = do return senderAmount k ls senderAmount = do - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost notifyEncryptedBalanceChange $ amountDiff 0 stpatdTransferAmount commitChanges (ls ^. changeSet) - return - ( TxSuccess + return $ + TxSuccess [ EncryptedAmountsRemoved { earAccount = senderAddress, earUpToIndex = stpatdIndex, @@ -553,16 +594,13 @@ handleTransferToPublic wtc transferData@SecToPubAmountTransferData{..} = do { aabdAccount = senderAddress, aabdAmount = stpatdTransferAmount } - ], - energyCost, - usedEnergy - ) + ] handleTransferToEncrypted :: (SchedulerMonad m) => WithDepositContext m -> Amount -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleTransferToEncrypted wtc toEncrypted = do cryptoParams <- TVer.getCryptographicParameters withDeposit wtc (c cryptoParams) k @@ -589,22 +627,17 @@ handleTransferToEncrypted wtc toEncrypted = do return encryptedAmount k ls encryptedAmount = do - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost notifyEncryptedBalanceChange $ amountToDelta toEncrypted commitChanges (ls ^. changeSet) - return - ( TxSuccess + return $ + TxSuccess [ EncryptedSelfAmountAdded { eaaAccount = senderAddress, eaaNewAmount = encryptedAmount, eaaAmount = toEncrypted } - ], - energyCost, - usedEnergy - ) + ] handleEncryptedAmountTransfer :: forall m. @@ -615,7 +648,7 @@ handleEncryptedAmountTransfer :: EncryptedAmountTransferData -> -- | Nothing in case of an EncryptedAmountTransfer and Just in case of an EncryptedAmountTransferWithMemo Maybe Memo -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleEncryptedAmountTransfer wtc toAddress transferData@EncryptedAmountTransferData{..} maybeMemo = do cryptoParams <- TVer.getCryptographicParameters withDeposit wtc (c cryptoParams) k @@ -679,8 +712,6 @@ handleEncryptedAmountTransfer wtc toAddress transferData@EncryptedAmountTransfer return (targetAccountEncryptedAmountIndex, senderAmount) k ls (targetAccountEncryptedAmountIndex, senderAmount) = do - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost commitChanges (ls ^. changeSet) let eventList = [ EncryptedAmountsRemoved @@ -696,12 +727,7 @@ handleEncryptedAmountTransfer wtc toAddress transferData@EncryptedAmountTransfer } ] ++ (TransferMemo <$> maybeToList maybeMemo) - - return - ( TxSuccess eventList, - energyCost, - usedEnergy - ) + return (TxSuccess eventList) -- | Handle the deployment of a module. handleDeployModule :: @@ -710,11 +736,10 @@ handleDeployModule :: WithDepositContext m -> -- | The module to deploy. Wasm.WasmModule -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleDeployModule wtc mod = withDeposit wtc c k where - senderAccount = wtc ^. wtcSenderAccount currentProtocolVersion = demoteProtocolVersion (protocolVersion @(MPV m)) c = do @@ -739,15 +764,13 @@ handleDeployModule wtc mod = return (Right (iface, moduleV1), mhash) _ -> rejectTransaction ModuleNotWF - k ls (toCommit, mhash) = do - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost + k _ls (toCommit, mhash) = do -- Add the module to the global state (module interface, value interface and module itself). -- We know the module does not exist at this point, so we can ignore the return value. case toCommit of Left v0 -> () <$ commitModule v0 Right v1 -> () <$ commitModule v1 - return (TxSuccess [ModuleDeployed mhash], energyCost, usedEnergy) + return (TxSuccess [ModuleDeployed mhash]) -- | Tick energy for storing the given contract state for V0 contracts. V1 -- contract storage works differently, we charge based only on the part of the @@ -806,7 +829,7 @@ handleInitContract :: Wasm.InitName -> -- | Parameter expression to initialize with. Wasm.Parameter -> - m (Maybe (TransactionSummary' res)) + m (Maybe (TransactionSummary' (TransactionOutcomesVersionFor (MPV m)) res)) handleInitContract wtc initAmount modref initName param = withDeposit wtc c k where @@ -902,8 +925,6 @@ handleInitContract wtc initAmount modref initName param = k ls (Left (iface, result)) = do let model = Wasm.newState result - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost -- Withdraw the amount the contract is initialized with from the sender account. cs' <- addAmountToCS senderAccount (amountDiff 0 initAmount) (ls ^. changeSet) @@ -923,8 +944,8 @@ handleInitContract wtc initAmount modref initName param = -- add the contract initialization to the change set and commit the changes commitChanges $ addContractInitToCS (Proxy @m) newInstanceAddr cs' - return - ( transactionSuccess + return $ + transactionSuccess [ ContractInitialized { ecRef = modref, ecAddress = newInstanceAddr, @@ -934,14 +955,9 @@ handleInitContract wtc initAmount modref initName param = ecEvents = Wasm.logs result, ecParameter = CFalse } - ], - energyCost, - usedEnergy - ) + ] k ls (Right (iface, result)) = do let model = WasmV1.irdNewState result - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost -- Withdraw the amount the contract is initialized with from the sender account. cs' <- addAmountToCS senderAccount (amountDiff 0 initAmount) (ls ^. changeSet) @@ -961,8 +977,8 @@ handleInitContract wtc initAmount modref initName param = -- add the contract initialization to the change set and commit the changes commitChanges $ addContractInitToCS (Proxy @m) newInstanceAddr cs' - return - ( transactionSuccess + return $ + transactionSuccess [ ContractInitialized { ecRef = modref, ecAddress = newInstanceAddr, @@ -972,10 +988,7 @@ handleInitContract wtc initAmount modref initName param = ecEvents = WasmV1.irdLogs result, ecParameter = CFalse } - ], - energyCost, - usedEnergy - ) + ] handleSimpleTransfer :: (SchedulerMonad m) => @@ -986,9 +999,9 @@ handleSimpleTransfer :: Amount -> -- | Nothing in case of a Transfer and Just in case of a TransferWithMemo Maybe Memo -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleSimpleTransfer wtc toAddr transferamount maybeMemo = - withDeposit wtc c (defaultSuccess wtc) + withDeposit wtc c defaultSuccess where senderAccount = wtc ^. wtcSenderAccount senderAddress = wtc ^. wtcSenderAddress @@ -1019,9 +1032,9 @@ handleUpdateContract :: Wasm.ReceiveName -> -- | Message to send to the receive method. Wasm.Parameter -> - m (Maybe (TransactionSummary' res)) + m (Maybe (TransactionSummary' (TransactionOutcomesVersionFor (MPV m)) res)) handleUpdateContract wtc uAmount uAddress uReceiveName uMessage = - withDeposit wtc computeAndCharge (defaultSuccess wtc) + withDeposit wtc computeAndCharge defaultSuccess where senderAccount = wtc ^. wtcSenderAccount senderAddress = wtc ^. wtcSenderAddress @@ -1984,7 +1997,7 @@ handleAddBaker :: Amount -> -- | Whether to restake the baker's earnings Bool -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleAddBaker wtc abElectionVerifyKey abSignatureVerifyKey abAggregationVerifyKey abProofSig abProofElection abProofAggregation abBakingStake abRestakeEarnings = withDeposit wtc c k where @@ -1995,10 +2008,7 @@ handleAddBaker wtc abElectionVerifyKey abSignatureVerifyKey abAggregationVerifyK -- Get the total amount on the account, including locked amounts, -- less the deposit. getCurrentAccountTotalAmount senderAccount - k ls accountBalance = do - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost - + k _ls accountBalance = do let challenge = addBakerChallenge senderAddress abElectionVerifyKey abSignatureVerifyKey abAggregationVerifyKey electionP = checkElectionKeyProof challenge abElectionVerifyKey abProofElection signP = checkSignatureVerifyKeyProof challenge abSignatureVerifyKey abProofSig @@ -2006,7 +2016,7 @@ handleAddBaker wtc abElectionVerifyKey abSignatureVerifyKey abAggregationVerifyK if accountBalance < abBakingStake then -- The balance is insufficient. - return (TxReject InsufficientBalanceForBakerStake, energyCost, usedEnergy) + return (TxReject InsufficientBalanceForBakerStake) else if electionP && signP && aggregationP then do @@ -2037,14 +2047,14 @@ handleAddBaker wtc abElectionVerifyKey abSignatureVerifyKey abAggregationVerifyK ebaStake = abBakingStake, ebaRestakeEarnings = abRestakeEarnings } - return (TxSuccess [baddEvt], energyCost, usedEnergy) + return (TxSuccess [baddEvt]) BI.BAInvalidAccount -> -- This case should not be possible because the account was already resolved - return (TxReject (InvalidAccountReference senderAddress), energyCost, usedEnergy) - BI.BAAlreadyBaker bid -> return (TxReject (AlreadyABaker bid), energyCost, usedEnergy) - BI.BADuplicateAggregationKey -> return (TxReject (DuplicateAggregationKey abAggregationVerifyKey), energyCost, usedEnergy) - BI.BAStakeUnderThreshold -> return (TxReject StakeUnderMinimumThresholdForBaking, energyCost, usedEnergy) - else return (TxReject InvalidProof, energyCost, usedEnergy) + return (TxReject (InvalidAccountReference senderAddress)) + BI.BAAlreadyBaker bid -> return (TxReject (AlreadyABaker bid)) + BI.BADuplicateAggregationKey -> return (TxReject (DuplicateAggregationKey abAggregationVerifyKey)) + BI.BAStakeUnderThreshold -> return (TxReject StakeUnderMinimumThresholdForBaking) + else return (TxReject InvalidProof) -- | Argument to configure baker 'withDeposit' continuation. data ConfigureBakerCont (av :: AccountVersion) @@ -2096,7 +2106,7 @@ handleConfigureBaker :: Maybe AmountFraction -> -- | Whether to suspend/resume the baker. Maybe Bool -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleConfigureBaker wtc cbCapital @@ -2108,7 +2118,7 @@ handleConfigureBaker cbBakingRewardCommission cbFinalizationRewardCommission cbSuspend = - withDeposit wtc tickGetArgAndBalance chargeAndExecute + withDeposit wtc tickGetArgAndBalance (const executeConfigure) where senderAccount = wtc ^. wtcSenderAccount senderAccountIndex = fst senderAccount @@ -2176,11 +2186,6 @@ handleConfigureBaker else tickEnergy Cost.configureBakerCostWithoutKeys arg <- makeArg (arg,) <$> getCurrentAccountTotalAmount senderAccount - chargeAndExecute ls argAndBalance = do - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost - result <- executeConfigure argAndBalance - return (result, energyCost, usedEnergy) -- Check the proofs are valid, if we are updating the keys. -- (If there is no key update, then this is trivially 'True'.) proofsValid = maybe True (checkConfigureBakerKeys senderAddress) cbKeysWithProofs @@ -2290,9 +2295,9 @@ handleConfigureDelegation :: Maybe Amount -> Maybe Bool -> Maybe DelegationTarget -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleConfigureDelegation wtc cdCapital cdRestakeEarnings cdDelegationTarget = - withDeposit wtc tickAndGetAccountBalance chargeAndExecute + withDeposit wtc tickAndGetAccountBalance (const executeConfigure) where senderAccount = wtc ^. wtcSenderAccount senderAccountIndex = fst senderAccount @@ -2338,11 +2343,6 @@ handleConfigureDelegation wtc cdCapital cdRestakeEarnings cdDelegationTarget = duDelegationTarget = cdDelegationTarget } (arg,) <$> getCurrentAccountTotalAmount senderAccount - chargeAndExecute ls argAndBalance = do - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost - result <- executeConfigure argAndBalance - return (result, energyCost, usedEnergy) executeConfigure (CDCAdd{..}, accountBalance) | accountBalance < BI.daCapital cdcDelegatorAdd = return (TxReject InsufficientBalanceForDelegationStake) @@ -2403,17 +2403,14 @@ handleConfigureDelegation wtc cdCapital cdRestakeEarnings cdDelegationTarget = handleRemoveBaker :: (AccountVersionFor (MPV m) ~ 'AccountV0, ChainParametersVersionFor (MPV m) ~ 'ChainParametersV0, SchedulerMonad m) => WithDepositContext m -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleRemoveBaker wtc = withDeposit wtc c k where senderAccount = wtc ^. wtcSenderAccount senderAddress = wtc ^. wtcSenderAddress c = tickEnergy Cost.removeBakerCost - k ls () = do - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost - + k _ls () = do res <- removeBaker (fst senderAccount) case res of BI.BRRemoved bid _ -> do @@ -2422,16 +2419,16 @@ handleRemoveBaker wtc = { ebrBakerId = bid, ebrAccount = senderAddress } - return (TxSuccess [brEvt], energyCost, usedEnergy) - BI.BRInvalidBaker -> return (TxReject (NotABaker senderAddress), energyCost, usedEnergy) - BI.BRChangePending _ -> return (TxReject BakerInCooldown, energyCost, usedEnergy) + return (TxSuccess [brEvt]) + BI.BRInvalidBaker -> return (TxReject (NotABaker senderAddress)) + BI.BRChangePending _ -> return (TxReject BakerInCooldown) handleUpdateBakerStake :: (AccountVersionFor (MPV m) ~ 'AccountV0, ChainParametersVersionFor (MPV m) ~ 'ChainParametersV0, SchedulerMonad m) => WithDepositContext m -> -- | new stake Amount -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleUpdateBakerStake wtc newStake = withDeposit wtc c k where @@ -2442,50 +2439,45 @@ handleUpdateBakerStake wtc newStake = -- Get the total amount on the account, including locked amounts, -- less the deposit. getCurrentAccountTotalAmount senderAccount - k ls accountBalance = do - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost + k _ls accountBalance = do if accountBalance < newStake then -- The balance is insufficient. - return (TxReject InsufficientBalanceForBakerStake, energyCost, usedEnergy) + return (TxReject InsufficientBalanceForBakerStake) else do res <- updateBakerStake (fst senderAccount) newStake case res of - BI.BSUChangePending _ -> return (TxReject BakerInCooldown, energyCost, usedEnergy) + BI.BSUChangePending _ -> return (TxReject BakerInCooldown) BI.BSUStakeIncreased bid -> - return (TxSuccess [BakerStakeIncreased bid senderAddress newStake], energyCost, usedEnergy) + return (TxSuccess [BakerStakeIncreased bid senderAddress newStake]) BI.BSUStakeReduced bid _ -> - return (TxSuccess [BakerStakeDecreased bid senderAddress newStake], energyCost, usedEnergy) + return (TxSuccess [BakerStakeDecreased bid senderAddress newStake]) BI.BSUStakeUnchanged _ -> - return (TxSuccess [], energyCost, usedEnergy) + return (TxSuccess []) BI.BSUInvalidBaker -> -- Since we resolved the account already, this happens only if the account is not a baker. - return (TxReject (NotABaker senderAddress), energyCost, usedEnergy) + return (TxReject (NotABaker senderAddress)) BI.BSUStakeUnderThreshold -> - return (TxReject StakeUnderMinimumThresholdForBaking, energyCost, usedEnergy) + return (TxReject StakeUnderMinimumThresholdForBaking) handleUpdateBakerRestakeEarnings :: (AccountVersionFor (MPV m) ~ 'AccountV0, SchedulerMonad m) => WithDepositContext m -> -- | Whether to restake earnings Bool -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleUpdateBakerRestakeEarnings wtc newRestakeEarnings = withDeposit wtc c k where senderAccount = wtc ^. wtcSenderAccount senderAddress = wtc ^. wtcSenderAddress c = tickEnergy Cost.updateBakerRestakeCost - k ls () = do - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost - + k _ls () = do res <- updateBakerRestakeEarnings (fst senderAccount) newRestakeEarnings case res of BI.BREUUpdated bid -> - return (TxSuccess [BakerSetRestakeEarnings bid senderAddress newRestakeEarnings], energyCost, usedEnergy) + return (TxSuccess [BakerSetRestakeEarnings bid senderAddress newRestakeEarnings]) BI.BREUInvalidBaker -> -- Since we resolved the account already, this happens only if the account is not a baker. - return (TxReject (NotABaker senderAddress), energyCost, usedEnergy) + return (TxReject (NotABaker senderAddress)) -- | Update a baker's keys. The logic is as follows: -- @@ -2509,17 +2501,14 @@ handleUpdateBakerKeys :: Proofs.Dlog25519Proof -> Proofs.Dlog25519Proof -> BakerAggregationProof -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleUpdateBakerKeys wtc bkuElectionKey bkuSignKey bkuAggregationKey bkuProofSig bkuProofElection bkuProofAggregation = withDeposit wtc c k where senderAccount = wtc ^. wtcSenderAccount senderAddress = wtc ^. wtcSenderAddress c = tickEnergy Cost.updateBakerKeysCost - k ls _ = do - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost - + k _ls _ = do let challenge = updateBakerKeyChallenge senderAddress bkuElectionKey bkuSignKey bkuAggregationKey electionP = checkElectionKeyProof challenge bkuElectionKey bkuProofElection signP = checkSignatureVerifyKeyProof challenge bkuSignKey bkuProofSig @@ -2540,12 +2529,12 @@ handleUpdateBakerKeys wtc bkuElectionKey bkuSignKey bkuAggregationKey bkuProofSi ebkuElectionKey = bkuElectionKey, ebkuAggregationKey = bkuAggregationKey } - return (TxSuccess [bupdEvt], energyCost, usedEnergy) + return (TxSuccess [bupdEvt]) BI.BKUInvalidBaker -> -- Since we resolved the account already, this happens only if the account is not a baker. - return (TxReject (NotABaker senderAddress), energyCost, usedEnergy) - BI.BKUDuplicateAggregationKey -> return (TxReject (DuplicateAggregationKey bkuAggregationKey), energyCost, usedEnergy) - else return (TxReject InvalidProof, energyCost, usedEnergy) + return (TxReject (NotABaker senderAddress)) + BI.BKUDuplicateAggregationKey -> return (TxReject (DuplicateAggregationKey bkuAggregationKey)) + else return (TxReject InvalidProof) -- | Credential deployments (transactions without a sender) -- The logic is as follows: @@ -2565,11 +2554,12 @@ handleUpdateBakerKeys wtc bkuElectionKey bkuSignKey bkuAggregationKey bkuProofSi -- -- Note that the function only fails with `TxInvalid` and thus failed transactions are not committed to chain. handleDeployCredential :: + forall m. (SchedulerMonad m) => -- | Credentials to deploy with the current verification status. TVer.CredentialDeploymentWithStatus -> TransactionHash -> - m (Maybe TxResult) + m (Maybe (TxResult (TransactionOutcomesVersionFor (MPV m)))) handleDeployCredential (WithMetadata{wmdData = cred@AccountCreation{messageExpiry = messageExpiry, credential = cdi}}, mVerRes) cdiHash = do res <- runExceptT $ do cm <- lift getChainMetadata @@ -2621,6 +2611,7 @@ handleDeployCredential (WithMetadata{wmdData = cred@AccountCreation{messageExpir TxValid $ TransactionSummary { tsSender = Nothing, + tsSponsorDetails = conditionally cHasSponsorDetails Nothing, tsHash = cdiHash, tsCost = 0, tsEnergyCost = theCost, @@ -2628,6 +2619,7 @@ handleDeployCredential (WithMetadata{wmdData = cred@AccountCreation{messageExpir .. } theCost = Cost.deployCredential (ID.credentialType cdi) (ID.credNumKeys . ID.credPubKeys $ cdi) + cHasSponsorDetails = (sHasSponsorDetails (sTransactionOutcomesVersionFor (protocolVersion @(MPV m)))) -- | Updates the credential keys in the credential with the given Credential ID. -- It rejects if there is no credential with the given Credential ID. @@ -2640,7 +2632,7 @@ handleUpdateCredentialKeys :: ID.CredentialPublicKeys -> -- | Signatures on the transaction. This is needed to check that a specific credential signed. TransactionSignature -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleUpdateCredentialKeys wtc cid keys sigs = withDeposit wtc c k where @@ -2663,11 +2655,9 @@ handleUpdateCredentialKeys wtc cid keys sigs = let ownerCheck = OrdMap.member index $ tsSignatures sigs unless ownerCheck $ rejectTransaction CredentialHolderDidNotSign return index - k ls index = do - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost + k _ls index = do updateCredentialKeys (fst senderAccount) index keys - return (TxSuccess [CredentialKeysUpdated cid], energyCost, usedEnergy) + return (TxSuccess [CredentialKeysUpdated cid]) -- | Handler for a token update transaction. handleTokenUpdate :: @@ -2680,7 +2670,7 @@ handleTokenUpdate :: TokenId -> -- | Operations for the token. TokenParameter -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleTokenUpdate depositContext tokenId tokenOperations = withDeposit depositContext computeTransaction commitTransaction where @@ -2704,19 +2694,13 @@ handleTokenUpdate depositContext tokenId tokenOperations = tickEnergy energyUsed return (res, cannonicalTokenId) -- Process the successful transaction computation. - commitTransaction computeState (computeResult, cannonicalTokenId) = do - (usedEnergy, energyCost) <- - computeExecutionCharge - (depositContext ^. wtcEnergyAmount) - (computeState ^. energyLeft) - chargeExecutionCost senderAccount energyCost - let result = case computeResult of - Left PLTEOutOfEnergy -> TxReject OutOfEnergy - Left (PLTEFail encodedRejectReason) -> - TxReject . TokenUpdateTransactionFailed $ - makeTokenModuleRejectReason cannonicalTokenId encodedRejectReason - Right events -> TxSuccess events - return (result, energyCost, usedEnergy) + commitTransaction _computeState (computeResult, cannonicalTokenId) = + return $! case computeResult of + Left PLTEOutOfEnergy -> TxReject OutOfEnergy + Left (PLTEFail encodedRejectReason) -> + TxReject . TokenUpdateTransactionFailed $ + makeTokenModuleRejectReason cannonicalTokenId encodedRejectReason + Right events -> TxSuccess events -- Call the module of the token with the operations and return the events emitted from the token module. invokeTokenOperations :: Energy -> @@ -2742,7 +2726,7 @@ handleChainUpdate :: forall m. (SchedulerMonad m) => TVer.ChainUpdateWithStatus -> - m TxResult + m (TxResult (TransactionOutcomesVersionFor (MPV m))) handleChainUpdate (WithMetadata{wmdData = ui@UpdateInstruction{..}, ..}, maybeVerificationResult) = do cm <- getChainMetadata -- check that payload si @@ -2846,7 +2830,7 @@ handleChainUpdate (WithMetadata{wmdData = ui@UpdateInstruction{..}, ..}, maybeVe scpv = chainParametersVersion sauv :: SAuthorizationsVersion (AuthorizationsVersionFor (MPV m)) sauv = sAuthorizationsVersionFor $ protocolVersion @(MPV m) - checkSigThen :: m TxResult -> m TxResult + checkSigThen :: m (TxResult tov) -> m (TxResult tov) checkSigThen cont = do case maybeVerificationResult of Just (TVer.Ok (TVer.ChainUpdateSuccess keysHash _)) -> do @@ -2868,7 +2852,7 @@ handleChainUpdate (WithMetadata{wmdData = ui@UpdateInstruction{..}, ..}, maybeVe case checkTransactionVerificationResult newVerRes of Left failure -> return $ TxInvalid failure Right _ -> cont - checkSigAndEnqueue :: UpdateValue (ChainParametersVersionFor (MPV m)) (AuthorizationsVersionFor (MPV m)) -> m TxResult + checkSigAndEnqueue :: UpdateValue (ChainParametersVersionFor (MPV m)) (AuthorizationsVersionFor (MPV m)) -> m (TxResult (TransactionOutcomesVersionFor (MPV m))) checkSigAndEnqueue = checkSigThen . enqueue enqueue change = do enqueueUpdate (updateEffectiveTime uiHeader) change @@ -2883,12 +2867,14 @@ handleChainUpdate (WithMetadata{wmdData = ui@UpdateInstruction{..}, ..}, maybeVe TxValid TransactionSummary { tsSender = Nothing, + tsSponsorDetails = conditionally cHasSponsorDetails Nothing, tsHash = wmdHash, tsCost = 0, tsEnergyCost = 0, tsType = TSTUpdateTransaction $ updateType uiPayload, .. } + cHasSponsorDetails = (sHasSponsorDetails (sTransactionOutcomesVersionFor (protocolVersion @(MPV m)))) -- | Handler for processing chain update creating a new protocol level token. -- It is assumed that the signatures have already been checked. @@ -2925,7 +2911,7 @@ handleUpdateCredentials :: OrdMap.Map ID.CredentialIndex ID.CredentialDeploymentInformation -> [ID.CredentialRegistrationID] -> ID.AccountThreshold -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleUpdateCredentials wtc cdis removeRegIds threshold = withDeposit wtc c k where @@ -2946,9 +2932,7 @@ handleUpdateCredentials wtc cdis removeRegIds threshold = unless allowed $ rejectTransaction NotAllowedMultipleCredentials return creds - k ls existingCredentials = do - (usedEnergy, energyCost) <- computeExecutionCharge (wtc ^. wtcEnergyAmount) (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost + k _ls existingCredentials = do cryptoParams <- TVer.getCryptographicParameters -- check that all credentials that are to be removed actually exist. @@ -3016,46 +3000,33 @@ handleUpdateCredentials wtc cdis removeRegIds threshold = -- check all the credential proofs. -- This is only done if all the previous checks have succeeded since this is by far the most computationally expensive part. checkProofs <- foldM (\check cdi -> if check then checkCDI cdi else return False) (firstCredNotRemoved && thresholdCheck && removalCheck && null existingCredIds) cdis - if checkProofs - then do + if + | checkProofs -> do -- check if stuff is correct let creds = traverse (ID.values . ID.NormalACWP) cdis case creds of - Nothing -> return (TxReject InvalidCredentials, energyCost, usedEnergy) + Nothing -> return (TxReject InvalidCredentials) Just newCredentials -> do updateAccountCredentials (fst senderAccount) (reverse revListIndicesToRemove) newCredentials threshold - return - ( TxSuccess + return $ + TxSuccess [ CredentialsUpdated { cuAccount = senderAddress, cuNewCredIds = Set.toList newCredIds, cuRemovedCredIds = removeRegIds, cuNewThreshold = threshold } - ], - energyCost, - usedEnergy - ) + ] -- try to provide a more fine-grained error by analyzing what went wrong -- at some point we should refine the scheduler monad to support cleaner error -- handling by adding MonadError capability to it. Until that is done this -- is a pretty clean alternative to avoid deep nesting. - else - if not firstCredNotRemoved - then return (TxReject RemoveFirstCredential, energyCost, usedEnergy) - else - if not thresholdCheck - then return (TxReject InvalidAccountThreshold, energyCost, usedEnergy) - else - if not (null nonExistingRegIds) - then return (TxReject (NonExistentCredIDs nonExistingRegIds), energyCost, usedEnergy) - else - if not removalCheck - then return (TxReject KeyIndexAlreadyInUse, energyCost, usedEnergy) - else - if not (null existingCredIds) - then return (TxReject (DuplicateCredIDs existingCredIds), energyCost, usedEnergy) - else return (TxReject InvalidCredentials, energyCost, usedEnergy) + | not firstCredNotRemoved -> return (TxReject RemoveFirstCredential) + | not thresholdCheck -> return (TxReject InvalidAccountThreshold) + | not (null nonExistingRegIds) -> return (TxReject (NonExistentCredIDs nonExistingRegIds)) + | not removalCheck -> return (TxReject KeyIndexAlreadyInUse) + | not (null existingCredIds) -> return (TxReject (DuplicateCredIDs existingCredIds)) + | otherwise -> return (TxReject InvalidCredentials) -- | Charges energy based on payload size and emits a 'DataRegistered' event. handleRegisterData :: @@ -3063,9 +3034,9 @@ handleRegisterData :: WithDepositContext m -> -- | The data to register. RegisteredData -> - m (Maybe TransactionSummary) + m (Maybe (TransactionSummary (TransactionOutcomesVersionFor (MPV m)))) handleRegisterData wtc regData = - withDeposit wtc c (defaultSuccess wtc) + withDeposit wtc c defaultSuccess where c = do tickEnergy Cost.registerDataCost @@ -3149,7 +3120,7 @@ filterTransactions :: UTCTime -> -- | Transactions to make a block out of. [TransactionGroup] -> - m FilteredTransactions + m (FilteredTransactions (TransactionOutcomesVersionFor (MPV m))) filterTransactions maxSize timeout groups0 = do maxEnergy <- getMaxBlockEnergy credLimit <- getAccountCreationLimit @@ -3174,9 +3145,9 @@ filterTransactions maxSize timeout groups0 = do Integer -> -- \^Current size of transactions in the block. CredentialsPerBlockLimit -> -- \^Number of credentials until limit. Bool -> -- \^Whether or not the block timeout is reached - FilteredTransactions -> -- \^Currently accumulated result + FilteredTransactions (TransactionOutcomesVersionFor (MPV m)) -> -- \^Currently accumulated result [TransactionGroup] -> -- \^Grouped transactions to process - m FilteredTransactions + m (FilteredTransactions (TransactionOutcomesVersionFor (MPV m))) -- All block items are processed. We accumulate the added items -- in reverse order, so reverse the list before returning. runNext _ _ _ _ fts [] = return fts{ftAdded = reverse (ftAdded fts)} @@ -3232,7 +3203,7 @@ filterTransactions maxSize timeout groups0 = do newFts = currentFts { ftFailedUpdates = ((,NonSequentialNonce (curSN + 1)) <$> invalid) ++ ftFailedUpdates currentFts, - ftAdded = (ui & _1 %~ chainUpdate, summary) : ftAdded currentFts + ftAdded = (ui & _1 %~ toBlockItem, summary) : ftAdded currentFts } runUpdateInstructions csize newFts rest -- The cumulative block size with this update is too high. @@ -3248,7 +3219,7 @@ filterTransactions maxSize timeout groups0 = do in runNext maxEnergy currentSize credLimit False newFts groups -- Run a single credential and continue with 'runNext'. - runCredential :: TVer.CredentialDeploymentWithStatus -> m FilteredTransactions + runCredential :: TVer.CredentialDeploymentWithStatus -> m (FilteredTransactions (TransactionOutcomesVersionFor (MPV m))) runCredential cws@(c@WithMetadata{..}, verRes) = do totalEnergyUsed <- getUsedEnergy let csize = size + fromIntegral wmdSize @@ -3270,7 +3241,7 @@ filterTransactions maxSize timeout groups0 = do runNext maxEnergy size (credLimit - 1) False newFts groups -- NB: We keep the old size Just (TxValid summary) -> do markEnergyUsed (tsEnergyCost summary) - let newFts = fts{ftAdded = ((credentialDeployment c, verRes), summary) : ftAdded fts} + let newFts = fts{ftAdded = ((toBlockItem c, verRes), summary) : ftAdded fts} runNext maxEnergy csize (credLimit - 1) False newFts groups Nothing -> error "Unreachable due to cenergy <= maxEnergy check." else @@ -3286,9 +3257,9 @@ filterTransactions maxSize timeout groups0 = do -- Run all transactions in a group and continue with 'runNext'. runTransactionGroup :: Integer -> -- \^Current size of transactions in the block. - FilteredTransactions -> + FilteredTransactions (TransactionOutcomesVersionFor (MPV m)) -> [TVer.TransactionWithStatus] -> -- \^Current group to process. - m FilteredTransactions + m (FilteredTransactions (TransactionOutcomesVersionFor (MPV m))) runTransactionGroup currentSize currentFts (t : ts) = do totalEnergyUsed <- getUsedEnergy let csize = currentSize + fromIntegral (transactionSize (fst t)) @@ -3357,7 +3328,7 @@ filterTransactions maxSize timeout groups0 = do { ftFailed = map (,NonSequentialNonce nextNonce) invalid ++ ftFailed currentFts, - ftAdded = ((normalTransaction (fst t), snd t), summary) : ftAdded currentFts + ftAdded = ((toBlockItem (fst t), snd t), summary) : ftAdded currentFts } return (newFts, rest) @@ -3392,7 +3363,7 @@ runTransactions :: forall m. (SchedulerMonad m) => [TVer.BlockItemWithStatus] -> - m (Either (Maybe FailureKind) [(BlockItem, TransactionSummary)]) + m (Either (Maybe FailureKind) [(BlockItem, TransactionSummary (TransactionOutcomesVersionFor (MPV m)))]) runTransactions = go [] where go valid (bi : ts) = @@ -3406,10 +3377,11 @@ runTransactions = go [] Nothing -> return (Left Nothing) go valid [] = return (Right (reverse $ map (\(x, y) -> (fst x, y)) valid)) - predispatch :: TVer.BlockItemWithStatus -> m (Maybe TxResult) + predispatch :: TVer.BlockItemWithStatus -> m (Maybe (TxResult (TransactionOutcomesVersionFor (MPV m)))) predispatch (WithMetadata{wmdData = NormalTransaction tr, ..}, verRes) = dispatch (WithMetadata{wmdData = tr, ..}, verRes) predispatch (WithMetadata{wmdData = CredentialDeployment cred, ..}, verRes) = handleDeployCredential (WithMetadata{wmdData = cred, ..}, verRes) wmdHash predispatch (WithMetadata{wmdData = ChainUpdate cu, ..}, verRes) = Just <$> handleChainUpdate (WithMetadata{wmdData = cu, ..}, verRes) + predispatch (WithMetadata{wmdData = ExtendedTransaction tr, ..}, verRes) = dispatch (WithMetadata{wmdData = tr, ..}, verRes) -- | Execute transactions in sequence. Like 'runTransactions' but only for side-effects on global state. -- @@ -3441,7 +3413,8 @@ execTransactions = go return (Left (Just reason)) go [] = return (Right ()) - predispatch :: TVer.BlockItemWithStatus -> m (Maybe TxResult) + predispatch :: TVer.BlockItemWithStatus -> m (Maybe (TxResult (TransactionOutcomesVersionFor (MPV m)))) predispatch (WithMetadata{wmdData = NormalTransaction tr, ..}, verRes) = dispatch (WithMetadata{wmdData = tr, ..}, verRes) predispatch (WithMetadata{wmdData = CredentialDeployment cred, ..}, verRes) = handleDeployCredential (WithMetadata{wmdData = cred, ..}, verRes) wmdHash predispatch (WithMetadata{wmdData = ChainUpdate cu, ..}, verRes) = Just <$> handleChainUpdate (WithMetadata{wmdData = cu, ..}, verRes) + predispatch (WithMetadata{wmdData = ExtendedTransaction tr, ..}, verRes) = dispatch (WithMetadata{wmdData = tr, ..}, verRes) diff --git a/concordium-consensus/src/Concordium/Scheduler/Environment.hs b/concordium-consensus/src/Concordium/Scheduler/Environment.hs index 0510e69e79..af518df4af 100644 --- a/concordium-consensus/src/Concordium/Scheduler/Environment.hs +++ b/concordium-consensus/src/Concordium/Scheduler/Environment.hs @@ -888,8 +888,9 @@ data LocalState m = LocalState makeLenses ''LocalState data TransactionContext = TransactionContext - { -- | Header of the transaction initiating the transaction. - _tcTxSender :: !AccountIndex, + { -- | Index of the account that is paying for the transaction. + _tcTxPayer :: !AccountIndex, + -- | Amount deposited by the payer to fund the transaction cost. _tcDepositedAmount :: !Amount } @@ -915,12 +916,16 @@ runLocalT :: forall m a. (Monad m) => LocalT a m a -> + -- | Deposit amount. Amount -> + -- | Payer account index. AccountIndex -> - Energy -> -- Energy limit by the transaction header. - Energy -> -- remaining block energy + -- | Energy left for executing this transaction. + Energy -> + -- | Energy left for executing this block. + Energy -> m (Either (Maybe RejectReason) a, LocalState m) -runLocalT (LocalT st) _tcDepositedAmount _tcTxSender _energyLeft _blockEnergyLeft = do +runLocalT (LocalT st) _tcDepositedAmount _tcTxPayer _energyLeft _blockEnergyLeft = do -- The initial contract modification index must start at 1 since 0 is the -- "initial state" of all contracts (as recorded in the changeset). let s = @@ -947,6 +952,14 @@ instance BlockStateTypes (LocalT r m) where type InstrumentedModuleRef (LocalT r m) = InstrumentedModuleRef m type MutableTokenState (LocalT r m) = MutableTokenState m +-- | The energy used in executing a transaction and the cost that was paid for it. +data ExecutionCharge = ExecutionCharge + { -- | The amount of energy used in the transaction. + ecUsedEnergy :: !Energy, + -- | The cost charged for the energy used in the transaction. + ecEnergyCost :: !Amount + } + -- | Given the deposited amount and the remaining amount of gas compute how much -- the sender of the transaction should be charged, as well as how much energy was used -- for execution. @@ -957,21 +970,29 @@ computeExecutionCharge :: Energy -> -- | Energy remaining unused. Energy -> - m (Energy, Amount) -computeExecutionCharge allocated unused = - let used = allocated - unused - in (used,) <$> energyToGtu used + m ExecutionCharge +computeExecutionCharge allocated unused = do + let ecUsedEnergy = allocated - unused + ecEnergyCost <- energyToGtu ecUsedEnergy + return ExecutionCharge{..} -- | Reduce the public balance on the account to charge for execution cost. The -- given amount is the amount to charge (subtract). The precondition of this -- method is that the account exists and its balance is sufficient to -- cover the costs. These are not checked. -- --- NB: This method should only be used directly when the given account's balance --- is the only one affected by the transaction, either because a transaction was --- rejected, or because it was a transaction which only affects one account's --- balance such as DeployCredential, or DeployModule. -chargeExecutionCost :: forall m. (SchedulerMonad m) => IndexedAccount m -> Amount -> m () +-- NB: This function is only called in two ways: +-- +-- - by 'computeChargeExecution' to charge for executing a payload that was deserialized. +-- - by 'dispatchTransactionBody' to charge for a payload that could not be deserialized. +chargeExecutionCost :: + forall m. + (SchedulerMonad m) => + -- | Payer account.` + IndexedAccount m -> + -- | Execution cost. + Amount -> + m () chargeExecutionCost (ai, acc) amnt = do balance <- getAccountAmount acc let csWithAccountDelta = emptyCS (Proxy @m) & accountUpdates . at ai ?~ (emptyAccountUpdate ai & auAmount ?~ amountDiff 0 amnt) @@ -979,9 +1000,25 @@ chargeExecutionCost (ai, acc) amnt = do commitChanges csWithAccountDelta notifyExecutionCost amnt +-- | Compute the amount to charge the transaction payer for executing the transaction, +-- and charge the account. Returns the energy and cost charged. +computeChargeExecution :: + (SchedulerMonad m) => + -- | The context for the transaction execution. + WithDepositContext m -> + -- | The remaining unused energy. + Energy -> + m ExecutionCharge +computeChargeExecution wtc unused = do + executionCharge <- computeExecutionCharge (_wtcEnergyAmount wtc) unused + chargeExecutionCost (_wtcPayerAccount wtc) (ecEnergyCost executionCharge) + return executionCharge + data WithDepositContext m = WithDepositContext { -- | The account initiating the transaction. _wtcSenderAccount :: !(IndexedAccount m), + -- | The account paying the energy cost for the transaction. + _wtcPayerAccount :: !(IndexedAccount m), -- | Type of the top-level transaction. _wtcTransactionType :: !TransactionType, -- | Hash of the top-level transaction. @@ -989,6 +1026,8 @@ data WithDepositContext m = WithDepositContext -- | Address of the sender of the transaction. -- This should correspond to '_wtcSenderAccount', but need not be the canonical address. _wtcSenderAddress :: !AccountAddress, + -- | If the transaction is sponsored, this is the address of the sponsor account. + _wtcSponsorAddress :: !(Maybe AccountAddress), -- | The amount of energy dedicated for the execution of this transaction. _wtcEnergyAmount :: !Energy, -- | Cost to be charged for checking the transaction header. @@ -1001,27 +1040,28 @@ data WithDepositContext m = WithDepositContext makeLenses ''WithDepositContext --- | Given an account which is initiating the top-level transaction and the +-- | Given an account which is paying the fees for the top-level transaction and the -- deposited amount, run the given computation in the modified environment where -- the balance on the account is decreased by the deposited amount. Return the -- amount of energy __used__ by the computation and any result returned. The -- function __ensures__ that the amount of energy is not more than the -- deposited amount. The function __assumes__ the following -- --- * The account exists in the account database. +-- * The payer account exists in the account database. -- * The deposited amount exists in the public account value. -- * The deposited amount is __at least__ Cost.checkHeader applied to the respective parameters (i.e., minimum transaction cost). withDeposit :: - (SchedulerMonad m, TransactionResult res) => + forall tov m res a. + (SchedulerMonad m, TransactionResult res, tov ~ TransactionOutcomesVersionFor (MPV m)) => WithDepositContext m -> -- | The computation to run in the modified environment with reduced amount on the initial account. LocalT a m a -> -- | Continuation for the successful branch of the computation. + -- The execution cost is charged before this is called. -- It gets the result of the previous computation as input, in particular the - -- remaining energy and the ChangeSet. It should return the result, and the amount that was charged - -- for the execution. - (LocalState m -> a -> m (res, Amount, Energy)) -> - m (Maybe (TransactionSummary' res)) + -- remaining energy and the ChangeSet. It should return the result. + (LocalState m -> a -> m res) -> + m (Maybe (TransactionSummary' tov res)) withDeposit wtc comp k = do let tsHash = wtc ^. wtcTransactionHash let totalEnergyToUse = wtc ^. wtcEnergyAmount @@ -1032,7 +1072,7 @@ withDeposit wtc comp k = do let energy = totalEnergyToUse - wtc ^. wtcTransactionCheckHeaderCost -- record how much we have deposited. This cannot be touched during execution. depositedAmount <- energyToGtu totalEnergyToUse - (res, ls) <- runLocalT comp depositedAmount (wtc ^. wtcSenderAccount . _1) energy beLeft + (res, ls) <- runLocalT comp depositedAmount (wtc ^. wtcPayerAccount . _1) energy beLeft let addReturn result = foldr (setTransactionReturnValue . V1.returnValueToByteString) @@ -1043,16 +1083,17 @@ withDeposit wtc comp k = do Left Nothing -> return Nothing -- Failure: transaction fails (out of energy or actual failure by transaction logic) Left (Just reason) -> do - -- The only effect of this transaction is that the sender is charged for the execution cost + -- The only effect of this transaction is that the payer is charged for the execution cost -- (energy ticked so far). - (usedEnergy, payment) <- computeExecutionCharge totalEnergyToUse (ls ^. energyLeft) - chargeExecutionCost (wtc ^. wtcSenderAccount) payment + executionCharge <- computeChargeExecution wtc (ls ^. energyLeft) + let (tsCost, sponsorDetails) = computeCostDetails executionCharge + return $! Just $! TransactionSummary { tsSender = Just (wtc ^. wtcSenderAddress), - tsCost = payment, - tsEnergyCost = usedEnergy, + tsSponsorDetails = conditionally cHasSponsorDetails sponsorDetails, + tsEnergyCost = ecUsedEnergy executionCharge, tsResult = addReturn $ transactionReject reason, tsType = TSTAccountTransaction $ Just $ wtc ^. wtcTransactionType, tsIndex = wtc ^. wtcTransactionIndex, @@ -1060,36 +1101,46 @@ withDeposit wtc comp k = do } -- Computation successful Right a -> do - -- In this case we invoke the continuation, which should charge for the used energy. - (tsResult0, tsCost, tsEnergyCost) <- k ls a + -- In this case we charge for the used energy then invoke the continuation. + executionCharge <- computeChargeExecution wtc (ls ^. energyLeft) + let (tsCost, sponsorDetails) = computeCostDetails executionCharge + tsResult0 <- k ls a return $! Just $! TransactionSummary { tsSender = Just (wtc ^. wtcSenderAddress), + tsSponsorDetails = conditionally cHasSponsorDetails sponsorDetails, + tsEnergyCost = ecUsedEnergy executionCharge, tsType = TSTAccountTransaction $ Just $ wtc ^. wtcTransactionType, tsIndex = wtc ^. wtcTransactionIndex, tsResult = addReturn tsResult0, .. } - -{-# INLINE defaultSuccess #-} - --- | Default continuation to use with 'withDeposit'. It charges for the energy used, commits the changes + where + cHasSponsorDetails = sHasSponsorDetails (sTransactionOutcomesVersionFor (protocolVersion @(MPV m))) + computeCostDetails ExecutionCharge{..} + | Just sponsorAddress <- wtc ^. wtcSponsorAddress = + ( 0, + Just $ + SponsorDetails + { sdSponsor = sponsorAddress, + sdCost = ecEnergyCost + } + ) + | otherwise = (ecEnergyCost, Nothing) + +-- | Default continuation to use with 'withDeposit'. It commits the changes -- from the current changeset and returns the recorded events, the amount corresponding to the -- used energy and the used energy. +{-# INLINE defaultSuccess #-} defaultSuccess :: (SchedulerMonad m, TransactionResult res) => - WithDepositContext m -> LocalState m -> [Event] -> - m (res, Amount, Energy) -defaultSuccess wtc = \ls res -> do - let energyAllocated = wtc ^. wtcEnergyAmount - senderAccount = wtc ^. wtcSenderAccount - (usedEnergy, energyCost) <- computeExecutionCharge energyAllocated (ls ^. energyLeft) - chargeExecutionCost senderAccount energyCost + m res +defaultSuccess = \ls res -> do commitChanges (ls ^. changeSet) - return (transactionSuccess res, energyCost, usedEnergy) + return (transactionSuccess res) {-# INLINE liftLocal #-} liftLocal :: (Monad m) => m a -> LocalT r m a @@ -1330,9 +1381,9 @@ instance (MonadProtocolVersion m, StaticInformation m, AccountOperations m, Cont getCurrentAccountTotalAmount (ai, acc) = do oldTotal <- getAccountAmount acc !txCtx <- ask - -- If the account is the sender, subtract the deposit + -- If the account is the transaction fee payer, subtract the deposit let netDeposit = - if txCtx ^. tcTxSender == ai + if txCtx ^. tcTxPayer == ai then oldTotal - (txCtx ^. tcDepositedAmount) else oldTotal macc <- use (changeSet . accountUpdates . at ai) @@ -1350,9 +1401,9 @@ instance (MonadProtocolVersion m, StaticInformation m, AccountOperations m, Cont oldLockedUp <- getAccountLockedAmount acc staked <- getAccountTotalStakedAmount acc !txCtx <- ask - -- If the account is the sender, subtract the deposit + -- If the account is the transaction fee payer, subtract the deposit let netDeposit = - if txCtx ^. tcTxSender == ai + if txCtx ^. tcTxPayer == ai then oldTotal - (txCtx ^. tcDepositedAmount) else oldTotal macc <- use (changeSet . accountUpdates . at ai) @@ -1469,6 +1520,8 @@ logInvalidBlockItem WithMetadata{wmdData = CredentialDeployment cred} fk = logEvent Scheduler LLWarning $ "Credential with registration id " ++ (show . ID.credId . credential $ cred) ++ " was invalid with reason " ++ show fk logInvalidBlockItem WithMetadata{wmdData = ChainUpdate{}, ..} fk = logEvent Scheduler LLWarning $ "Chain update with hash " ++ show wmdHash ++ " was invalid with reason: " ++ show fk +logInvalidBlockItem WithMetadata{wmdData = ExtendedTransaction{}, ..} fk = + logEvent Scheduler LLWarning $ "Transaction with hash " ++ show wmdHash ++ " was invalid with reason: " ++ show fk {-# INLINE logInvalidTransaction #-} logInvalidTransaction :: (SchedulerMonad m) => TVer.TransactionWithStatus -> FailureKind -> m () diff --git a/concordium-consensus/src/Concordium/Scheduler/Runner.hs b/concordium-consensus/src/Concordium/Scheduler/Runner.hs index 4525cf8a06..ae2894d8bf 100644 --- a/concordium-consensus/src/Concordium/Scheduler/Runner.hs +++ b/concordium-consensus/src/Concordium/Scheduler/Runner.hs @@ -172,8 +172,9 @@ processUngroupedBlockItems inpt = do return (map txMap txs) where txMap (Types.NormalTransaction x) = Types.TGAccountTransactions [(Types.fromAccountTransaction 0 x, Nothing)] - txMap (Types.CredentialDeployment x) = Types.TGCredentialDeployment (Types.addMetadata Types.CredentialDeployment 0 x, Nothing) - txMap (Types.ChainUpdate x) = Types.TGUpdateInstructions [(Types.addMetadata Types.ChainUpdate 0 x, Nothing)] + txMap (Types.CredentialDeployment x) = Types.TGCredentialDeployment (Types.addMetadata 0 x, Nothing) + txMap (Types.ChainUpdate x) = Types.TGUpdateInstructions [(Types.addMetadata 0 x, Nothing)] + txMap (Types.ExtendedTransaction x) = Types.TGAccountTransactions [(Types.fromAccountTransactionV1 0 x, Nothing)] -- | For testing purposes: process transactions in the groups in which they came -- The arrival time of all transactions is taken to be 0. diff --git a/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs b/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs index b6888edd23..a816168dc7 100644 --- a/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs +++ b/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs @@ -1344,7 +1344,7 @@ constructBlock :: Maybe FinalizerInfo -> -- | New seed state SeedState (SeedStateVersionFor (MPV m)) -> - m (Sch.FilteredTransactions, ExecutionResult m) + m (Sch.FilteredTransactions (TransactionOutcomesVersionFor (MPV m)), ExecutionResult m) constructBlock slotNumber slotTime blockParent blockBaker mfinInfo newSeedState = let cm = ChainMetadata{..} in do diff --git a/concordium-consensus/src/Concordium/Scheduler/Types.hs b/concordium-consensus/src/Concordium/Scheduler/Types.hs index ae7247241f..a4e2e8fba1 100644 --- a/concordium-consensus/src/Concordium/Scheduler/Types.hs +++ b/concordium-consensus/src/Concordium/Scheduler/Types.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DataKinds #-} + module Concordium.Scheduler.Types ( module Concordium.Scheduler.Types, module Concordium.Types, @@ -28,9 +30,9 @@ import Concordium.ID.Types (IdentityProviderIdentity) import qualified Concordium.TransactionVerification as TVer -- | Result of constructing a block from 'GroupedTransactions'. -data FilteredTransactions = FilteredTransactions +data FilteredTransactions (tov :: TransactionOutcomesVersion) = FilteredTransactions { -- | Transactions which have been added to the block, in the order added, with results. - ftAdded :: [(TVer.BlockItemWithStatus, TransactionSummary)], + ftAdded :: [(TVer.BlockItemWithStatus, TransactionSummary tov)], -- | Transactions which failed. No order is guaranteed. ftFailed :: [(TVer.TransactionWithStatus, FailureKind)], -- | Credential deployments which failed. No order is guaranteed. @@ -46,7 +48,7 @@ data FilteredTransactions = FilteredTransactions } deriving (Show) -emptyFilteredTransactions :: FilteredTransactions +emptyFilteredTransactions :: FilteredTransactions tov emptyFilteredTransactions = FilteredTransactions [] [] [] [] [] [] [] type GroupedTransactions = [TransactionGroup] diff --git a/concordium-consensus/src/Concordium/Skov/Monad.hs b/concordium-consensus/src/Concordium/Skov/Monad.hs index 0f1e1b900e..232a29303f 100644 --- a/concordium-consensus/src/Concordium/Skov/Monad.hs +++ b/concordium-consensus/src/Concordium/Skov/Monad.hs @@ -113,6 +113,12 @@ data UpdateResult ResultDoubleSign | -- | The consensus has thrown an exception and entered an unrecoverable state. ResultConsensusFailure + | -- | No account corresponding to the transaction's sponsor exists. + ResultNonexistingSponsorAccount + | -- | The transaction includes a sponsor signature but no sponsor account. + ResultMissingSponsorAccount + | -- | The transaction includes a sponsor account but no sponsor signature. + ResultMissingSponsorSignature deriving (Eq, Show) -- | Maps a 'TV.VerificationResult' to the corresponding 'UpdateResult' type. @@ -130,6 +136,7 @@ transactionVerificationResultToUpdateResult (TV.MaybeOk (TV.NormalTransactionInv transactionVerificationResultToUpdateResult (TV.MaybeOk TV.NormalTransactionInvalidSignatures) = ResultVerificationFailed transactionVerificationResultToUpdateResult (TV.MaybeOk (TV.NormalTransactionInvalidNonce _)) = ResultNonceTooLarge transactionVerificationResultToUpdateResult (TV.MaybeOk TV.NormalTransactionEnergyExceeded) = ResultEnergyExceeded +transactionVerificationResultToUpdateResult (TV.MaybeOk (TV.ExtendedTransactionInvalidSponsor _)) = ResultNonexistingSponsorAccount -- 'NotOk' mappings transactionVerificationResultToUpdateResult (TV.NotOk (TV.CredentialDeploymentDuplicateAccountRegistrationID _)) = ResultDuplicateAccountRegistrationID transactionVerificationResultToUpdateResult (TV.NotOk TV.CredentialDeploymentInvalidSignatures) = ResultCredentialDeploymentInvalidSignatures @@ -141,6 +148,8 @@ transactionVerificationResultToUpdateResult (TV.NotOk (TV.NormalTransactionDupli transactionVerificationResultToUpdateResult (TV.NotOk TV.Expired) = ResultStale transactionVerificationResultToUpdateResult (TV.NotOk TV.InvalidPayloadSize) = ResultSerializationFail transactionVerificationResultToUpdateResult (TV.NotOk TV.ChainUpdateEffectiveTimeNonZeroForCreatePLT) = ResultChainUpdateInvalidEffectiveTime +transactionVerificationResultToUpdateResult (TV.NotOk TV.SponsoredTransactionMissingSponsor) = ResultSerializationFail +transactionVerificationResultToUpdateResult (TV.NotOk TV.SponsoredTransactionMissingSponsorSignature) = ResultVerificationFailed class ( Monad m, diff --git a/concordium-consensus/src/Concordium/Skov/Update.hs b/concordium-consensus/src/Concordium/Skov/Update.hs index 0dbc8755fb..400c797bf4 100644 --- a/concordium-consensus/src/Concordium/Skov/Update.hs +++ b/concordium-consensus/src/Concordium/Skov/Update.hs @@ -815,8 +815,7 @@ doAddPreverifiedTransaction blockItem okRes = do case res of Added WithMetadata{..} verRes -> do ptrs <- getPendingTransactions - case wmdData of - NormalTransaction tx -> do + let addPreverifiedAccountTransaction tx = do -- Record the transaction in the pending transaction table. focus <- getFocusBlock st <- blockState focus @@ -825,6 +824,9 @@ doAddPreverifiedTransaction blockItem okRes = do when (nextNonce <= transactionNonce tx) $ putPendingTransactions $! addPendingTransaction nextNonce WithMetadata{wmdData = tx, ..} ptrs + case wmdData of + NormalTransaction tx -> addPreverifiedAccountTransaction (TransactionV0 tx) + ExtendedTransaction tx -> addPreverifiedAccountTransaction (TransactionV1 tx) CredentialDeployment _ -> do putPendingTransactions $! addPendingDeployCredential wmdHash ptrs ChainUpdate cu -> do @@ -860,8 +862,7 @@ doReceiveTransactionInternal origin verifyBs tr ts slot = do addCommitTransaction tr ctx ts slot >>= \case Added bi@WithMetadata{..} verRes -> do ptrs <- getPendingTransactions - case wmdData of - NormalTransaction tx -> do + let addAccountTransaction tx = do -- Transactions received individually should always be added to the ptt. -- If the transaction was received as part of a block we only add it to the ptt if -- the transaction nonce is at least the `nextNonce` recorded for sender account. @@ -891,6 +892,9 @@ doReceiveTransactionInternal origin verifyBs tr ts slot = do -- the focus block, then we do not need to add it to the -- pending transactions. Otherwise, we do. when (nextNonce <= transactionNonce tx) $ add nextNonce + case wmdData of + NormalTransaction tx -> addAccountTransaction (TransactionV0 tx) + ExtendedTransaction tx -> addAccountTransaction (TransactionV1 tx) CredentialDeployment _ -> do putPendingTransactions $! addPendingDeployCredential wmdHash ptrs ChainUpdate cu -> do @@ -900,6 +904,7 @@ doReceiveTransactionInternal origin verifyBs tr ts slot = do when (nextSN <= updateSeqNumber (uiHeader cu)) $ putPendingTransactions $! addPendingUpdate nextSN cu ptrs + -- The actual verification result here is only used if the transaction was received individually. -- If the transaction was received as part of a block we don't use the result for anything. return (Just (bi, Just verRes), transactionVerificationResultToUpdateResult verRes) diff --git a/concordium-consensus/src/Concordium/TransactionVerification.hs b/concordium-consensus/src/Concordium/TransactionVerification.hs index c76be2df94..f76f93bb64 100644 --- a/concordium-consensus/src/Concordium/TransactionVerification.hs +++ b/concordium-consensus/src/Concordium/TransactionVerification.hs @@ -6,7 +6,6 @@ module Concordium.TransactionVerification where import qualified Data.Map.Strict as OrdMap import qualified Data.Serialize as S -import qualified Concordium.Cost as Cost import qualified Concordium.Crypto.SHA256 as Sha256 import qualified Concordium.GlobalState.Types as GSTypes import qualified Concordium.ID.Account as A @@ -15,6 +14,7 @@ import qualified Concordium.ID.IdentityProvider as IP import qualified Concordium.ID.Types as ID import qualified Concordium.Types as Types import Concordium.Types.HashableTo (getHash) +import Concordium.Types.Option import qualified Concordium.Types.Parameters as Params import qualified Concordium.Types.Transactions as Tx import Concordium.Types.Updates (UpdateSequenceNumber) @@ -72,6 +72,15 @@ data OkResult { keysHash :: !Sha256.Hash, nonce :: !Types.Nonce } + | -- | The extended transaction passed verification. + -- The result contains the hash of the keys of the sender and of the sponsor (if any), and the transaction nonce. + -- These can be used to short-circuit signature verification when executing the transaction. + -- If the sender or sponsor keys have changed for the account then the corresponding signature(s) have to be verified again. + ExtendedTransactionSuccess + { senderKeysHash :: !Sha256.Hash, + sponsorKeysHash :: !(Option Sha256.Hash), + nonce :: !Types.Nonce + } | -- | At start-up, the transaction was taken from a block that has already been verified, so -- we trust that it was verified correctly, but do not have the keys used to verify it. TrustedSuccess @@ -102,11 +111,11 @@ data MaybeOkResult -- The result contains the next nonce. -- Reason for 'MaybeOk': the nonce could be valid at a later point in time. NormalTransactionInvalidNonce !Types.Nonce - | -- | The sender does not have enough funds to cover the transfer. - -- Reason for 'MaybeOk': the sender could have enough funds at a later point in time. + | -- | The sender (or sponsor) does not have enough funds to cover the transfer. + -- Reason for 'MaybeOk': the sender (or sponsor) could have enough funds at a later point in time. NormalTransactionInsufficientFunds - | -- | The 'NormalTransaction' contained invalid signatures. - -- Reason for 'MaybeOk': the sender could've changed account information at a later point in time. + | -- | The 'NormalTransaction' (or sponsored) contained invalid signatures. + -- Reason for 'MaybeOk': the sender/sponsor could've changed account information at a later point in time. NormalTransactionInvalidSignatures | -- | The energy requirement of the transaction exceeds the maximum allowed for a block. -- P6 makes the maxBlockEnergy configurable as a chain parameter, so it could be valid in a future block where @@ -114,6 +123,9 @@ data MaybeOkResult -- This is treated as a 'MaybeOk' for simplicity also for older protocol versions as the transaction will -- be rejected when executed anyhow if it is surpassing the maximum block energy limit. NormalTransactionEnergyExceeded + | -- | The sponsored transaction contained an invalid sponsor. + -- Reason for 'MaybeOk': the sponsor could exist at a later point in time. + ExtendedTransactionInvalidSponsor !Types.AccountAddress deriving (Eq, Show, Ord) -- | Verification results which always should result in a transaction being rejected. @@ -144,6 +156,10 @@ data NotOkResult Expired | -- | Transaction payload size exceeds protocol limit. InvalidPayloadSize + | -- | The transaction has a sponsor signature, but the sponsor is not specified in the header. + SponsoredTransactionMissingSponsor + | -- | The transaction has a sponsor specified in the header, but no sponsor signature. + SponsoredTransactionMissingSponsorSignature deriving (Eq, Show, Ord) -- | Type which can verify transactions in a monadic context. @@ -215,6 +231,8 @@ verify now bi = do verifyChainUpdate ui Tx.WithMetadata{wmdData = Tx.NormalTransaction tx} -> do verifyNormalTransaction tx + Tx.WithMetadata{wmdData = Tx.ExtendedTransaction tx} -> + verifyExtendedTransaction tx -- | Verifies a 'CredentialDeployment' transaction. -- @@ -316,7 +334,7 @@ verifyNormalTransaction meta = throwError $ NotOk InvalidPayloadSize -- Check that enough energy is supplied - let cost = Cost.baseCost (Tx.getTransactionHeaderPayloadSize $ Tx.transactionHeader meta) (Tx.getTransactionNumSigs (Tx.transactionSignature meta)) + let cost = Tx.transactionBaseCost meta unless (Tx.transactionGasAmount meta >= cost) $ throwError $ NotOk NormalTransactionDepositInsufficient -- Check that the required energy does not exceed the maximum allowed for a block maxEnergy <- lift getMaxBlockEnergy @@ -351,6 +369,88 @@ verifyNormalTransaction meta = return $ Ok $ NormalTransactionSuccess (getHash keys) nonce ) +-- | Verifies an 'ExtendedTransaction' transaction. +-- This function verifies the following: +-- * Checks that enough energy is supplied for the transaction. +-- * Checks that if a sponsor is specified, a sponsor signature is present as well. +-- * CHecks that if no sponsor is specified, no sponsor signature is present. +-- * Checks that the sender is a valid account. +-- * Checks that the sponsor is a valid account, if present. +-- * Checks that the nonce is correct. +-- * Checks that the 'ExtendedTransaction' is correctly signed by both sender and the optional sponsor. +verifyExtendedTransaction :: + forall m msg. + (TransactionVerifier m, Tx.TransactionData msg) => + msg -> + m VerificationResult +verifyExtendedTransaction meta = + either id id + <$> runExceptT + ( do + unless (Types.validatePayloadSize (Types.protocolVersion @(Types.MPV m)) (Tx.thPayloadSize (Tx.transactionHeader meta))) $ + throwError $ + NotOk InvalidPayloadSize + + -- Check that either both, the sponsor and the sponsor signature are specified or neither. + mbSponsorAddr <- case (Tx.transactionSponsor meta, Tx.transactionSponsorSignature meta) of + (Just sponsorAddr, Just _sponsorSig) -> return $ Just sponsorAddr + (Nothing, Nothing) -> return Nothing + (Just _sponsorAddr, Nothing) -> throwError $ NotOk SponsoredTransactionMissingSponsorSignature + (Nothing, Just _sponsorSignature) -> throwError $ NotOk SponsoredTransactionMissingSponsor + + -- Check that enough energy is supplied + let cost = Tx.transactionBaseCost meta + unless (Tx.transactionGasAmount meta >= cost) $ throwError $ NotOk NormalTransactionDepositInsufficient + -- Check that the required energy does not exceed the maximum allowed for a block + maxEnergy <- lift getMaxBlockEnergy + when (Tx.transactionGasAmount meta > maxEnergy) $ throwError $ MaybeOk NormalTransactionEnergyExceeded + -- Check that the sender account exists + let senderAddr = Tx.transactionSender meta + mbSenderAcc <- lift (getAccount senderAddr) + senderAcc <- case mbSenderAcc of + Nothing -> throwError (MaybeOk $ NormalTransactionInvalidSender senderAddr) + Just senderAcc -> return senderAcc + -- Check that the sponsor account exists if a sponsor is present + mbSponsorAcc <- case mbSponsorAddr of + Just sponsorAddr -> do + macc <- lift (getAccount sponsorAddr) + case macc of + Nothing -> throwError (MaybeOk $ ExtendedTransactionInvalidSponsor sponsorAddr) + Just acc -> return $ Just acc + Nothing -> return Nothing + -- Check that the nonce of the transaction is correct. + nextNonce <- lift (getNextAccountNonce senderAcc) + let nonce = Tx.transactionNonce meta + when (nonce < nextNonce) $ throwError (NotOk $ NormalTransactionDuplicateNonce nonce) + -- For transactions received as part of a `Block` we only check that the `Nonce` + -- is not too old with respect to the 'last finalized block' or the 'parent block'. + -- In the `Scheduler` we check that the `Nonce` is actually the next one. + -- The reason for this is that otherwise when transactions are received via a block + -- we don't know what the next nonce is as we can't verify in the context of the 'block' which the + -- transactions were received with. Hence if there are multiple transactions from the same account within the same block, + -- which would lead us to rejecting the valid transaction(s). + exactNonce <- lift checkExactNonce + when (exactNonce && nonce /= nextNonce) $ throwError (MaybeOk $ NormalTransactionInvalidNonce nextNonce) + -- check that the sender or sponsor account has enough funds to cover the transfer + amnt <- case mbSponsorAcc of + Nothing -> lift $ getAccountAvailableAmount senderAcc + Just sponsorAcc -> lift $ getAccountAvailableAmount sponsorAcc + depositedAmount <- lift (energyToCcd (Tx.transactionGasAmount meta)) + unless (depositedAmount <= amnt) $ throwError $ MaybeOk NormalTransactionInsufficientFunds + -- Check the sender and sponsor signatures + senderKeys <- lift (getAccountVerificationKeys senderAcc) + case mbSponsorAcc of + Nothing -> do + let sigCheck = Tx.verifyTransaction senderKeys meta + unless sigCheck $ throwError $ MaybeOk NormalTransactionInvalidSignatures + return $ Ok $ ExtendedTransactionSuccess (getHash senderKeys) Absent nonce + Just sponsorAcc -> do + sponsorKeys <- lift (getAccountVerificationKeys sponsorAcc) + let sigCheck = Tx.verifySponsoredTransaction senderKeys sponsorKeys meta + unless sigCheck $ throwError $ MaybeOk NormalTransactionInvalidSignatures + return $ Ok $ ExtendedTransactionSuccess (getHash senderKeys) (Present $ getHash sponsorKeys) nonce + ) + -- | Wrapper types for pairing a transaction with its verification result (if it has one). -- The purpose of these types is to provide a uniform api between the 'TransactionTable' and the 'TreeState'. -- diff --git a/concordium-consensus/src/Concordium/Types/TransactionOutcomes.hs b/concordium-consensus/src/Concordium/Types/TransactionOutcomes.hs index b1c13db00a..67a9350887 100644 --- a/concordium-consensus/src/Concordium/Types/TransactionOutcomes.hs +++ b/concordium-consensus/src/Concordium/Types/TransactionOutcomes.hs @@ -27,25 +27,25 @@ import Concordium.Utils.Serialization -- | Outcomes of transactions. The vector of outcomes must have the same size as the -- number of transactions in the block, and ordered in the same way. -data TransactionOutcomes = TransactionOutcomes - { outcomeValues :: !(Vec.Vector TransactionSummary), +data TransactionOutcomes (tov :: TransactionOutcomesVersion) = TransactionOutcomes + { outcomeValues :: !(Vec.Vector (TransactionSummary tov)), _outcomeSpecial :: !(Seq.Seq SpecialTransactionOutcome) } makeLenses ''TransactionOutcomes -instance Show TransactionOutcomes where +instance Show (TransactionOutcomes tov) where show (TransactionOutcomes v s) = "Normal transactions: " ++ show (Vec.toList v) ++ ", special transactions: " ++ show s -putTransactionOutcomes :: S.Putter TransactionOutcomes +putTransactionOutcomes :: S.Putter (TransactionOutcomes tov) putTransactionOutcomes TransactionOutcomes{..} = do putListOf putTransactionSummary (Vec.toList outcomeValues) S.put _outcomeSpecial -getTransactionOutcomes :: SProtocolVersion pv -> S.Get TransactionOutcomes +getTransactionOutcomes :: SProtocolVersion pv -> S.Get (TransactionOutcomes (TransactionOutcomesVersionFor pv)) getTransactionOutcomes spv = TransactionOutcomes <$> (Vec.fromList <$> getListOf (getTransactionSummary spv)) <*> S.get -instance HashableTo (TransactionOutcomesHashV 'TOV0) TransactionOutcomes where +instance HashableTo (TransactionOutcomesHashV 'TOV0) (TransactionOutcomes 'TOV0) where getHash transactionoutcomes = TransactionOutcomesHashV . H.hash . S.runPut $ putTransactionOutcomes transactionoutcomes @@ -92,7 +92,7 @@ newtype TransactionOutcomesHashV (tov :: TransactionOutcomesVersion) = Transacti toTransactionOutcomesHash :: TransactionOutcomesHashV tov -> TransactionOutcomesHash toTransactionOutcomesHash = TransactionOutcomesHash . theTransactionOutcomesHashV -emptyTransactionOutcomesV0 :: TransactionOutcomes +emptyTransactionOutcomesV0 :: TransactionOutcomes 'TOV0 emptyTransactionOutcomesV0 = TransactionOutcomes Vec.empty Seq.empty -- | Hash of the empty V0 transaction outcomes structure. This transaction outcomes @@ -123,22 +123,34 @@ emptyTransactionOutcomesHashV2 = S.putWord64be 0 S.put (H.hash "EmptyLFMBTree") +-- | Hash of the empty V3 transaction outcomes structure. This transaction outcomes +-- structure is used starting in protocol version 10. +emptyTransactionOutcomesHashV3 :: TransactionOutcomesHashV 'TOV3 +{-# NOINLINE emptyTransactionOutcomesHashV3 #-} +emptyTransactionOutcomesHashV3 = + TransactionOutcomesHashV $ H.hashOfHashes emptyHash emptyHash + where + emptyHash = H.hash $ S.runPut $ do + S.putWord64be 0 + S.put (H.hash "EmptyLFMBTree") + emptyTransactionOutcomesHashV :: STransactionOutcomesVersion tov -> TransactionOutcomesHashV tov emptyTransactionOutcomesHashV stov = case stov of STOV0 -> emptyTransactionOutcomesHashV0 STOV1 -> emptyTransactionOutcomesHashV1 STOV2 -> emptyTransactionOutcomesHashV2 + STOV3 -> emptyTransactionOutcomesHashV3 -transactionOutcomesV0FromList :: [TransactionSummary] -> TransactionOutcomes +transactionOutcomesV0FromList :: [TransactionSummary tov] -> TransactionOutcomes tov transactionOutcomesV0FromList l = let outcomeValues = Vec.fromList l _outcomeSpecial = Seq.empty in TransactionOutcomes{..} -type instance Index TransactionOutcomes = TransactionIndex -type instance IxValue TransactionOutcomes = TransactionSummary +type instance Index (TransactionOutcomes tov) = TransactionIndex +type instance IxValue (TransactionOutcomes tov) = TransactionSummary tov -instance Ixed TransactionOutcomes where +instance Ixed (TransactionOutcomes tov) where ix idx f outcomes@TransactionOutcomes{..} = let x = fromIntegral idx in if x >= length outcomeValues diff --git a/concordium-consensus/test-runners/app/Main.hs b/concordium-consensus/test-runners/app/Main.hs index 143eff4252..7ed64d9730 100644 --- a/concordium-consensus/test-runners/app/Main.hs +++ b/concordium-consensus/test-runners/app/Main.hs @@ -86,7 +86,7 @@ protocolUpdateTransactions :: Timestamp -> [BlockItem] protocolUpdateTransactions (Timestamp ts) = [ui] where ui = - addMetadata id 0 $ + addMetadata 0 $ ChainUpdate $ makeUpdateInstruction RawUpdateInstruction diff --git a/concordium-consensus/test-runners/catchup/Main.hs b/concordium-consensus/test-runners/catchup/Main.hs index 15de0952f3..ed708cefb0 100644 --- a/concordium-consensus/test-runners/catchup/Main.hs +++ b/concordium-consensus/test-runners/catchup/Main.hs @@ -86,7 +86,7 @@ protocolUpdateTransactions :: Timestamp -> [BlockItem] protocolUpdateTransactions (Timestamp ts) = [ui] where ui = - addMetadata id 0 $ + addMetadata 0 $ ChainUpdate $ makeUpdateInstruction RawUpdateInstruction diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs index 4c07616e85..f59ff093f8 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs @@ -62,21 +62,21 @@ cred3 = readAccountCreation . BSL.fromStrict $ $(makeRelativeToProject "testdata -- | A credential deployment transaction yielding cred1. credBi1 :: BlockItem credBi1 = - credentialDeployment $ addMetadata (\x -> CredentialDeployment{biCred = x}) (tt + 1) cred1 + makeBlockItem (tt + 1) cred1 where tt = utcTimeToTransactionTime testTime -- | A credential deployment transaction yielding cred2. credBi2 :: BlockItem credBi2 = - credentialDeployment $ addMetadata (\x -> CredentialDeployment{biCred = x}) (tt + 1) cred2 + makeBlockItem (tt + 1) cred2 where tt = utcTimeToTransactionTime testTime -- | A credential deployment transaction yielding cred3 credBi3 :: BlockItem credBi3 = - credentialDeployment $ addMetadata (\x -> CredentialDeployment{biCred = x}) (tt + 1) cred3 + makeBlockItem (tt + 1) cred3 where tt = utcTimeToTransactionTime testTime diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs index 65c3197a56..55b023f45e 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs @@ -28,8 +28,8 @@ import qualified ConcordiumTests.KonsensusV1.Common as Common import ConcordiumTests.KonsensusV1.Consensus.Blocks hiding (testBB1, testBB2, testBB2', testBB3, testBB3', tests) -- | Make a raw transfer transaction with the provided nonce. -mkTransferTransaction :: Nonce -> BareBlockItem -mkTransferTransaction nonce = NormalTransaction{biTransaction = signTransactionSingle foundationKeyPair mkHeader payload} +mkTransferTransaction :: Nonce -> AccountTransaction +mkTransferTransaction nonce = signTransactionSingle foundationKeyPair mkHeader payload where mkHeader = TransactionHeader @@ -43,11 +43,11 @@ mkTransferTransaction nonce = NormalTransaction{biTransaction = signTransactionS -- | A transfer with nonce 1 for testBB1 transfer1 :: BlockItem -transfer1 = normalTransaction $ addMetadata (\x -> NormalTransaction{biTransaction = x}) 1000 (biTransaction $ mkTransferTransaction 1) +transfer1 = makeBlockItem 1000 (mkTransferTransaction 1) -- | A transfer with nonce 2 for testBB4 transfer2 :: BlockItem -transfer2 = normalTransaction $ addMetadata (\x -> NormalTransaction{biTransaction = x}) 1001 (biTransaction $ mkTransferTransaction 2) +transfer2 = makeBlockItem 1000 (mkTransferTransaction 2) -- | Valid block for round 1 with 1 normal transfer testBB1 :: forall pv. (IsProtocolVersion pv, IsConsensusV1 pv) => BakedBlock pv diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs index dd581dd92d..8439d0fed8 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs @@ -277,7 +277,7 @@ firstTimeoutMessageFor sProtocolVersion qc curRound curEpoch = -- | Helper to compute the transaction outcomes hash for a given set of transaction outcomes and -- special transaction outcomes. transactionOutcomesHashV1 :: - [TransactionSummaryV1] -> + [TransactionSummaryV1 tov] -> [Transactions.SpecialTransactionOutcome] -> TransactionOutcomes.TransactionOutcomesHash transactionOutcomesHashV1 outcomes specialOutcomes = diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LMDB.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LMDB.hs index c0bae4775b..2862cf0778 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LMDB.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LMDB.hs @@ -140,14 +140,13 @@ dummyTransactionHeader = -- data. dummyBlockItem :: BlockItem dummyBlockItem = - addMetadata id dummyTransactionTime $ - NormalTransaction $ - AccountTransaction - { atrSignature = TransactionSignature $ Map.fromList [(1, Map.fromList [(1, Signature "bla")])], - atrHeader = dummyTransactionHeader, - atrPayload = EncodedPayload "bla", - atrSignHash = TransactionSignHashV0 dummyHash - } + makeBlockItem dummyTransactionTime $ + AccountTransaction + { atrSignature = TransactionSignature $ Map.fromList [(1, Map.fromList [(1, Signature "bla")])], + atrHeader = dummyTransactionHeader, + atrPayload = EncodedPayload "bla", + atrSignHash = TransactionSignHashV0 dummyHash + } -- | A helper function for creating a block with the given round and block items. -- Blocks with different hashes can then be constructed by calling this function with different rounds. diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs index bc887718b7..478aa71880 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs @@ -4,8 +4,10 @@ {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- | This module tests processing of transactions for consensus V1. @@ -19,6 +21,7 @@ module ConcordiumTests.KonsensusV1.TransactionProcessingTest where import Control.Monad import Control.Monad.Catch +import Control.Monad.Identity import Control.Monad.Reader import Control.Monad.State import qualified Data.Aeson as AE @@ -30,15 +33,18 @@ import Data.Kind (Type) import qualified Data.Map.Strict as Map import Data.Maybe (isJust) import Data.Ratio +import qualified Data.Text as T import Data.Time.Clock import Data.Time.Clock.POSIX import qualified Data.Vector as Vec +import Data.Void import Lens.Micro.Platform import System.Random import Test.HUnit import Test.Hspec import Concordium.Common.Version +import Concordium.Constants import Concordium.Crypto.DummyData import qualified Concordium.Crypto.SHA256 as Hash import qualified Concordium.Crypto.SignatureScheme as SigScheme @@ -58,7 +64,10 @@ import Concordium.GlobalState.Persistent.BlobStore import Concordium.GlobalState.Persistent.BlockState import Concordium.GlobalState.Persistent.Genesis (genesisState) import Concordium.GlobalState.TransactionTable +import Concordium.GlobalState.Transactions +import qualified Concordium.GlobalState.Types as GSTypes import Concordium.ID.Types (randomAccountAddress) +import qualified Concordium.ID.Types as ID import Concordium.Logger import Concordium.Scheduler.DummyData import Concordium.TimeMonad @@ -74,8 +83,8 @@ import Concordium.Types.TransactionOutcomes import Concordium.Types.Transactions import Concordium.Types.Updates import Concordium.Utils +import Concordium.Wasm (WasmVersion) -import Concordium.GlobalState.Transactions import Concordium.KonsensusV1.Transactions import Concordium.KonsensusV1.TreeState.Implementation import Concordium.KonsensusV1.TreeState.Types @@ -124,11 +133,11 @@ myCryptographicParameters = -- | The valid credential deployment wrapped in 'WithMetadata' and @1@ for the transaction time. credentialDeploymentWM :: WithMetadata AccountCreation -credentialDeploymentWM = addMetadata CredentialDeployment 1 validAccountCreation +credentialDeploymentWM = addMetadata 1 validAccountCreation -- | The valid credential deployment wrapped in a 'BlockItem'. dummyCredentialDeployment :: BlockItem -dummyCredentialDeployment = credentialDeployment credentialDeploymentWM +dummyCredentialDeployment = toBlockItem credentialDeploymentWM -- | A dummy credential deployment 'TransactionHash'. dummyCredentialDeploymentHash :: TransactionHash @@ -340,7 +349,7 @@ dummyAccountAddress = fst $ randomAccountAddress (mkStdGen 42) -- Note. that the signature is not correct either. dummyNormalTransaction :: Transaction dummyNormalTransaction = - addMetadata NormalTransaction 0 $ + addMetadata 0 . TransactionV0 $ makeAccountTransaction dummyTransactionSignature hdr @@ -359,7 +368,7 @@ dummyNormalTransaction = -- | A dummy update instruction. dummyUpdateInstruction :: TransactionTime -> WithMetadata UpdateInstruction dummyUpdateInstruction effTime = - addMetadata ChainUpdate 0 $ + addMetadata 0 $ makeUpdateInstruction RawUpdateInstruction { ruiSeqNumber = 1, @@ -380,11 +389,11 @@ dummyUpdateInstruction effTime = -- | The block item for 'dummyNormalTransaction'. dummyNormalTransactionBI :: BlockItem -dummyNormalTransactionBI = normalTransaction dummyNormalTransaction +dummyNormalTransactionBI = toBlockItem dummyNormalTransaction -- | The block item for 'dummyUpdateInstruction'. dummyChainUpdateBI :: TransactionTime -> BlockItem -dummyChainUpdateBI effTime = chainUpdate $ dummyUpdateInstruction effTime +dummyChainUpdateBI effTime = toBlockItem $ dummyUpdateInstruction effTime -- | Test for transaction verification testTransactionVerification :: @@ -446,7 +455,7 @@ testProcessBlockItem _ = describe "processBlockItem" $ do -- The credential deployment must be in the the transaction table at this point. assertEqual "The transaction table should yield the 'Received' credential deployment with a round 0 as commit point" - (HM.fromList [(dummyCredentialDeploymentHash, (credentialDeployment credentialDeploymentWM, Received (commitPoint $! Round 0) (TVer.Ok TVer.CredentialDeploymentSuccess)))]) + (HM.fromList [(dummyCredentialDeploymentHash, (toBlockItem credentialDeploymentWM, Received (commitPoint $! Round 0) (TVer.Ok TVer.CredentialDeploymentSuccess)))]) (sd' ^. transactionTable . ttHashMap) -- The purge counter must be incremented at this point. assertEqual @@ -506,7 +515,7 @@ testProcessBlockItem _ = describe "processBlockItem" $ do -- The credential deployment that was not deemed duplicate must be in the the transaction table at this point. assertEqual "The transaction table should yield the 'Received' credential deployment with a round 0 as commit point" - (HM.fromList [(dummyCredentialDeploymentHash, (credentialDeployment credentialDeploymentWM, Received (commitPoint $! Round 0) (TVer.Ok TVer.CredentialDeploymentSuccess)))]) + (HM.fromList [(dummyCredentialDeploymentHash, (toBlockItem credentialDeploymentWM, Received (commitPoint $! Round 0) (TVer.Ok TVer.CredentialDeploymentSuccess)))]) (sd' ^. transactionTable . ttHashMap) -- The purge counter must be incremented only once at this point. assertEqual @@ -573,7 +582,7 @@ testProcessBlockItems sProtocolVersion = describe "processBlockItems" $ do (sd' ^. transactionTablePurgeCounter) assertEqual "The transaction table should yield the 'Received' credential deployment with a round 1 as commit point" - (HM.fromList [(dummyCredentialDeploymentHash, (credentialDeployment credentialDeploymentWM, Received (commitPoint $! Round 1) (TVer.Ok TVer.CredentialDeploymentSuccess)))]) + (HM.fromList [(dummyCredentialDeploymentHash, (toBlockItem credentialDeploymentWM, Received (commitPoint $! Round 1) (TVer.Ok TVer.CredentialDeploymentSuccess)))]) (sd' ^. transactionTable . ttHashMap) where theTime :: UTCTime @@ -615,6 +624,641 @@ testProcessBlockItems sProtocolVersion = describe "processBlockItems" $ do .. } +-- TransactionVerifier testing +------------------------------ + +-- | Test data used for testing transaction verification +data TransactionVerifierTestData (pv :: ProtocolVersion) = TransactionVerifierTestData + { tvtdAccounts :: !(Map.Map (GSTypes.Account (TVTM pv)) (AccountTestData pv)), + tvtdAccountsByAddress :: !(Map.Map AccountAddress (GSTypes.Account (TVTM pv))), + tvtdEnergyRate :: !EnergyRate, + tvtdCheckExactNonce :: !Bool + } + +data AccountTestData (pv :: ProtocolVersion) = AccountTestData + { atdAccountAvailableAmount :: !Amount, + atdAccountNonce :: !Nonce, + atdAccountVerificationKeys :: ID.AccountInformation + } + +-- The transaction verifier test monad. +newtype TVTM (pv :: ProtocolVersion) a = TVTM + { runTVTM :: TransactionVerifierT' (TransactionVerifierTestData pv) Identity a + } + deriving (Functor, Applicative, Monad, MonadReader (TransactionVerifierTestData pv)) + +instance + forall (pv :: ProtocolVersion). + (IsProtocolVersion pv, IsCompatibleAuthorizationsVersion (ChainParametersVersionFor pv) (AuthorizationsVersionFor pv) ~ 'True) => + MonadProtocolVersion (TVTM pv) + where + type MPV (TVTM pv) = pv + +-- Used to define the following type family instances. +data WasmVersionedVoid (v :: WasmVersion) + +instance forall (pv :: ProtocolVersion). GSTypes.BlockStateTypes (TVTM pv) where + type Account (TVTM pv) = T.Text + type BlockState (TVTM pv) = Void + type UpdatableBlockState (TVTM pv) = Void + type ContractState (TVTM pv) = WasmVersionedVoid + type BakerInfoRef (TVTM pv) = Void + type InstrumentedModuleRef (TVTM pv) = WasmVersionedVoid + type MutableTokenState (TVTM pv) = Void + +instance + forall (pv :: ProtocolVersion). + (IsProtocolVersion pv, IsCompatibleAuthorizationsVersion (ChainParametersVersionFor pv) (AuthorizationsVersionFor pv) ~ 'True) => + TVer.TransactionVerifier (TVTM pv) + where + getAccount addr = do + testData <- ask + return $ Map.lookup addr $ tvtdAccountsByAddress testData + + getAccountAvailableAmount acc = do + testData <- tvtdAccounts <$> ask + case Map.lookup acc testData of + Nothing -> error "account not available in test data" + Just atd -> return $ atdAccountAvailableAmount atd + + getNextAccountNonce acc = do + testData <- tvtdAccounts <$> ask + case Map.lookup acc testData of + Nothing -> error "account not available in test data" + Just atd -> return $ atdAccountNonce atd + + getAccountVerificationKeys acc = do + testData <- tvtdAccounts <$> ask + case Map.lookup acc testData of + Nothing -> error "account not available in test data" + Just atd -> return $ atdAccountVerificationKeys atd + + getMaxBlockEnergy = return 1000 + + -- For testing we assume exact nonces. + checkExactNonce = tvtdCheckExactNonce <$> ask + + energyToCcd nrg = do + testData <- ask + return $ computeCost (tvtdEnergyRate testData) nrg + + -- We currently don't use the following for testing. + getIdentityProvider = error "Unexpected use of `getIdentityProvider` in TransactionVerifierTestM" + getAnonymityRevokers = error "Unexpected use of `getAnonymityRevokers` in TransactionVerifierTestM" + getCryptographicParameters = error "Unexpected use of `getCryptographicParameters` in TransactionVerifierTestM" + registrationIdExists = error "Unexpected use of `registrationIdExists` in TransactionVerifierTestM" + getNextUpdateSequenceNumber = error "Unexpected use of `getNextUpdateSequenceNumber` in TransactionVerifierTestM" + getUpdateKeysCollection = error "Unexpected use of `getUpdateKeysCollection` in TransactionVerifierTestM" + +-- | Tests for the transaction verification of extended transaction introduced in P10. +testExtendedTransactionVerification :: + forall pv. + (IsConsensusV1 pv, IsProtocolVersion pv) => + SProtocolVersion pv -> + Spec +testExtendedTransactionVerification spv = do + it "A well-formed extended transaction with sponsor should pass verification" $ do + let + txHeader = + TransactionHeaderV1 + { thv1HeaderV0 = + TransactionHeader + { thSender = senderAccountAddress, + thNonce = 2, + thEnergyAmount = 302, + thPayloadSize = 8, + thExpiry = 0 + }, + thv1Sponsor = Just sponsorAccountAddress + } + txPayload = EncodedPayload "deadbeef" + txBodyHash = transactionV1SignHashFromHeaderPayload txHeader txPayload + senderTxSignature = makeTxSignature senderKeyPair txBodyHash + sponsorTxSignature = makeTxSignature sponsorKeyPair txBodyHash + txSignatures = + TransactionSignaturesV1 + { tsv1Sender = senderTxSignature, + tsv1Sponsor = Just sponsorTxSignature + } + tx = makeAccountTransactionV1 txSignatures txHeader txPayload + let res = + runIdentity $ + (runTransactionVerifierT $ runTVTM $ TVer.verifyExtendedTransaction tx) + testData + assertEqual + "The verification should yield the expected `Ok ExtendTransactionSuccess` result" + ( TVer.Ok + TVer.ExtendedTransactionSuccess + { senderKeysHash = getHash senderAccountVerificationKeys, + sponsorKeysHash = Present $ getHash sponsorAccountVerificationKeys, + nonce = 2 + } + ) + res + it "A transaction with a too big payload size should be rejected" $ do + let + txHeader = + TransactionHeaderV1 + { thv1HeaderV0 = + TransactionHeader + { thSender = senderAccountAddress, + thNonce = 2, + thEnergyAmount = 302, + thPayloadSize = (fromIntegral $ maxPayloadSize spv + 1), + thExpiry = 0 + }, + thv1Sponsor = Just sponsorAccountAddress + } + txPayload = EncodedPayload "deadbeef" + txBodyHash = transactionV1SignHashFromHeaderPayload txHeader txPayload + senderTxSignature = makeTxSignature senderKeyPair txBodyHash + sponsorTxSignature = makeTxSignature sponsorKeyPair txBodyHash + txSignatures = + TransactionSignaturesV1 + { tsv1Sender = senderTxSignature, + tsv1Sponsor = Just sponsorTxSignature + } + tx = makeAccountTransactionV1 txSignatures txHeader txPayload + let res = + runIdentity $ + (runTransactionVerifierT $ runTVTM $ TVer.verifyExtendedTransaction tx) + testData + assertEqual + "The verification should yield the expected `NotOk InvalidPayloadSize` result" + (TVer.NotOk TVer.InvalidPayloadSize) + res + + it "A transaction with a sponsor address but without sponsor signature should be rejected" $ do + let + txHeader = + TransactionHeaderV1 + { thv1HeaderV0 = + TransactionHeader + { thSender = senderAccountAddress, + thNonce = 2, + thEnergyAmount = 302, + thPayloadSize = 8, + thExpiry = 0 + }, + thv1Sponsor = Just sponsorAccountAddress + } + txPayload = EncodedPayload "deadbeef" + txBodyHash = transactionV1SignHashFromHeaderPayload txHeader txPayload + senderTxSignature = makeTxSignature senderKeyPair txBodyHash + txSignatures = + TransactionSignaturesV1 + { tsv1Sender = senderTxSignature, + tsv1Sponsor = Nothing + } + tx = makeAccountTransactionV1 txSignatures txHeader txPayload + let res = + runIdentity $ + (runTransactionVerifierT $ runTVTM $ TVer.verifyExtendedTransaction tx) + testData + assertEqual + "The verification should yield the expected `NotOk SponsoredTransactionMissingSponsorSignature` result" + (TVer.NotOk TVer.SponsoredTransactionMissingSponsorSignature) + res + it "A transaction with no sponsor address but a sponsor signature should be rejected" $ do + let + txHeader = + TransactionHeaderV1 + { thv1HeaderV0 = + TransactionHeader + { thSender = senderAccountAddress, + thNonce = 2, + thEnergyAmount = 302, + thPayloadSize = 8, + thExpiry = 0 + }, + thv1Sponsor = Nothing + } + txPayload = EncodedPayload "deadbeef" + txBodyHash = transactionV1SignHashFromHeaderPayload txHeader txPayload + senderTxSignature = makeTxSignature senderKeyPair txBodyHash + sponsorTxSignature = makeTxSignature sponsorKeyPair txBodyHash + txSignatures = + TransactionSignaturesV1 + { tsv1Sender = senderTxSignature, + tsv1Sponsor = Just sponsorTxSignature + } + tx = makeAccountTransactionV1 txSignatures txHeader txPayload + let res = + runIdentity $ + (runTransactionVerifierT $ runTVTM $ TVer.verifyExtendedTransaction tx) + testData + assertEqual + "The verification should yield the expected `NotOk SponsoredTransactionMissingSponsor` result" + (TVer.NotOk TVer.SponsoredTransactionMissingSponsor) + res + it "An extended transaction with too little energy should be rejected" $ do + let + txHeader = + TransactionHeaderV1 + { thv1HeaderV0 = + TransactionHeader + { thSender = senderAccountAddress, + thNonce = 2, + -- cost: 302 + -- V1 header: 2 (bitmap) + 60 (V0 header) + 32 (sponsor address) = 94 + -- payload: 8 + -- signatures: 2 * 100 + thEnergyAmount = 301, + thPayloadSize = 8, + thExpiry = 0 + }, + thv1Sponsor = Just sponsorAccountAddress + } + txPayload = EncodedPayload "deadbeef" + txBodyHash = transactionV1SignHashFromHeaderPayload txHeader txPayload + senderTxSignature = makeTxSignature senderKeyPair txBodyHash + sponsorTxSignature = makeTxSignature sponsorKeyPair txBodyHash + txSignatures = + TransactionSignaturesV1 + { tsv1Sender = senderTxSignature, + tsv1Sponsor = Just sponsorTxSignature + } + tx = makeAccountTransactionV1 txSignatures txHeader txPayload + let res = + runIdentity $ + (runTransactionVerifierT $ runTVTM $ TVer.verifyExtendedTransaction tx) + testData + assertEqual + "The verification should yield the expected `NotOk NormalTransactionDepositInsufficient` result" + (TVer.NotOk TVer.NormalTransactionDepositInsufficient) + res + it "An extended transaction with energy exceeding the maximally allowed energy should be rejected" $ do + let + txHeader = + TransactionHeaderV1 + { thv1HeaderV0 = + TransactionHeader + { thSender = senderAccountAddress, + thNonce = 2, + -- max energy is set by the TVTM mock to 1000 + thEnergyAmount = fromIntegral $ (1000 + 1 :: Int), + thPayloadSize = 8, + thExpiry = 0 + }, + thv1Sponsor = Just sponsorAccountAddress + } + txPayload = EncodedPayload "deadbeef" + txBodyHash = transactionV1SignHashFromHeaderPayload txHeader txPayload + senderTxSignature = makeTxSignature senderKeyPair txBodyHash + sponsorTxSignature = makeTxSignature sponsorKeyPair txBodyHash + txSignatures = + TransactionSignaturesV1 + { tsv1Sender = senderTxSignature, + tsv1Sponsor = Just sponsorTxSignature + } + tx = makeAccountTransactionV1 txSignatures txHeader txPayload + let res = + runIdentity $ + (runTransactionVerifierT $ runTVTM $ TVer.verifyExtendedTransaction tx) + testData + assertEqual + "The verification should yield the expected `MaybeOk NormalTransactionEnergyExceeded` result" + (TVer.MaybeOk TVer.NormalTransactionEnergyExceeded) + res + + it "An extended transaction with nonce < next expected nonce should not pass verification" $ do + let + txHeader = + TransactionHeaderV1 + { thv1HeaderV0 = + TransactionHeader + { thSender = senderAccountAddress, + thNonce = 1, + thEnergyAmount = 302, + thPayloadSize = 8, + thExpiry = 0 + }, + thv1Sponsor = Just sponsorAccountAddress + } + txPayload = EncodedPayload "deadbeef" + txBodyHash = transactionV1SignHashFromHeaderPayload txHeader txPayload + senderTxSignature = makeTxSignature senderKeyPair txBodyHash + sponsorTxSignature = makeTxSignature sponsorKeyPair txBodyHash + txSignatures = + TransactionSignaturesV1 + { tsv1Sender = senderTxSignature, + tsv1Sponsor = Just sponsorTxSignature + } + tx = makeAccountTransactionV1 txSignatures txHeader txPayload + let res = + runIdentity $ + (runTransactionVerifierT $ runTVTM $ TVer.verifyExtendedTransaction tx) + testData + assertEqual + "The verification should yield the expected `NotOk NormalTransactionDuplicateNonce` result" + (TVer.NotOk $ TVer.NormalTransactionDuplicateNonce 1) + res + it "An extended transaction with nonce > next expected nonce should not pass verification if `checkExactNonce == True`" $ do + let + txHeader = + TransactionHeaderV1 + { thv1HeaderV0 = + TransactionHeader + { thSender = senderAccountAddress, + -- the expected nonce is 2 + thNonce = 3, + thEnergyAmount = 302, + thPayloadSize = 8, + thExpiry = 0 + }, + thv1Sponsor = Just sponsorAccountAddress + } + txPayload = EncodedPayload "deadbeef" + txBodyHash = transactionV1SignHashFromHeaderPayload txHeader txPayload + senderTxSignature = makeTxSignature senderKeyPair txBodyHash + sponsorTxSignature = makeTxSignature sponsorKeyPair txBodyHash + txSignatures = + TransactionSignaturesV1 + { tsv1Sender = senderTxSignature, + tsv1Sponsor = Just sponsorTxSignature + } + tx = makeAccountTransactionV1 txSignatures txHeader txPayload + let res = + runIdentity $ + (runTransactionVerifierT $ runTVTM $ TVer.verifyExtendedTransaction tx) + testData + assertEqual + "The verification should yield the expected `MaybeOk NormalTransactionInvalidNonce` result" + (TVer.MaybeOk $ TVer.NormalTransactionInvalidNonce 2) + res + it "An extended transaction with nonce > next expected nonce should pass verification if `checkExactNonce == False`" $ do + let + txHeader = + TransactionHeaderV1 + { thv1HeaderV0 = + TransactionHeader + { thSender = senderAccountAddress, + -- the expected nonce is 1 + thNonce = 3, + thEnergyAmount = 302, + thPayloadSize = 8, + thExpiry = 0 + }, + thv1Sponsor = Just sponsorAccountAddress + } + txPayload = EncodedPayload "deadbeef" + txBodyHash = transactionV1SignHashFromHeaderPayload txHeader txPayload + senderTxSignature = makeTxSignature senderKeyPair txBodyHash + sponsorTxSignature = makeTxSignature sponsorKeyPair txBodyHash + txSignatures = + TransactionSignaturesV1 + { tsv1Sender = senderTxSignature, + tsv1Sponsor = Just sponsorTxSignature + } + tx = makeAccountTransactionV1 txSignatures txHeader txPayload + let res = + runIdentity $ + (runTransactionVerifierT $ runTVTM $ TVer.verifyExtendedTransaction tx) + testDataNotExactNonce + assertEqual + "The verification should yield the expected `Ok ExtendedTransactionSuccess` result" + ( TVer.Ok + TVer.ExtendedTransactionSuccess + { senderKeysHash = getHash senderAccountVerificationKeys, + sponsorKeysHash = Present $ getHash sponsorAccountVerificationKeys, + nonce = 3 + } + ) + res + it "An extended transaction with sponsor but missing sponsor account should not pass verification" $ do + let + txHeader = + TransactionHeaderV1 + { thv1HeaderV0 = + TransactionHeader + { thSender = senderAccountAddress, + thNonce = 2, + thEnergyAmount = 302, + thPayloadSize = 8, + thExpiry = 0 + }, + thv1Sponsor = Just sponsorAccountAddress + } + txPayload = EncodedPayload "deadbeef" + txBodyHash = transactionV1SignHashFromHeaderPayload txHeader txPayload + senderTxSignature = makeTxSignature senderKeyPair txBodyHash + sponsorTxSignature = makeTxSignature sponsorKeyPair txBodyHash + txSignatures = + TransactionSignaturesV1 + { tsv1Sender = senderTxSignature, + tsv1Sponsor = Just sponsorTxSignature + } + tx = makeAccountTransactionV1 txSignatures txHeader txPayload + let res = + runIdentity $ + (runTransactionVerifierT $ runTVTM $ TVer.verifyExtendedTransaction tx) + testDataNoSponsor + assertEqual + "The verification should yield the expected `MaybeOk ExtendedTransactionInvalidSponsor` result" + (TVer.MaybeOk $ TVer.ExtendedTransactionInvalidSponsor sponsorAccountAddress) + res + it "An extended transaction where the sponsor has too little funds should be rejected" $ do + let + txHeader = + TransactionHeaderV1 + { thv1HeaderV0 = + TransactionHeader + { thSender = senderAccountAddress, + thNonce = 2, + thEnergyAmount = 302, + thPayloadSize = 8, + thExpiry = 0 + }, + thv1Sponsor = Just sponsorAccountAddress + } + txPayload = EncodedPayload "deadbeef" + txBodyHash = transactionV1SignHashFromHeaderPayload txHeader txPayload + senderTxSignature = makeTxSignature senderKeyPair txBodyHash + sponsorTxSignature = makeTxSignature sponsorKeyPair txBodyHash + txSignatures = + TransactionSignaturesV1 + { tsv1Sender = senderTxSignature, + tsv1Sponsor = Just sponsorTxSignature + } + tx = makeAccountTransactionV1 txSignatures txHeader txPayload + let res = + runIdentity $ + (runTransactionVerifierT $ runTVTM $ TVer.verifyExtendedTransaction tx) + testDataTooLittleFunding + assertEqual + "The verification should yield the expected `MaybeOk NormalTransactionInsufficientFunds` result" + (TVer.MaybeOk $ TVer.NormalTransactionInsufficientFunds) + res + it "An extended transaction with invalid sender signature should be rejected" $ do + let + txHeader = + TransactionHeaderV1 + { thv1HeaderV0 = + TransactionHeader + { thSender = senderAccountAddress, + thNonce = 2, + thEnergyAmount = 302, + thPayloadSize = 8, + thExpiry = 0 + }, + thv1Sponsor = Just sponsorAccountAddress + } + txPayload = EncodedPayload "deadbeef" + txBodyHash = transactionV1SignHashFromHeaderPayload txHeader txPayload + senderTxSignature = + TransactionSignature $ + Map.singleton + 0 + ( Map.singleton + 0 + (SigScheme.sign senderKeyPair "nice_try") + ) + sponsorTxSignature = makeTxSignature sponsorKeyPair txBodyHash + txSignatures = + TransactionSignaturesV1 + { tsv1Sender = senderTxSignature, + tsv1Sponsor = Just sponsorTxSignature + } + tx = makeAccountTransactionV1 txSignatures txHeader txPayload + let res = + runIdentity $ + (runTransactionVerifierT $ runTVTM $ TVer.verifyExtendedTransaction tx) + testData + assertEqual + "The verification should yield the expected `MaybeOk NormalTransactionInvalidSignatures` result" + (TVer.MaybeOk $ TVer.NormalTransactionInvalidSignatures) + res + it "An extended transaction with invalid sponsor signature should be rejected" $ do + let + txHeader = + TransactionHeaderV1 + { thv1HeaderV0 = + TransactionHeader + { thSender = senderAccountAddress, + thNonce = 2, + thEnergyAmount = 302, + thPayloadSize = 8, + thExpiry = 0 + }, + thv1Sponsor = Just sponsorAccountAddress + } + txPayload = EncodedPayload "deadbeef" + txBodyHash = transactionV1SignHashFromHeaderPayload txHeader txPayload + senderTxSignature = makeTxSignature senderKeyPair txBodyHash + sponsorTxSignature = + TransactionSignature $ + Map.singleton + 0 + ( Map.singleton + 0 + (SigScheme.sign sponsorKeyPair "some_other_transaction") + ) + txSignatures = + TransactionSignaturesV1 + { tsv1Sender = senderTxSignature, + tsv1Sponsor = Just sponsorTxSignature + } + tx = makeAccountTransactionV1 txSignatures txHeader txPayload + let res = + runIdentity $ + (runTransactionVerifierT $ runTVTM $ TVer.verifyExtendedTransaction tx) + testData + assertEqual + "The verification should yield the expected `MaybeOk NormalTransactionInvalidSignatures` result" + (TVer.MaybeOk $ TVer.NormalTransactionInvalidSignatures) + res + where + senderAccountAddress = fst $ randomAccountAddress (mkStdGen 42) + sponsorAccountAddress = fst $ randomAccountAddress (mkStdGen 43) + ((senderSignKey, senderVerifyKey), _) = randomEd25519KeyPair $ mkStdGen 42 + senderKeyPair = + SigScheme.KeyPairEd25519 + { signKey = senderSignKey, + verifyKey = senderVerifyKey + } + ((sponsorSignKey, sponsorVerifyKey), _) = randomEd25519KeyPair $ mkStdGen 43 + sponsorKeyPair = + SigScheme.KeyPairEd25519 + { signKey = sponsorSignKey, + verifyKey = sponsorVerifyKey + } + mkAccountVerificationKeys key = + ID.AccountInformation + { aiCredentials = + Map.singleton + (ID.CredentialIndex 0) + ( ID.CredentialPublicKeys + { credKeys = Map.singleton 0 (SigScheme.VerifyKeyEd25519 key), + credThreshold = 0 + } + ), + aiThreshold = 0 + } + senderAccountVerificationKeys = mkAccountVerificationKeys senderVerifyKey + sponsorAccountVerificationKeys = mkAccountVerificationKeys sponsorVerifyKey + makeTxSignature keyPair txBodyHash = + TransactionSignature $ + Map.singleton + 0 + ( Map.singleton + 0 + (SigScheme.sign keyPair (transactionSignHashToByteString txBodyHash)) + ) + mkTestData :: Amount -> Amount -> Bool -> TransactionVerifierTestData pv + mkTestData senderAvailableAmount sponsorAvailableAmount checkExactNonce = + TransactionVerifierTestData + { tvtdAccounts = + Map.fromList + [ ( "sender_account", + AccountTestData + { -- transasction cost is `computeCost 1/3 302` = 100+2/3 + atdAccountAvailableAmount = senderAvailableAmount, + atdAccountNonce = 2, + atdAccountVerificationKeys = senderAccountVerificationKeys + } + ), + ( "sponsor_account", + AccountTestData + { atdAccountAvailableAmount = sponsorAvailableAmount, + atdAccountNonce = 2, + atdAccountVerificationKeys = sponsorAccountVerificationKeys + } + ) + ], + tvtdAccountsByAddress = + Map.fromList + [ (senderAccountAddress, "sender_account"), + (sponsorAccountAddress, "sponsor_account") + ], + tvtdEnergyRate = 1 % 3, + tvtdCheckExactNonce = checkExactNonce + } + -- the minimal funding for the test transactions + minFunding = 101 + testData = mkTestData minFunding minFunding True + testDataNotExactNonce = mkTestData minFunding minFunding False + testDataTooLittleFunding = mkTestData minFunding (minFunding - 1) True + -- test data with missing sponsor account + testDataNoSponsor :: TransactionVerifierTestData pv = + TransactionVerifierTestData + { tvtdAccounts = + Map.fromList + [ ( "sender_account", + AccountTestData + { atdAccountAvailableAmount = minFunding, + atdAccountNonce = 2, + atdAccountVerificationKeys = senderAccountVerificationKeys + } + ) + ], + tvtdAccountsByAddress = + Map.fromList + [ (senderAccountAddress, "sender_account") + ], + tvtdEnergyRate = 1 % 3, + tvtdCheckExactNonce = True + } + tests :: Spec tests = describe "KonsensusV1.TransactionProcessing" $ do Common.forEveryProtocolVersionConsensusV1 $ \spv pvString -> @@ -626,3 +1270,6 @@ tests = describe "KonsensusV1.TransactionProcessing" $ do describe "P9" $ do describe "Transaction verification" $ testTransactionVerification SP9 + describe "P10" $ do + describe "ExtendedTransaction verification" $ + testExtendedTransactionVerification SP10 diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs index a16f8b6513..2c8992d08e 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs @@ -515,7 +515,7 @@ dummyAccountAddress = dummyAccountAddressN 0 -- does no transaction processing i.e. verification of the transaction. dummyTransaction' :: AccountAddress -> Nonce -> Transaction dummyTransaction' accAddr n = - addMetadata NormalTransaction 0 $ + addMetadata 0 . TransactionV0 $ makeAccountTransaction dummyTransactionSignature hdr @@ -535,13 +535,13 @@ dummyTransactionFromSender :: AccountAddress -> Nonce -> Transaction dummyTransactionFromSender = dummyTransaction' dummyTransactionBIFromSender :: AccountAddress -> Nonce -> BlockItem -dummyTransactionBIFromSender accAddr = normalTransaction . (dummyTransactionFromSender accAddr) +dummyTransactionBIFromSender accAddr = toBlockItem . (dummyTransactionFromSender accAddr) dummyTransaction :: Nonce -> Transaction dummyTransaction = dummyTransaction' dummyAccountAddress dummyTransactionBI :: Nonce -> BlockItem -dummyTransactionBI = normalTransaction . dummyTransaction +dummyTransactionBI = toBlockItem . dummyTransaction dummySuccessTransactionResult :: Nonce -> TVer.VerificationResult dummySuccessTransactionResult n = @@ -571,20 +571,20 @@ dummyUpdateInstruction usn = dummyUpdateInstructionWM :: UpdateSequenceNumber -> WithMetadata UpdateInstruction dummyUpdateInstructionWM usn = - addMetadata ChainUpdate 0 $ dummyUpdateInstruction usn + addMetadata 0 $ dummyUpdateInstruction usn dummyChainUpdate :: UpdateSequenceNumber -> BlockItem -dummyChainUpdate usn = chainUpdate $ dummyUpdateInstructionWM usn +dummyChainUpdate usn = toBlockItem $ dummyUpdateInstructionWM usn -- | A valid 'AccountCreation' with expiry 1596409020 dummyAccountCreation :: AccountCreation dummyAccountCreation = readAccountCreation . BSL.fromStrict $ $(makeRelativeToProject "testdata/transactionverification/verifiable-credential.json" >>= embedFile) credentialDeploymentWM :: WithMetadata AccountCreation -credentialDeploymentWM = addMetadata CredentialDeployment 0 dummyAccountCreation +credentialDeploymentWM = addMetadata 0 dummyAccountCreation dummyCredentialDeployment :: BlockItem -dummyCredentialDeployment = credentialDeployment credentialDeploymentWM +dummyCredentialDeployment = toBlockItem credentialDeploymentWM -- | Testing 'lookupLiveTransaction' -- This test ensures that live transactions can be @@ -810,17 +810,17 @@ testRemoveTransactions :: Spec testRemoveTransactions _ = describe "finalizeTransactions" $ do it "normal transactions" $ do - sd' <- execStateT (finalizeTransactions [normalTransaction tr0]) sd + sd' <- execStateT (finalizeTransactions [toBlockItem tr0]) sd assertEqual "Account non-finalized transactions" (Just TT.AccountNonFinalizedTransactions{_anftMap = Map.singleton 2 (Map.singleton tr1 (dummySuccessTransactionResult 2))}) (sd' ^. transactionTable . TT.ttNonFinalizedTransactions . at sender) assertEqual "transaction hash map" - (HM.fromList [(getHash tr1, (normalTransaction tr1, TT.Received 0 (dummySuccessTransactionResult 2)))]) + (HM.fromList [(getHash tr1, (toBlockItem tr1, TT.Received 0 (dummySuccessTransactionResult 2)))]) (sd' ^. transactionTable . TT.ttHashMap) it "chain updates" $ do - sd' <- execStateT (finalizeTransactions [chainUpdate cu0]) sd1 + sd' <- execStateT (finalizeTransactions [toBlockItem cu0]) sd1 assertEqual "Chain update non-finalized transactions" (Just TT.NonFinalizedChainUpdates{_nfcuNextSequenceNumber = 2, _nfcuMap = Map.singleton 2 (Map.singleton cu1 (dummySuccessTransactionResult 2))}) @@ -828,20 +828,20 @@ testRemoveTransactions _ = describe "finalizeTransactions" $ do assertEqual "transaction hash map" ( HM.fromList - [ (getHash cu1, (chainUpdate cu1, TT.Received 0 (dummySuccessTransactionResult 2))), - (getHash tr1, (normalTransaction tr1, TT.Received 0 (dummySuccessTransactionResult 2))) + [ (getHash cu1, (toBlockItem cu1, TT.Received 0 (dummySuccessTransactionResult 2))), + (getHash tr1, (toBlockItem tr1, TT.Received 0 (dummySuccessTransactionResult 2))) ] ) (sd' ^. transactionTable . TT.ttHashMap) it "credential deployments" $ do - sd' <- execStateT (finalizeTransactions [credentialDeployment cred0]) sd2 + sd' <- execStateT (finalizeTransactions [toBlockItem cred0]) sd2 assertEqual "Non-finalized credential deployments" (sd' ^. transactionTable . TT.ttHashMap . at credDeploymentHash) Nothing assertEqual "transaction hash map" - (HM.fromList [(getHash tr1, (normalTransaction tr1, TT.Received 0 (dummySuccessTransactionResult 2)))]) + (HM.fromList [(getHash tr1, (toBlockItem tr1, TT.Received 0 (dummySuccessTransactionResult 2)))]) (sd' ^. transactionTable . TT.ttHashMap) where sender = accountAddressEmbed dummyAccountAddress @@ -851,8 +851,8 @@ testRemoveTransactions _ = describe "finalizeTransactions" $ do cu0 = dummyUpdateInstructionWM 1 cu1 = dummyUpdateInstructionWM 2 cred0 = credentialDeploymentWM - addTrans t = snd . TT.addTransaction (normalTransaction t) 0 (dummySuccessTransactionResult (transactionNonce t)) - addChainUpdate u = snd . TT.addTransaction (chainUpdate u) 0 (dummySuccessTransactionResult (updateSeqNumber $ uiHeader $ wmdData u)) + addTrans t = snd . TT.addTransaction (toBlockItem t) 0 (dummySuccessTransactionResult (transactionNonce t)) + addChainUpdate u = snd . TT.addTransaction (toBlockItem u) 0 (dummySuccessTransactionResult (updateSeqNumber $ uiHeader $ wmdData u)) addCredential = snd . TT.addTransaction dummyCredentialDeployment 0 dummySuccessCredentialDeployment credDeploymentHash = getHash dummyCredentialDeployment sd = @@ -885,21 +885,21 @@ testAddTransaction :: Spec testAddTransaction _ = describe "addTransaction" $ do it "add transaction" $ do - sd' <- execStateT (addTransaction tr0Round (normalTransaction tr0) (dummySuccessTransactionResult 1)) (dummyInitialSkovData @pv) + sd' <- execStateT (addTransaction tr0Round (toBlockItem tr0) (dummySuccessTransactionResult 1)) (dummyInitialSkovData @pv) assertEqual "Account non-finalized transactions" (Just TT.AccountNonFinalizedTransactions{_anftMap = Map.singleton 1 (Map.singleton tr0 (dummySuccessTransactionResult 1))}) (sd' ^. transactionTable . TT.ttNonFinalizedTransactions . at sender) assertEqual "transaction hash map" - (HM.fromList [(getHash tr0, (normalTransaction tr0, TT.Received (TT.commitPoint tr0Round) (dummySuccessTransactionResult 1)))]) + (HM.fromList [(getHash tr0, (toBlockItem tr0, TT.Received (TT.commitPoint tr0Round) (dummySuccessTransactionResult 1)))]) (sd' ^. transactionTable . TT.ttHashMap) assertEqual "transaction table purge counter is incremented" (1 + (dummyInitialSkovData @pv) ^. transactionTablePurgeCounter) (sd' ^. transactionTablePurgeCounter) - sd'' <- execStateT (finalizeTransactions [normalTransaction tr0]) sd' - added <- evalStateT (addTransaction tr0Round (normalTransaction tr1) (dummySuccessTransactionResult 1)) sd'' + sd'' <- execStateT (finalizeTransactions [toBlockItem tr0]) sd' + added <- evalStateT (addTransaction tr0Round (toBlockItem tr1) (dummySuccessTransactionResult 1)) sd'' assertEqual "tx should be added" True added where tr0Round = 1 @@ -917,14 +917,14 @@ testCommitTransaction :: Spec testCommitTransaction _ = describe "commitTransaction" $ do it "commit transaction" $ do - sd' <- execStateT (commitTransaction 1 bh 0 (normalTransaction tr0)) sd + sd' <- execStateT (commitTransaction 1 bh 0 (toBlockItem tr0)) sd assertEqual "transaction hash map" - (HM.fromList [(getHash tr0, (normalTransaction tr0, TT.Committed 1 (dummySuccessTransactionResult (transactionNonce tr0)) $ HM.fromList [(bh, TransactionIndex 0)]))]) + (HM.fromList [(getHash tr0, (toBlockItem tr0, TT.Committed 1 (dummySuccessTransactionResult (transactionNonce tr0)) $ HM.fromList [(bh, TransactionIndex 0)]))]) (sd' ^. transactionTable . TT.ttHashMap) where tr0 = dummyTransaction 1 - addTrans t = snd . TT.addTransaction (normalTransaction t) 0 (dummySuccessTransactionResult (transactionNonce t)) + addTrans t = snd . TT.addTransaction (toBlockItem t) 0 (dummySuccessTransactionResult (transactionNonce t)) sd = dummyInitialSkovData @pv & transactionTable @@ -945,21 +945,21 @@ testMarkTransactionDead :: Spec testMarkTransactionDead _ = describe "markTransactionDead" $ do it "mark committed transaction dead" $ do - sd' <- execStateT (commitTransaction 1 bh 0 (normalTransaction tr0)) sd - sd'' <- execStateT (markTransactionDead bh (normalTransaction tr0)) sd' + sd' <- execStateT (commitTransaction 1 bh 0 (toBlockItem tr0)) sd + sd'' <- execStateT (markTransactionDead bh (toBlockItem tr0)) sd' assertEqual "transaction hash map" - (HM.fromList [(getHash tr0, (normalTransaction tr0, TT.Received 1 (dummySuccessTransactionResult (transactionNonce tr0))))]) + (HM.fromList [(getHash tr0, (toBlockItem tr0, TT.Received 1 (dummySuccessTransactionResult (transactionNonce tr0))))]) (sd'' ^. transactionTable . TT.ttHashMap) it "mark received transaction dead" $ do - sd' <- execStateT (markTransactionDead bh (normalTransaction tr0)) sd + sd' <- execStateT (markTransactionDead bh (toBlockItem tr0)) sd assertEqual "transaction hash map" - (HM.fromList [(getHash tr0, (normalTransaction tr0, TT.Received 0 (dummySuccessTransactionResult (transactionNonce tr0))))]) + (HM.fromList [(getHash tr0, (toBlockItem tr0, TT.Received 0 (dummySuccessTransactionResult (transactionNonce tr0))))]) (sd' ^. transactionTable . TT.ttHashMap) where tr0 = dummyTransaction 1 - addTrans t = snd . TT.addTransaction (normalTransaction t) 0 (dummySuccessTransactionResult (transactionNonce t)) + addTrans t = snd . TT.addTransaction (toBlockItem t) 0 (dummySuccessTransactionResult (transactionNonce t)) sd = dummyInitialSkovData @pv & transactionTable @@ -979,7 +979,7 @@ testPurgeTransactionTable :: testPurgeTransactionTable _ = describe "purgeTransactionTable" $ do it "force purge the transaction table" $ do -- increment the purge counter. - sd' <- execStateT (addTransaction 0 (normalTransaction tr0) (dummySuccessTransactionResult 1)) sd + sd' <- execStateT (addTransaction 0 (toBlockItem tr0) (dummySuccessTransactionResult 1)) sd sd'' <- execStateT (purgeTransactionTable True theTime) sd' assertEqual "purge counter should be reset" @@ -998,7 +998,7 @@ testPurgeTransactionTable _ = describe "purgeTransactionTable" $ do Nothing (sd'' ^. transactionTable . TT.ttHashMap . at credDeploymentHash) where - addChainUpdate u = snd . TT.addTransaction (chainUpdate u) 0 (dummySuccessTransactionResult (updateSeqNumber $ uiHeader $ wmdData u)) + addChainUpdate u = snd . TT.addTransaction (toBlockItem u) 0 (dummySuccessTransactionResult (updateSeqNumber $ uiHeader $ wmdData u)) addCredential = snd . TT.addTransaction dummyCredentialDeployment 0 dummySuccessCredentialDeployment tr0 = dummyTransaction 1 cu0 = dummyUpdateInstructionWM 1 @@ -1028,7 +1028,7 @@ testClearOnProtocolUpdate :: Spec testClearOnProtocolUpdate _ = describe "clearOnProtocolUpdate" $ it "clears on protocol update" $ do - sd' <- execStateT (commitTransaction 1 bh 0 (normalTransaction tr0)) sd + sd' <- execStateT (commitTransaction 1 bh 0 (toBlockItem tr0)) sd sd'' <- execStateT clearOnProtocolUpdate sd' assertEqual "block table should be empty" @@ -1040,12 +1040,12 @@ testClearOnProtocolUpdate _ = describe "clearOnProtocolUpdate" $ (sd'' ^. branches) assertEqual "committed transactions should be received with commit point 0" - (HM.fromList [(getHash tr0, (normalTransaction tr0, TT.Received 0 (dummySuccessTransactionResult 1)))]) + (HM.fromList [(getHash tr0, (toBlockItem tr0, TT.Received 0 (dummySuccessTransactionResult 1)))]) (sd'' ^. transactionTable . TT.ttHashMap) where tr0 = dummyTransaction 1 bh = BlockHash minBound - addTrans t = snd . TT.addTransaction (normalTransaction t) 0 (dummySuccessTransactionResult (transactionNonce t)) + addTrans t = snd . TT.addTransaction (toBlockItem t) 0 (dummySuccessTransactionResult (transactionNonce t)) sd = skovDataWithTestBlocks @pv & transactionTable diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/ReceiveTransactionsTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/ReceiveTransactionsTest.hs index eb960ecc68..f469ddbc44 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/ReceiveTransactionsTest.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/ReceiveTransactionsTest.hs @@ -116,7 +116,7 @@ test = do now = posixSecondsToUTCTime $ credentialDeploymentExpiryTime - 1 txArrivalTime = utcTimeToTransactionTime now genesis = testGenesisData now myips myars myCryptoParams - txs = [toBlockItem txArrivalTime mycdi, toBlockItem txArrivalTime myicdi] + txs = [makeBlockItem txArrivalTime mycdi, makeBlockItem txArrivalTime myicdi] s <- runTransactions testDoReceiveTransaction txs now genesis let results = fst s resultingState = snd s @@ -164,7 +164,7 @@ test = do let credentialDeploymentExpiryTime = 1596409020 now = posixSecondsToUTCTime $ credentialDeploymentExpiryTime - 1 txArrivalTime = utcTimeToTransactionTime now - txs = [toBlockItem txArrivalTime mycdi, toBlockItem txArrivalTime myicdi] + txs = [makeBlockItem txArrivalTime mycdi, makeBlockItem txArrivalTime myicdi] genesis = testGenesisData now myips myars myCryptoParams s <- runTransactions testDoReceiveTransactionInternal txs now genesis let results = fst s @@ -176,8 +176,8 @@ test = do let now = utcTimeToTransactionTime theTime genesis = testGenesisData theTime dummyIdentityProviders dummyArs dummyCryptographicParameters txs = - [ toBlockItem now $ mkAccountTransaction (now + 1) True 2 True TheCost, - toBlockItem now $ mkAccountTransaction (now + 1) True 1 True TheCost + [ makeBlockItem now $ mkAccountTransaction (now + 1) True 2 True TheCost, + makeBlockItem now $ mkAccountTransaction (now + 1) True 1 True TheCost ] s <- runTransactions testDoReceiveTransactionInternal txs theTime genesis let results = fst s @@ -316,13 +316,13 @@ accountCreations gCtx now = ] where expiry = now + 1 - expiredTransaction = toBlockItem now (mkAccountCreation (now - 1) (regId 1) 0 True True False) - expiredCredentialDeployment = toBlockItem now (mkAccountCreation expiry (regId 1) 0 True True True) - credentialDeploymentWithDuplicateRegId = toBlockItem now (mkAccountCreation expiry duplicateRegId 0 True True False) - credentialWithInvalidIP = toBlockItem now (mkAccountCreation expiry (regId 1) 42 True True False) - credentialWithInvalidAr = toBlockItem now (mkAccountCreation expiry (regId 1) 0 False True False) - credentialWithInvalidSignatures = toBlockItem now (mkAccountCreation expiry (regId 1) 0 True True False) - intialCredentialWithInvalidSignatures = toBlockItem now (mkInitialAccountCreationWithInvalidSignatures expiry (regId 42)) + expiredTransaction = makeBlockItem now (mkAccountCreation (now - 1) (regId 1) 0 True True False) + expiredCredentialDeployment = makeBlockItem now (mkAccountCreation expiry (regId 1) 0 True True True) + credentialDeploymentWithDuplicateRegId = makeBlockItem now (mkAccountCreation expiry duplicateRegId 0 True True False) + credentialWithInvalidIP = makeBlockItem now (mkAccountCreation expiry (regId 1) 42 True True False) + credentialWithInvalidAr = makeBlockItem now (mkAccountCreation expiry (regId 1) 0 False True False) + credentialWithInvalidSignatures = makeBlockItem now (mkAccountCreation expiry (regId 1) 0 True True False) + intialCredentialWithInvalidSignatures = makeBlockItem now (mkInitialAccountCreationWithInvalidSignatures expiry (regId 42)) regId seed = RegIdCred $ generateGroupElementFromSeed gCtx seed chainUpdates :: TransactionTime -> [BlockItem] @@ -335,12 +335,12 @@ chainUpdates now = verifiable ] where - expiredTimeout = toBlockItem now (mkChainUpdate (now - 1) (now - 1) getValidSequenceNumber True) - invalidEffectiveTime = toBlockItem now (mkChainUpdate (now + 1) (now + 2) getValidSequenceNumber True) - sequenceNumberTooOld = toBlockItem now (mkChainUpdate (now + 2) (now + 1) getTooOldSequenceNumber True) - sequenceNumberTooLarge = toBlockItem now (mkChainUpdate (now + 2) (now + 1) getTooLargeSequenceNumber True) - invalidSignature = toBlockItem now (mkChainUpdate (now + 2) (now + 1) getValidSequenceNumber False) - verifiable = toBlockItem now (mkChainUpdate (now + 2) (now + 1) getValidSequenceNumber True) + expiredTimeout = makeBlockItem now (mkChainUpdate (now - 1) (now - 1) getValidSequenceNumber True) + invalidEffectiveTime = makeBlockItem now (mkChainUpdate (now + 1) (now + 2) getValidSequenceNumber True) + sequenceNumberTooOld = makeBlockItem now (mkChainUpdate (now + 2) (now + 1) getTooOldSequenceNumber True) + sequenceNumberTooLarge = makeBlockItem now (mkChainUpdate (now + 2) (now + 1) getTooLargeSequenceNumber True) + invalidSignature = makeBlockItem now (mkChainUpdate (now + 2) (now + 1) getValidSequenceNumber False) + verifiable = makeBlockItem now (mkChainUpdate (now + 2) (now + 1) getValidSequenceNumber True) getValidSequenceNumber = minUpdateSequenceNumber + 1 getTooOldSequenceNumber = minUpdateSequenceNumber getTooLargeSequenceNumber = minUpdateSequenceNumber + 2 @@ -362,33 +362,26 @@ normals now isSingle successNonce = atMaxBlockEnergy ] where - expired = toBlockItem now $ mkAccountTransaction (now - 1) True 1 True TheCost - depositInsufficient = toBlockItem now $ mkAccountTransaction (now + 1) True 1 True TooLittle - invalidSender = toBlockItem now $ mkAccountTransaction (now + 1) True 1 False TheCost + expired = makeBlockItem now $ mkAccountTransaction (now - 1) True 1 True TheCost + depositInsufficient = makeBlockItem now $ mkAccountTransaction (now + 1) True 1 True TooLittle + invalidSender = makeBlockItem now $ mkAccountTransaction (now + 1) True 1 False TheCost -- 'invalidNonce' should be accepted for transactions received individually, but rejected if it was part of a block. - nonceTooLarge = toBlockItem now $ mkAccountTransaction (now + 1) True 3 True TheCost + nonceTooLarge = makeBlockItem now $ mkAccountTransaction (now + 1) True 3 True TheCost -- since the one above was accepted because it was part of a block we must increment the nonce here, -- if the transaction is part of a block invalidSignature = if isSingle - then toBlockItem now $ mkAccountTransaction (now + 1) False 1 True TheCost - else toBlockItem now $ mkAccountTransaction (now + 1) False 3 True TheCost + then makeBlockItem now $ mkAccountTransaction (now + 1) False 1 True TheCost + else makeBlockItem now $ mkAccountTransaction (now + 1) False 3 True TheCost -- This ones also needs a nonce depending of the `TransactionOrigin` - verifiable nonce = toBlockItem now $ mkAccountTransaction (now + 1) True nonce True TheCost + verifiable nonce = makeBlockItem now $ mkAccountTransaction (now + 1) True nonce True TheCost -- Also this one. tooMuchEnergy = if isSingle - then toBlockItem now $ mkAccountTransaction (now + 1) True 2 True TooMuch - else toBlockItem now $ mkAccountTransaction (now + 1) True 5 True TooMuch + then makeBlockItem now $ mkAccountTransaction (now + 1) True 2 True TooMuch + else makeBlockItem now $ mkAccountTransaction (now + 1) True 5 True TooMuch -- transactions which state exactly the max block energy bound should be accepted - atMaxBlockEnergy = toBlockItem now $ mkAccountTransaction (now + 1) True (if isSingle then 3 else 6) True MaxBlockEnergy - -toBlockItem :: TransactionTime -> BareBlockItem -> BlockItem -toBlockItem now bbi = - case bbi of - CredentialDeployment cred -> credentialDeployment $ addMetadata (\x -> CredentialDeployment{biCred = x}) now cred - ChainUpdate ui -> chainUpdate $ addMetadata (\x -> ChainUpdate{biUpdate = x}) now ui - NormalTransaction tx -> normalTransaction $ addMetadata (\x -> NormalTransaction{biTransaction = x}) now tx + atMaxBlockEnergy = makeBlockItem now $ mkAccountTransaction (now + 1) True (if isSingle then 3 else 6) True MaxBlockEnergy duplicateRegId :: CredentialRegistrationID duplicateRegId = credId (makeTestCredentialFromSeed 1) diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/BlockHash.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/BlockHash.hs index 436748f99b..a6d10ed43c 100644 --- a/concordium-consensus/tests/globalstate/GlobalStateTests/BlockHash.hs +++ b/concordium-consensus/tests/globalstate/GlobalStateTests/BlockHash.hs @@ -108,21 +108,21 @@ defaultHash = Block.generateBlockHash slot parent bakerid bakerSVK blockP nonce -- (Note that this test does not perform any of such actions, -- hence it's ok to simply have the instance functions be -- defined as undefined.) -newtype DummyHashMonad a = DummyHashMonad {runDummyHashMonad :: a} +newtype DummyHashMonad (pv :: ProtocolVersion) a = DummyHashMonad {runDummyHashMonad :: a} deriving (Functor, Applicative, Monad) via Identity -instance MonadIO DummyHashMonad where +instance MonadIO (DummyHashMonad (pv :: ProtocolVersion)) where liftIO = undefined -instance MonadBlobStore DummyHashMonad where +instance MonadBlobStore (DummyHashMonad (pv :: ProtocolVersion)) where storeRaw = undefined loadRaw = undefined flushStore = undefined getCallbacks = undefined loadBlobPtr = undefined -instance MonadProtocolVersion DummyHashMonad where - type MPV DummyHashMonad = 'P6 +instance (IsProtocolVersion pv, IsCompatibleAuthorizationsVersion (ChainParametersVersionFor pv) (AuthorizationsVersionFor pv) ~ 'True) => MonadProtocolVersion (DummyHashMonad (pv :: ProtocolVersion)) where + type MPV (DummyHashMonad pv) = pv tests :: Spec tests = do @@ -197,13 +197,18 @@ tests = do defaultHash `shouldNotBe` hash' specify "Hash of emptyPersistentTransactionOutcomes (TOV0) is hash of emptyTransactionOutcomesV0" $ - runDummyHashMonad (getHashM (emptyPersistentTransactionOutcomes @'TOV0)) - `shouldBe` getHash @(TransactionOutcomesHashV 'TOV0) emptyTransactionOutcomesV0 + runDummyHashMonad @'P4 (getHashM (emptyPersistentTransactionOutcomes @'TOV0)) + `shouldBe` emptyTransactionOutcomesHashV0 specify "Hash of emptyPersistentTransactionOutcomes (TOV1) is emptyTransactionOutcomesHashV1" $ - runDummyHashMonad (getHashM (emptyPersistentTransactionOutcomes @'TOV1)) + runDummyHashMonad @'P6 (getHashM (emptyPersistentTransactionOutcomes @'TOV1)) `shouldBe` emptyTransactionOutcomesHashV1 specify "Hash of emptyPersistentTransactionOutcomes (TOV2) is emptyTransactionOutcomesHashV2" $ - runDummyHashMonad (getHashM (emptyPersistentTransactionOutcomes @'TOV2)) + runDummyHashMonad @'P9 (getHashM (emptyPersistentTransactionOutcomes @'TOV2)) `shouldBe` emptyTransactionOutcomesHashV2 + +-- TODO (RUN-18): Turn on tests for P10. +-- specify "Hash of emptyPersistentTransactionOutcomes (TOV3) is emptyTransactionOutcomesHashV3" $ +-- runDummyHashMonad @'P10 (getHashM (emptyPersistentTransactionOutcomes @'TOV3)) +-- `shouldBe` emptyTransactionOutcomesHashV3 diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/AccountTransactionSpecs.hs b/concordium-consensus/tests/scheduler/SchedulerTests/AccountTransactionSpecs.hs index a5c8aaf665..20108382f7 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/AccountTransactionSpecs.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/AccountTransactionSpecs.hs @@ -45,7 +45,7 @@ cdi7' = transactionsInput :: [CredentialDeploymentWithStatus] transactionsInput = - map ((\x -> (x, Nothing)) . Types.addMetadata Types.CredentialDeployment 0) $ + map ((\x -> (x, Nothing)) . Types.addMetadata 0) $ [ cdi1, cdi2, cdi3, @@ -104,7 +104,7 @@ testAccountCreation _ pvString = specify (map snd ftFailedCredentials) assertEqual "Execution cost should be 0." 0 srExecutionCosts where - checkState :: Helpers.SchedulerResult -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion + checkState :: Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState _ state = do doInvariantAssertions <- Helpers.assertBlockStateInvariantsH state 0 let addedAccountAddresses = diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/BakerTransactions.hs b/concordium-consensus/tests/scheduler/SchedulerTests/BakerTransactions.hs index 4bc7086eb5..1955bb1a5c 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/BakerTransactions.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/BakerTransactions.hs @@ -269,6 +269,7 @@ tests = do txs <- liftIO (processUngroupedTransactions transactionsInput) (outcomes, endState) <- Helpers.runSchedulerTestWithIntermediateStates + @(Types.TransactionOutcomesVersionFor PV1) @PV1 Helpers.defaultTestConfig initialBlockState diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/BlockEnergyLimitSpec.hs b/concordium-consensus/tests/scheduler/SchedulerTests/BlockEnergyLimitSpec.hs index 54e85694d0..f5867ae650 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/BlockEnergyLimitSpec.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/BlockEnergyLimitSpec.hs @@ -83,7 +83,7 @@ testMaxBlockEnergy _ pvString = specify (pvString ++ ": One valid, two invalid, -- block energy limit let ts = Types.TGCredentialDeployment - (Types.addMetadata Types.CredentialDeployment 0 cdi1, Nothing) + (Types.addMetadata 0 cdi1, Nothing) : ts' -- dummy arrival time of 0 (Helpers.SchedulerResult{..}, doBlockStateAssertions) <- Helpers.runSchedulerTest @@ -107,7 +107,7 @@ testMaxBlockEnergy _ pvString = specify (pvString ++ ": One valid, two invalid, ] -> do assertEqual "The first transaction should be valid:" - (Types.normalTransaction $ fst t1) + (Types.toBlockItem $ fst t1) $ fst t assertEqual "Correct energy cost: " Helpers.simpleTransferCost energyCost _ -> assertFailure "There should be one valid transaction with a TxSuccess result." @@ -120,7 +120,7 @@ testMaxBlockEnergy _ pvString = specify (pvString ++ ": One valid, two invalid, invalidTs assertEqual "The credential deployment is invalid." - [Types.addMetadata Types.CredentialDeployment 0 cdi1] + [Types.addMetadata 0 cdi1] $ map fst invalidCreds assertEqual "There is one normal transaction whose energy exceeds the block energy limit, and one with non-sequential nonce:" @@ -138,7 +138,7 @@ testMaxBlockEnergy _ pvString = specify (pvString ++ ": One valid, two invalid, doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result state = do @@ -150,7 +150,7 @@ testMaxBlockEnergy _ pvString = specify (pvString ++ ": One valid, two invalid, doAssertReloadedState blockStateAssertions :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion blockStateAssertions result state = do diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/ChainMetatest.hs b/concordium-consensus/tests/scheduler/SchedulerTests/ChainMetatest.hs index 5e483c05c5..ea6e37bbff 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/ChainMetatest.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/ChainMetatest.hs @@ -79,7 +79,7 @@ testChainMeta _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result state = do diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/ConfigureBaker.hs b/concordium-consensus/tests/scheduler/SchedulerTests/ConfigureBaker.hs index 486250c982..4489a1322f 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/ConfigureBaker.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/ConfigureBaker.hs @@ -300,7 +300,7 @@ testDelegatorToBakerOk spv pvString = transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 438 1 checkState :: BakerKeysWithProofs -> - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState keysWithProofs result blockState = do @@ -404,7 +404,7 @@ testDelegatorToBakerDuplicateKey spv pvString = -- Transaction length is 438 bytes (378 bytes for the transaction and 60 bytes for the header). transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 438 1 checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = do @@ -465,7 +465,7 @@ testDelegatorToBakerMissingParam spv pvString = -- Transaction length is 437 bytes (378 bytes for the transaction and 60 bytes for the header). transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 437 1 checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = do @@ -566,7 +566,7 @@ testAddBakerOk spv pvString = transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 439 1 checkState :: BakerKeysWithProofs -> - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState keysWithProofs result blockState = do @@ -660,7 +660,7 @@ testAddBakerInsufficientBalance _spv pvString = -- Transaction length is 438 bytes (379 bytes for the transaction and 60 bytes for the header). transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 439 1 checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = do @@ -719,7 +719,7 @@ testAddBakerMissingParam _spv pvString = -- Transaction length is 437 bytes (377 bytes for the transaction and 60 bytes for the header). transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 437 1 checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = do @@ -778,7 +778,7 @@ testAddBakerInvalidProofs _spv pvString = -- Transaction length is 438 bytes (379 bytes for the transaction and 60 bytes for the header). transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 439 1 checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = do @@ -862,7 +862,7 @@ testUpdateBakerOk _spv pvString = -- Transaction length is 79 bytes (19 bytes for the transaction and 60 bytes for the header). transactionEnergy = Cost.configureBakerCostWithoutKeys + Cost.baseCost 79 1 checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = do @@ -932,7 +932,7 @@ testUpdateBakerInsufficientBalance _spv pvString = -- Transaction length is 79 bytes (19 bytes for the transaction and 60 bytes for the header). transactionEnergy = Cost.configureBakerCostWithoutKeys + Cost.baseCost 79 1 checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = do @@ -989,7 +989,7 @@ testUpdateBakerLowStake _spv pvString = -- Transaction length is 79 bytes (19 bytes for the transaction and 60 bytes for the header). transactionEnergy = Cost.configureBakerCostWithoutKeys + Cost.baseCost 79 1 checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = do @@ -1047,7 +1047,7 @@ testUpdateBakerInvalidProofs _spv pvString = -- Transaction length is 415 bytes (355 bytes for the transaction and 60 bytes for the header). transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 415 1 checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = do @@ -1108,7 +1108,7 @@ testUpdateBakerRemoveOk spv pvString = -- Transaction length is 71 bytes (11 bytes for the transaction and 60 bytes for the header). transactionEnergy = Cost.configureBakerCostWithoutKeys + Cost.baseCost 71 1 checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = do @@ -1200,7 +1200,7 @@ testUpdateBakerReduceStakeOk spv pvString = transactionEnergy = Cost.configureBakerCostWithKeys + Cost.baseCost 431 1 checkState :: BakerKeysWithProofs -> - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState keysWithProofs result blockState = do @@ -1281,7 +1281,7 @@ testUpdateBakerSuspendResumeOk spv pvString suspendOrResume accM = -- Transaction length is 64 bytes (4 bytes for the transaction and 60 bytes for the header). transactionEnergy = Cost.configureBakerCostWithoutKeys + Cost.baseCost 64 1 checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = do diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs b/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs index bad4449195..d9267159c4 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/Delegation.hs @@ -258,7 +258,7 @@ testRemoveDelegatorWithStakeOverThreshold _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = do @@ -295,7 +295,7 @@ testReduceDelegatorStakeStillAboveCapThreshold _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = @@ -332,7 +332,7 @@ testTransactionRejectsIfStakeIncreasedOverThreshold _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = @@ -370,7 +370,7 @@ testReducingStakeAndTargetNewStakeOverCap _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = @@ -418,7 +418,7 @@ testChangingTargetAndReducingStake _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = @@ -455,7 +455,7 @@ testIncreaseStake _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = @@ -496,7 +496,7 @@ testIncreaseStakeAndTarget _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = @@ -533,7 +533,7 @@ testIncreaseStakeAndChangeTargetReject _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = @@ -570,7 +570,7 @@ testChangeTargetToOverdelegatedPool _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = @@ -607,7 +607,7 @@ testAddDelegator _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = @@ -650,7 +650,7 @@ testDelegatorWithZeroStake _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = @@ -691,7 +691,7 @@ testAddDelegatorWhenAlreadyBaker spv pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = @@ -739,7 +739,7 @@ testAddDelegatorWithZeroStakeWhenAlreadyBaker spv pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = do @@ -905,7 +905,7 @@ testDelegateToSelf spv pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = do diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/FibonacciSelfMessageTest.hs b/concordium-consensus/tests/scheduler/SchedulerTests/FibonacciSelfMessageTest.hs index 4ba99ff55a..4c6faac786 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/FibonacciSelfMessageTest.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/FibonacciSelfMessageTest.hs @@ -111,7 +111,7 @@ testCase1 _ pvString = } ] ensureAllUpdates :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion ensureAllUpdates Helpers.SchedulerResult{..} bs = do diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs b/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs index dae2de8855..b3209055e3 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/Helpers.hs @@ -28,6 +28,7 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Data.Word import Lens.Micro.Platform +import System.IO.Temp import Test.HUnit import qualified Concordium.Crypto.SHA256 as Hash @@ -61,7 +62,7 @@ import qualified Concordium.Scheduler.Types as Types import Concordium.TimeMonad import Concordium.Types (SProtocolVersion) -getResults :: [(a, Types.TransactionSummary)] -> [(a, Types.ValidResult)] +getResults :: [(a, Types.TransactionSummary tov)] -> [(a, Types.ValidResult)] getResults = map (\(x, r) -> (x, Types.tsResult r)) -- | The cost for processing a simple transfer (account to account) @@ -142,7 +143,8 @@ forEveryProtocolVersion check = check Types.SP6 "P6", check Types.SP7 "P7", check Types.SP8 "P8", - check Types.SP9 "P9" + check Types.SP9 "P9", + check Types.SP10 "P10" ] -- | Convert an energy value to an amount, based on the exchange rates used in @@ -205,9 +207,10 @@ runTestBlockStateWithCacheSize :: Int -> PersistentBSM pv a -> IO a runTestBlockStateWithCacheSize cacheSize computation = runSilentLogger $ Blob.runBlobStoreTemp "." $ - BS.withNewAccountCacheAndLMDBAccountMap cacheSize "accountmap" $ - BS.runPersistentBlockStateMonad $ - _runPersistentBSM computation + withTempDirectory "." "accountmap" $ \amPath -> + BS.withNewAccountCacheAndLMDBAccountMap cacheSize amPath $ + BS.runPersistentBlockStateMonad $ + _runPersistentBSM computation -- | Run test block state computation with a account cache size and module cache size of 100. -- @@ -246,9 +249,9 @@ defaultContextState = } -- | Result from running the scheduler in a test environment. -data SchedulerResult = SchedulerResult +data SchedulerResult (tov :: Types.TransactionOutcomesVersion) = SchedulerResult { -- | The outcome for constructing a block. - srTransactions :: FilteredTransactions, + srTransactions :: FilteredTransactions tov, -- | The total execution cost of the block. srExecutionCosts :: Types.Amount, -- | The total execution energy of the block. @@ -263,7 +266,7 @@ runScheduler :: TestConfig -> BS.HashedPersistentBlockState pv -> Types.GroupedTransactions -> - PersistentBSM pv (SchedulerResult, BS.PersistentBlockState pv) + PersistentBSM pv (SchedulerResult (Types.TransactionOutcomesVersionFor pv), BS.PersistentBlockState pv) runScheduler TestConfig{..} stateBefore transactions = do blockStateBefore <- BS.thawBlockState stateBefore let txs = filterTransactions tcBlockSize (Time.timestampToUTCTime tcBlockTimeout) transactions @@ -289,12 +292,12 @@ runSchedulerTest :: (Types.IsProtocolVersion pv) => TestConfig -> PersistentBSM pv (BS.HashedPersistentBlockState pv) -> - (SchedulerResult -> BS.PersistentBlockState pv -> PersistentBSM pv a) -> + (SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> PersistentBSM pv a) -> Types.GroupedTransactions -> - IO (SchedulerResult, a) + IO (SchedulerResult (Types.TransactionOutcomesVersionFor pv), a) runSchedulerTest config constructState extractor transactions = runTestBlockState computation where - computation :: PersistentBSM pv (SchedulerResult, a) + computation :: PersistentBSM pv (SchedulerResult (Types.TransactionOutcomesVersionFor pv), a) computation = do blockStateBefore <- constructState (result, blockStateAfter) <- runScheduler config blockStateBefore transactions @@ -310,9 +313,9 @@ runSchedulerTestTransactionJson :: (Types.IsProtocolVersion pv) => TestConfig -> PersistentBSM pv (BS.HashedPersistentBlockState pv) -> - (SchedulerResult -> BS.PersistentBlockState pv -> PersistentBSM pv a) -> + (SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> PersistentBSM pv a) -> [SchedTest.TransactionJSON] -> - IO (SchedulerResult, a) + IO (SchedulerResult (Types.TransactionOutcomesVersionFor pv), a) runSchedulerTestTransactionJson config constructState extractor transactionJsonList = do transactions <- SchedTest.processUngroupedTransactions transactionJsonList runSchedulerTest config constructState extractor transactions @@ -320,7 +323,7 @@ runSchedulerTestTransactionJson config constructState extractor transactionJsonL -- | Check assertions on the result of running a transaction in the scheduler and the resulting -- block state. type TransactionAssertion pv = - SchedulerResult -> + SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> PersistentBSM pv Assertion @@ -373,26 +376,26 @@ runSchedulerTestAssertIntermediateStates config constructState transactionsAndAs return (nextAssertedSoFar, nextState, nextCostsSoFar) -- | Intermediate results collected while running a number of transactions. -type IntermediateResults a = [(SchedulerResult, a)] +type IntermediateResults (tov :: Types.TransactionOutcomesVersion) a = [(SchedulerResult tov, a)] -- | Run the scheduler on transactions in a test environment, while collecting all of the -- intermediate results and extracted values. runSchedulerTestWithIntermediateStates :: - forall pv a. - (Types.IsProtocolVersion pv) => + forall tov pv a. + (Types.IsProtocolVersion pv, tov ~ Types.TransactionOutcomesVersionFor pv) => TestConfig -> PersistentBSM pv (BS.HashedPersistentBlockState pv) -> - (SchedulerResult -> BS.PersistentBlockState pv -> PersistentBSM pv a) -> + (SchedulerResult tov -> BS.PersistentBlockState pv -> PersistentBSM pv a) -> Types.GroupedTransactions -> - PersistentBSM pv (IntermediateResults a, BS.HashedPersistentBlockState pv) + PersistentBSM pv (IntermediateResults tov a, BS.HashedPersistentBlockState pv) runSchedulerTestWithIntermediateStates config constructState extractor transactions = do blockStateBefore <- constructState foldM transactionRunner ([], blockStateBefore) transactions where transactionRunner :: - (IntermediateResults a, BS.HashedPersistentBlockState pv) -> + (IntermediateResults tov a, BS.HashedPersistentBlockState pv) -> Types.TransactionGroup -> - PersistentBSM pv (IntermediateResults a, BS.HashedPersistentBlockState pv) + PersistentBSM pv (IntermediateResults tov a, BS.HashedPersistentBlockState pv) transactionRunner (acc, currentState) tx = do (result, updatedState) <- runScheduler config currentState [tx] extracted <- extractor result updatedState @@ -751,11 +754,11 @@ readV1ModuleFile filePath = do return $ Wasm.WasmModuleV1 $ Wasm.WasmModuleV Wasm.ModuleSource{..} -- | Assert the scheduler result have added one successful transaction. -assertSuccess :: SchedulerResult -> Assertion +assertSuccess :: SchedulerResult tov -> Assertion assertSuccess = assertSuccessWhere (const (return ())) -- | Assert the scheduler result have added one successful transaction and check the events. -assertSuccessWhere :: ([Types.Event] -> Assertion) -> SchedulerResult -> Assertion +assertSuccessWhere :: ([Types.Event] -> Assertion) -> SchedulerResult tov -> Assertion assertSuccessWhere assertEvents result = case getResults $ ftAdded (srTransactions result) of [(_, Types.TxSuccess events)] -> @@ -766,7 +769,7 @@ assertSuccessWhere assertEvents result = -- | Assert the scheduler result have added one successful transaction and check the events are -- equal to the provided events. -assertSuccessWithEvents :: [Types.Event] -> SchedulerResult -> Assertion +assertSuccessWithEvents :: [Types.Event] -> SchedulerResult tov -> Assertion assertSuccessWithEvents expectedEvents = assertSuccessWhere (assertEqual "The correct event is produced" expectedEvents) @@ -776,7 +779,7 @@ assertNumberOfEvents expectedLength events = assertEqual "Correct number of events produced" expectedLength (length events) -- | Assert the scheduler result have added one rejected transaction and check the reason. -assertRejectWhere :: (Types.RejectReason -> Assertion) -> SchedulerResult -> Assertion +assertRejectWhere :: (Types.RejectReason -> Assertion) -> SchedulerResult tov -> Assertion assertRejectWhere assertReason result = case getResults $ ftAdded (srTransactions result) of [(_, Types.TxReject reason)] -> @@ -786,13 +789,13 @@ assertRejectWhere assertReason result = other -> assertFailure $ "Multiple transactions were added " ++ show other -- | Assert the scheduler result have added one rejected transaction and check the reason. -assertRejectWithReason :: Types.RejectReason -> SchedulerResult -> Assertion +assertRejectWithReason :: Types.RejectReason -> SchedulerResult tov -> Assertion assertRejectWithReason expectedReason = assertRejectWhere $ assertEqual "The correct reject reason is produced" expectedReason -- | Assert the scheduler result have failed one transaction and check the reason. -assertFailureWithReason :: Types.FailureKind -> SchedulerResult -> Assertion +assertFailureWithReason :: Types.FailureKind -> SchedulerResult tov -> Assertion assertFailureWithReason expectedReason result = case ftFailed $ srTransactions result of [(_, reason)] -> @@ -804,7 +807,7 @@ assertFailureWithReason expectedReason result = other -> assertFailure $ "Multiple transactions failed: " ++ show other -- | Assert the scheduler result has failed one chain update and check the reason. -assertUpdateFailureWithReason :: Types.FailureKind -> SchedulerResult -> Assertion +assertUpdateFailureWithReason :: Types.FailureKind -> SchedulerResult tov -> Assertion assertUpdateFailureWithReason expectedReason result = case ftFailedUpdates $ srTransactions result of [(_, reason)] -> @@ -818,7 +821,7 @@ assertUpdateFailureWithReason expectedReason result = -- | Assert the scheduler have used energy the exact energy needed to deploy a provided V0 smart -- contract module. Assuming the transaction was signed with a single signature. -- The provided module should be a WASM module and without the smart contract version prefix. -assertUsedEnergyDeploymentV0 :: FilePath -> SchedulerResult -> Assertion +assertUsedEnergyDeploymentV0 :: FilePath -> SchedulerResult tov -> Assertion assertUsedEnergyDeploymentV0 sourceFile result = do contractModule <- readV0ModuleFile sourceFile let len = fromIntegral $ ByteString.length $ Wasm.wasmSource contractModule @@ -838,7 +841,7 @@ assertUsedEnergyDeploymentV0 sourceFile result = do -- | Assert the scheduler have used energy the exact energy needed to deploy a provided V1 smart -- contract module. Assuming the transaction was signed with a single signature. -- The provided module should be a WASM module and without the smart contract version prefix. -assertUsedEnergyDeploymentV1 :: FilePath -> SchedulerResult -> Assertion +assertUsedEnergyDeploymentV1 :: FilePath -> SchedulerResult tov -> Assertion assertUsedEnergyDeploymentV1 sourceFile result = do contractModule <- readV0ModuleFile sourceFile let len = fromIntegral $ ByteString.length $ Wasm.wasmSource contractModule @@ -865,7 +868,7 @@ assertUsedEnergyInitialization :: Wasm.InitName -> Wasm.Parameter -> Maybe Wasm.ByteSize -> - SchedulerResult -> + SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> Assertion assertUsedEnergyInitialization spv sourceFile initName parameter initialStateSize result = do moduleSource <- ByteString.readFile sourceFile diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/InitContextTest.hs b/concordium-consensus/tests/scheduler/SchedulerTests/InitContextTest.hs index b44fe64a94..791db6ba32 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/InitContextTest.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/InitContextTest.hs @@ -79,7 +79,7 @@ testInit spv pvString = specify doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result state = do diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/InitialAccountCreationSpec.hs b/concordium-consensus/tests/scheduler/SchedulerTests/InitialAccountCreationSpec.hs index c08c16de56..3565904c35 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/InitialAccountCreationSpec.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/InitialAccountCreationSpec.hs @@ -29,7 +29,7 @@ initialBlockState = Helpers.createTestBlockStateWithAccountsM [] transactionsInput :: [CredentialDeploymentWithStatus] transactionsInput = map - ((\x -> (x, Nothing)) . Types.addMetadata Types.CredentialDeployment 0) + ((\x -> (x, Nothing)) . Types.addMetadata 0) [ icdi1, icdi2, icdi3 -- should fail because reuse of prf key @@ -54,7 +54,7 @@ testAccountCreation _ pvString = specify doAssertions where makeAssertions :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion makeAssertions result state = do diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/RandomBakerTransactions.hs b/concordium-consensus/tests/scheduler/SchedulerTests/RandomBakerTransactions.hs index b4c7b08924..81e20dce4d 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/RandomBakerTransactions.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/RandomBakerTransactions.hs @@ -278,7 +278,7 @@ testTransactions spv = forAll makeTransactions (ioProperty . tt) Left f -> return $ counterexample f False Right _ -> return $ property True constructStateChecks :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv (Either String ()) constructStateChecks result state = do diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/ReceiveContextTest.hs b/concordium-consensus/tests/scheduler/SchedulerTests/ReceiveContextTest.hs index fc614ab619..1202052c33 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/ReceiveContextTest.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/ReceiveContextTest.hs @@ -124,7 +124,7 @@ testReceive _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result state = do diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/RejectReasons.hs b/concordium-consensus/tests/scheduler/SchedulerTests/RejectReasons.hs index 0be77ef60a..aaa9e02abb 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/RejectReasons.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/RejectReasons.hs @@ -144,7 +144,7 @@ testRejectReasons _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result state = do diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/RejectReasonsRustContract.hs b/concordium-consensus/tests/scheduler/SchedulerTests/RejectReasonsRustContract.hs index 5d0c9df8d4..29e2621c05 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/RejectReasonsRustContract.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/RejectReasonsRustContract.hs @@ -178,7 +178,7 @@ testRejectReasons _ pvString = ] checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result state = do diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/SimpleTransferSpec.hs b/concordium-consensus/tests/scheduler/SchedulerTests/SimpleTransferSpec.hs index 0ede730522..820e937068 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/SimpleTransferSpec.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/SimpleTransferSpec.hs @@ -105,7 +105,7 @@ testCase0 _ pvString = specify doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result state = diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/SimpleTransfersTest.hs b/concordium-consensus/tests/scheduler/SchedulerTests/SimpleTransfersTest.hs index c1bcb2cd71..5804704450 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/SimpleTransfersTest.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/SimpleTransfersTest.hs @@ -73,7 +73,7 @@ transferWithMemoRejectTestP1 = specify doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor Types.P1) -> BS.PersistentBlockState PV1 -> Helpers.PersistentBSM PV1 Assertion checkState result state = do @@ -167,7 +167,7 @@ simpleTransferTest _ pvString = specify doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result state = do @@ -297,7 +297,7 @@ simpleTransferWithMemoTest _ pvString = specify doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result state = do @@ -409,7 +409,7 @@ simpleTransferUsingAccountAliasesTest _ pvString = specify doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result state = do diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/SmartContracts/V0/SmartContractTests.hs b/concordium-consensus/tests/scheduler/SchedulerTests/SmartContracts/V0/SmartContractTests.hs index 122d6f6a92..4967772a91 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/SmartContracts/V0/SmartContractTests.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/SmartContracts/V0/SmartContractTests.hs @@ -54,7 +54,7 @@ runInitTestsFromFile :: Types.SProtocolVersion pv -> String -> FilePath -> - [(Text, BSS.ShortByteString, Helpers.SchedulerResult -> Assertion)] -> + [(Text, BSS.ShortByteString, Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> Assertion)] -> Spec runInitTestsFromFile _ testCaseDescription testFile testCases = describe testCaseDescription $ @@ -110,7 +110,7 @@ runReceiveTestsFromFile :: Types.SProtocolVersion pv -> String -> FilePath -> - [(Text, BSS.ShortByteString, Helpers.SchedulerResult -> Assertion)] -> + [(Text, BSS.ShortByteString, Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> Assertion)] -> Spec runReceiveTestsFromFile _ testCaseDescription testFile testCases = describe testCaseDescription $ diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/SponsoredTransactions.hs b/concordium-consensus/tests/scheduler/SchedulerTests/SponsoredTransactions.hs new file mode 100644 index 0000000000..a3f923acb5 --- /dev/null +++ b/concordium-consensus/tests/scheduler/SchedulerTests/SponsoredTransactions.hs @@ -0,0 +1,837 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} + +-- | This module implements tests covering sponsored transactions. +module SchedulerTests.SponsoredTransactions (tests) where + +import Control.Monad.Reader +import qualified Data.Map.Strict as Map +import Lens.Micro.Platform +import Test.HUnit +import Test.Hspec + +import qualified Concordium.Crypto.SignatureScheme as SigScheme +import Concordium.GlobalState.BlockState +import qualified Concordium.GlobalState.Persistent.BlockState as BS +import Concordium.GlobalState.Transactions +import Concordium.GlobalState.Types +import Concordium.ID.Types +import Concordium.Scheduler.Types +import qualified Concordium.TransactionVerification as TVer +import Concordium.Types.HashableTo + +import Concordium.Common.Time +import Concordium.GlobalState.Classes +import Concordium.ID.DummyData (dummyCredential) +import qualified SchedulerTests.Helpers as Helpers + +type SignKeys = [(CredentialIndex, [(KeyIndex, SigScheme.KeyPair)])] + +signAccountTransactionV1 :: (PayloadSize -> TransactionHeaderV1) -> EncodedPayload -> SignKeys -> Maybe SignKeys -> AccountTransactionV1 +signAccountTransactionV1 mkHeader payload sender sponsor = + AccountTransactionV1 + { atrv1Signature = + TransactionSignaturesV1 + { tsv1Sender = txSign sender, + tsv1Sponsor = txSign <$> sponsor + }, + atrv1Header = header, + atrv1Payload = payload, + atrv1SignHash = signHash + } + where + header = mkHeader (payloadSize payload) + signHash = transactionV1SignHashFromHeaderPayload header payload + signHashBytes = transactionSignHashToByteString signHash + credSign = Map.fromList . map (\(idx, key) -> (idx, SigScheme.sign key signHashBytes)) + txSign = TransactionSignature . Map.fromList . map (\(idx, credKeys) -> (idx, credSign credKeys)) + +makeHeaderV1 :: + AccountAddress -> + Maybe AccountAddress -> + Nonce -> + Energy -> + PayloadSize -> + TransactionHeaderV1 +makeHeaderV1 sender sponsor nonce energy pSize = + TransactionHeaderV1 + { thv1HeaderV0 = + TransactionHeader + { thSender = sender, + thNonce = nonce, + thEnergyAmount = energy, + thExpiry = TransactionTime maxBound, + thPayloadSize = pSize + }, + thv1Sponsor = sponsor + } + +initialAmounts :: [Amount] +initialAmounts = [1_000_000, 1_000_000, 500, 0] + +constructInitialBlockState :: forall pv. (IsProtocolVersion pv) => Helpers.PersistentBSM pv (BS.HashedPersistentBlockState pv) +constructInitialBlockState = + Helpers.createTestBlockStateWithAccountsM $ + fmap + (uncurry Helpers.makeTestAccountFromSeed) + (zip initialAmounts [0 ..]) + +-- | Create an 'Expectation' that asserts the account balance in the given block +-- state is as expected. +assertAccountBalance :: (BlockStateOperations m) => UpdatableBlockState m -> AccountIndex -> Amount -> m Expectation +assertAccountBalance bs accIndex expectAmount = do + bsoGetAccountByIndex bs accIndex >>= \case + Nothing -> return $ assertFailure $ "Missing account at index " ++ show accIndex + Just acc -> do + balance <- getAccountAmount acc + return $ + assertEqual + ("Balance of account " ++ show accIndex) + expectAmount + balance + +-- | Create an 'Expectation' that asserts that the accounts have the corresponding balances +-- (in order of account index, starting from 0). +assertAccountBalances :: (BlockStateOperations m) => UpdatableBlockState m -> [Amount] -> m Expectation +assertAccountBalances bs expectAmounts = + sequence_ + <$> mapM (uncurry (assertAccountBalance bs)) (zip [0 ..] expectAmounts) + +-- | Test that a sponsored transaction is discarded in P9. +testSponsoredTransferP9 :: Expectation +testSponsoredTransferP9 = do + expectation <- Helpers.runTestBlockState $ do + initialState <- constructInitialBlockState @'P9 + (result, _finalState) <- Helpers.runScheduler Helpers.defaultTestConfig initialState transactions + return $ do + assertEqual + "Failed transactions" + [((testTransaction, Nothing), NotSupportedAtCurrentProtocolVersion)] + (ftFailed (Helpers.srTransactions result)) + assertEqual "Added transactions" [] (ftAdded (Helpers.srTransactions result)) + expectation + where + transactions = [TGAccountTransactions [(testTransaction, Nothing)]] + acc = Helpers.accountAddressFromSeed + keypair = Helpers.keyPairFromSeed + testTransaction = + fromAccountTransactionV1 0 $ + signAccountTransactionV1 + (makeHeaderV1 (acc 3) (Just (acc 0)) 1 1000) + (encodePayload (Transfer (acc 1) 50)) + [(0, [(0, keypair 3)])] + (Just [(0, [(0, keypair 0)])]) + +-- | Test that an extended (but not sponsored) transaction is discarded in P9. +testExtendedTransactionP9 :: Expectation +testExtendedTransactionP9 = do + expectation <- Helpers.runTestBlockState $ do + initialState <- constructInitialBlockState @'P9 + (result, _finalState) <- Helpers.runScheduler Helpers.defaultTestConfig initialState transactions + return $ do + assertEqual + "Failed transactions" + [((testTransaction, Nothing), NotSupportedAtCurrentProtocolVersion)] + (ftFailed (Helpers.srTransactions result)) + assertEqual "Added transactions" [] (ftAdded (Helpers.srTransactions result)) + expectation + where + transactions = [TGAccountTransactions [(testTransaction, Nothing)]] + acc = Helpers.accountAddressFromSeed + keypair = Helpers.keyPairFromSeed + testTransaction = + fromAccountTransactionV1 0 $ + signAccountTransactionV1 + (makeHeaderV1 (acc 3) Nothing 1 1000) + (encodePayload (Transfer (acc 1) 50)) + [(0, [(0, keypair 3)])] + Nothing + +-- | Test that a sponsored transaction where the sender has insufficient balance to cover the +-- transfer amount is rejected (but added to the block) in P10. +testSponsoredTransferRejectP10 :: Expectation +testSponsoredTransferRejectP10 = do + expectation <- Helpers.runTestBlockState $ do + initialState <- constructInitialBlockState @'P10 + (result, finalState) <- Helpers.runScheduler Helpers.defaultTestConfig initialState transactions + expAccBalances <- + assertAccountBalances + finalState + (initialAmounts & ix 0 -~ 63500) + return $ do + let resultTransactions = Helpers.srTransactions result + assertEqual "Failed transactions" [] (ftFailed resultTransactions) + assertEqual + "Added transactions" + [((toBlockItem testTransaction, Nothing), summary)] + (ftAdded resultTransactions) + expAccBalances + expectation + where + transactions = [TGAccountTransactions [(testTransaction, Nothing)]] + acc = Helpers.accountAddressFromSeed + keypair = Helpers.keyPairFromSeed + testTransaction = + fromAccountTransactionV1 0 $ + signAccountTransactionV1 + (makeHeaderV1 (acc 3) (Just (acc 0)) 1 1000) + (encodePayload (Transfer (acc 1) 50)) + [(0, [(0, keypair 3)])] + (Just [(0, [(0, keypair 0)])]) + summary = + TransactionSummary + { tsSender = Just (acc 3), + tsHash = getHash testTransaction, + tsCost = 0, + tsEnergyCost = 635, + tsType = TSTAccountTransaction (Just TTTransfer), + tsResult = TxReject{vrRejectReason = AmountTooLarge (AddressAccount $ acc 3) 50}, + tsIndex = 0, + tsSponsorDetails = + CTrue + ( Just + ( SponsorDetails + { sdSponsor = acc 0, + sdCost = 63500 + } + ) + ) + } + +-- | Test a sponsored transaction success case. +testSponsoredTransferSuccessP10 :: Expectation +testSponsoredTransferSuccessP10 = do + expectation <- Helpers.runTestBlockState $ do + initialState <- constructInitialBlockState @'P10 + (result, finalState) <- Helpers.runScheduler Helpers.defaultTestConfig initialState transactions + expAccBalances <- + assertAccountBalances + finalState + (initialAmounts & ix 0 -~ 63500 & ix 2 -~ 500 & ix 1 +~ 500) + return $ do + let resultTransactions = Helpers.srTransactions result + assertEqual "Failed transactions" [] (ftFailed resultTransactions) + assertEqual + "Added transactions" + [((toBlockItem testTransaction, Nothing), summary)] + (ftAdded resultTransactions) + expAccBalances + expectation + where + transactions = [TGAccountTransactions [(testTransaction, Nothing)]] + acc = Helpers.accountAddressFromSeed + keypair = Helpers.keyPairFromSeed + testTransaction = + fromAccountTransactionV1 0 $ + signAccountTransactionV1 + (makeHeaderV1 (acc 2) (Just (acc 0)) 1 1000) + (encodePayload (Transfer (acc 1) 500)) + [(0, [(0, keypair 2)])] + (Just [(0, [(0, keypair 0)])]) + summary = + TransactionSummary + { tsSender = Just (acc 2), + tsHash = getHash testTransaction, + tsCost = 0, + tsEnergyCost = 635, + tsType = TSTAccountTransaction (Just TTTransfer), + tsResult = + TxSuccess + { vrEvents = + [ Transferred + { etFrom = AddressAccount (acc 2), + etTo = AddressAccount (acc 1), + etAmount = 500 + } + ] + }, + tsIndex = 0, + tsSponsorDetails = + CTrue + ( Just + ( SponsorDetails + { sdSponsor = acc 0, + sdCost = 63500 + } + ) + ) + } + +-- | Test an extended transaction success case in P10. +testExtendedTransactionSuccessP10 :: Expectation +testExtendedTransactionSuccessP10 = do + expectation <- Helpers.runTestBlockState $ do + initialState <- constructInitialBlockState @'P10 + (result, finalState) <- Helpers.runScheduler Helpers.defaultTestConfig initialState transactions + expAccBalances <- + assertAccountBalances + finalState + (initialAmounts & ix 0 -~ 50300 & ix 0 -~ 500 & ix 1 +~ 500) + return $ do + let resultTransactions = Helpers.srTransactions result + assertEqual "Failed transactions" [] (ftFailed resultTransactions) + assertEqual + "Added transactions" + [((toBlockItem testTransaction, Nothing), summary)] + (ftAdded resultTransactions) + expAccBalances + expectation + where + transactions = [TGAccountTransactions [(testTransaction, Nothing)]] + acc = Helpers.accountAddressFromSeed + keypair = Helpers.keyPairFromSeed + testTransaction = + fromAccountTransactionV1 0 $ + signAccountTransactionV1 + (makeHeaderV1 (acc 0) Nothing 1 1000) + (encodePayload (Transfer (acc 1) 500)) + [(0, [(0, keypair 0)])] + (Nothing) + summary = + TransactionSummary + { tsSender = Just (acc 0), + tsHash = getHash testTransaction, + tsCost = 50300, + tsEnergyCost = 503, + tsType = TSTAccountTransaction (Just TTTransfer), + tsResult = + TxSuccess + { vrEvents = + [ Transferred + { etFrom = AddressAccount (acc 0), + etTo = AddressAccount (acc 1), + etAmount = 500 + } + ] + }, + tsIndex = 0, + tsSponsorDetails = CTrue Nothing + } + +-- | Test a sponsored transaction success case where the sender is the sponsor. +testSelfSponsoredTransferSuccessP10 :: Expectation +testSelfSponsoredTransferSuccessP10 = do + expectation <- Helpers.runTestBlockState $ do + initialState <- constructInitialBlockState @'P10 + (result, finalState) <- Helpers.runScheduler Helpers.defaultTestConfig initialState transactions + expAccBalances <- + assertAccountBalances + finalState + (initialAmounts & ix 0 -~ 63500 & ix 0 -~ 500 & ix 1 +~ 500) + return $ do + let resultTransactions = Helpers.srTransactions result + assertEqual "Failed transactions" [] (ftFailed resultTransactions) + assertEqual + "Added transactions" + [((toBlockItem testTransaction, Nothing), summary)] + (ftAdded resultTransactions) + expAccBalances + expectation + where + transactions = [TGAccountTransactions [(testTransaction, Nothing)]] + acc = Helpers.accountAddressFromSeed + keypair = Helpers.keyPairFromSeed + testTransaction = + fromAccountTransactionV1 0 $ + signAccountTransactionV1 + (makeHeaderV1 (acc 0) (Just (acc 0)) 1 1000) + (encodePayload (Transfer (acc 1) 500)) + [(0, [(0, keypair 0)])] + (Just [(0, [(0, keypair 0)])]) + summary = + TransactionSummary + { tsSender = Just (acc 0), + tsHash = getHash testTransaction, + tsCost = 0, + tsEnergyCost = 635, + tsType = TSTAccountTransaction (Just TTTransfer), + tsResult = + TxSuccess + { vrEvents = + [ Transferred + { etFrom = AddressAccount (acc 0), + etTo = AddressAccount (acc 1), + etAmount = 500 + } + ] + }, + tsIndex = 0, + tsSponsorDetails = + CTrue + ( Just + ( SponsorDetails + { sdSponsor = acc 0, + sdCost = 63500 + } + ) + ) + } + +newtype TestAccountNonceQueryT bs m a = TestAccountNonceQueryT {runTestAccountNonceQueryT :: bs -> m a} + deriving (Functor, Applicative, Monad) via (ReaderT bs m) + deriving (MonadTrans) via (ReaderT bs) + +-- Instance for deducing the protocol version from the parameterized @m@ of the 'AccountNonceQueryT'. +deriving via (MGSTrans (TestAccountNonceQueryT bs) m) instance (MonadProtocolVersion m) => MonadProtocolVersion (TestAccountNonceQueryT bs m) + +-- Instances required in order to use the 'AccountNonceQueryT' monad from within a block state context. +deriving via (MGSTrans (TestAccountNonceQueryT bs) m) instance BlockStateTypes (TestAccountNonceQueryT bs m) +deriving via (MGSTrans (TestAccountNonceQueryT bs) m) instance (TokenStateOperations ts m) => TokenStateOperations ts (TestAccountNonceQueryT bs m) +deriving via (MGSTrans (TestAccountNonceQueryT bs) m) instance (PLTQuery bs' ts m) => PLTQuery bs' ts (TestAccountNonceQueryT bs m) +deriving via (MGSTrans (TestAccountNonceQueryT bs) m) instance (BlockStateQuery m) => BlockStateQuery (TestAccountNonceQueryT bs m) +deriving via (MGSTrans (TestAccountNonceQueryT bs) m) instance (ContractStateOperations m) => ContractStateOperations (TestAccountNonceQueryT bs m) +deriving via (MGSTrans (TestAccountNonceQueryT bs) m) instance (AccountOperations m) => AccountOperations (TestAccountNonceQueryT bs m) +deriving via (MGSTrans (TestAccountNonceQueryT bs) m) instance (ModuleQuery m) => ModuleQuery (TestAccountNonceQueryT bs m) + +instance (bs ~ BlockState m, BlockStateQuery m) => AccountNonceQuery (TestAccountNonceQueryT bs m) where + getNextAccountNonce :: + (bs ~ BlockState m, BlockStateQuery m) => + AccountAddressEq -> TestAccountNonceQueryT bs m (Nonce, Bool) + getNextAccountNonce (AccountAddressEq addr) = TestAccountNonceQueryT $ \bs -> do + getAccount bs addr >>= \case + Nothing -> return (minNonce, True) + Just (_, acct) -> do + nonce <- getAccountNonce acct + return (nonce, True) + +verifyTx :: (BlockStateQuery m, BlockState m ~ BS.HashedPersistentBlockState (MPV m)) => BlockState m -> Transaction -> m TVer.VerificationResult +verifyTx bs tx = do + runTestAccountNonceQueryT (runTransactionVerifierT (TVer.verifyExtendedTransaction tx) ctx) bs + where + ctx = + Context + { _ctxTransactionOrigin = TVer.Individual, + _ctxMaxBlockEnergy = 10_000, + _ctxBs = bs + } + +-- | Test a sponsored transaction success case where the transaction is first verified. +testVerifySponsoredTransferSuccessP10 :: Expectation +testVerifySponsoredTransferSuccessP10 = do + expectation <- Helpers.runTestBlockState $ do + initialState <- constructInitialBlockState @'P10 + verRes <- verifyTx initialState testTransaction + case verRes of + TVer.Ok (TVer.ExtendedTransactionSuccess{}) -> return () + _ -> liftIO . assertFailure $ "Expected ExtendedTransactionSuccess{..} but saw " ++ show verRes + let transactions = [TGAccountTransactions [(testTransaction, Just verRes)]] + (result, finalState) <- Helpers.runScheduler Helpers.defaultTestConfig initialState transactions + expAccBalances <- + assertAccountBalances + finalState + (initialAmounts & ix 0 -~ 63500 & ix 2 -~ 500 & ix 1 +~ 500) + return $ do + let resultTransactions = Helpers.srTransactions result + assertEqual "Failed transactions" [] (ftFailed resultTransactions) + assertEqual + "Added transactions" + [((toBlockItem testTransaction, Just verRes), summary)] + (ftAdded resultTransactions) + expAccBalances + expectation + where + acc = Helpers.accountAddressFromSeed + keypair = Helpers.keyPairFromSeed + testTransaction = + fromAccountTransactionV1 0 $ + signAccountTransactionV1 + (makeHeaderV1 (acc 2) (Just (acc 0)) 1 1000) + (encodePayload (Transfer (acc 1) 500)) + [(0, [(0, keypair 2)])] + (Just [(0, [(0, keypair 0)])]) + summary = + TransactionSummary + { tsSender = Just (acc 2), + tsHash = getHash testTransaction, + tsCost = 0, + tsEnergyCost = 635, + tsType = TSTAccountTransaction (Just TTTransfer), + tsResult = + TxSuccess + { vrEvents = + [ Transferred + { etFrom = AddressAccount (acc 2), + etTo = AddressAccount (acc 1), + etAmount = 500 + } + ] + }, + tsIndex = 0, + tsSponsorDetails = + CTrue + ( Just + ( SponsorDetails + { sdSponsor = acc 0, + sdCost = 63500 + } + ) + ) + } + +-- | Test a sponsored transaction success case where the transaction is first verified, then the +-- sponsor's keys are changed (while keeping the signature valid). +testVerifyChangeSponsorKeySponsoredTransferSuccessP10 :: Expectation +testVerifyChangeSponsorKeySponsoredTransferSuccessP10 = do + expectation <- Helpers.runTestBlockState $ do + initialState <- constructInitialBlockState @'P10 + verRes <- verifyTx initialState testTransaction + case verRes of + TVer.Ok (TVer.ExtendedTransactionSuccess{}) -> return () + _ -> liftIO . assertFailure $ "Expected ExtendedTransactionSuccess{..} but saw " ++ show verRes + let transactions = [TGAccountTransactions [(testTransaction, Just verRes)]] + keyChangeState <- do + mbs0 <- thawBlockState initialState + let newKeys = + CredentialPublicKeys + { credKeys = + Map.fromList + [ (0, SigScheme.correspondingVerifyKey (keypair 0)), + (1, SigScheme.correspondingVerifyKey (keypair 100)) + ], + credThreshold = 1 + } + -- Add a new key to credential 0 of the sponsor. + mbs1 <- bsoSetAccountCredentialKeys mbs0 0 0 newKeys + gc <- bsoGetCryptoParams mbs1 + let cred = dummyCredential gc (acc 0) (SigScheme.correspondingVerifyKey (keypair 200)) (YearMonth 3000 1) (YearMonth 2000 1) + let addCreds = Map.singleton 1 cred + -- Add a new credential to the sponsor account. + mbs2 <- bsoUpdateAccountCredentials mbs1 0 [] addCreds 1 + freezeBlockState mbs2 + (result, finalState) <- Helpers.runScheduler Helpers.defaultTestConfig keyChangeState transactions + expAccBalances <- + assertAccountBalances + finalState + (initialAmounts & ix 0 -~ 63500 & ix 2 -~ 500 & ix 1 +~ 500) + return $ do + let resultTransactions = Helpers.srTransactions result + assertEqual "Failed transactions" [] (ftFailed resultTransactions) + assertEqual + "Added transactions" + [((toBlockItem testTransaction, Just verRes), summary)] + (ftAdded resultTransactions) + expAccBalances + expectation + where + acc = Helpers.accountAddressFromSeed + keypair = Helpers.keyPairFromSeed + testTransaction = + fromAccountTransactionV1 0 $ + signAccountTransactionV1 + (makeHeaderV1 (acc 2) (Just (acc 0)) 1 1000) + (encodePayload (Transfer (acc 1) 500)) + [(0, [(0, keypair 2)])] + (Just [(0, [(0, keypair 0)])]) + summary = + TransactionSummary + { tsSender = Just (acc 2), + tsHash = getHash testTransaction, + tsCost = 0, + tsEnergyCost = 635, + tsType = TSTAccountTransaction (Just TTTransfer), + tsResult = + TxSuccess + { vrEvents = + [ Transferred + { etFrom = AddressAccount (acc 2), + etTo = AddressAccount (acc 1), + etAmount = 500 + } + ] + }, + tsIndex = 0, + tsSponsorDetails = + CTrue + ( Just + ( SponsorDetails + { sdSponsor = acc 0, + sdCost = 63500 + } + ) + ) + } + +-- | Test a sponsored transaction case where the transaction is first verified, then the +-- sponsor's keys are changed increasing the threshold and rendering the transaction invalid. +testVerifyChangeSponsorKeySponsoredTransferFailureIncreaseThresholdP10 :: Expectation +testVerifyChangeSponsorKeySponsoredTransferFailureIncreaseThresholdP10 = do + expectation <- Helpers.runTestBlockState $ do + initialState <- constructInitialBlockState @'P10 + verRes <- verifyTx initialState testTransaction + case verRes of + TVer.Ok (TVer.ExtendedTransactionSuccess{}) -> return () + _ -> liftIO . assertFailure $ "Expected ExtendedTransactionSuccess{..} but saw " ++ show verRes + let transactions = [TGAccountTransactions [(testTransaction, Just verRes)]] + keyChangeState <- do + mbs0 <- thawBlockState initialState + let newKeys = + CredentialPublicKeys + { credKeys = + Map.fromList + [ (0, SigScheme.correspondingVerifyKey (keypair 0)), + (1, SigScheme.correspondingVerifyKey (keypair 100)) + ], + credThreshold = 2 + } + -- Add a new key to credential 0 of the sponsor, updating the threshold to 2. + mbs1 <- bsoSetAccountCredentialKeys mbs0 0 0 newKeys + freezeBlockState mbs1 + (result, finalState) <- Helpers.runScheduler Helpers.defaultTestConfig keyChangeState transactions + expAccBalances <- assertAccountBalances finalState initialAmounts + return $ do + let resultTransactions = Helpers.srTransactions result + assertEqual + "Failed transactions" + [((testTransaction, Just verRes), IncorrectSignature)] + (ftFailed resultTransactions) + assertEqual "Added transactions" [] (ftAdded resultTransactions) + expAccBalances + expectation + where + acc = Helpers.accountAddressFromSeed + keypair = Helpers.keyPairFromSeed + testTransaction = + fromAccountTransactionV1 0 $ + signAccountTransactionV1 + (makeHeaderV1 (acc 2) (Just (acc 0)) 1 1000) + (encodePayload (Transfer (acc 1) 500)) + [(0, [(0, keypair 2)])] + (Just [(0, [(0, keypair 0)])]) + +-- | Test a sponsored transaction case where the transaction is first verified, then the +-- sponsor's keys are changed increasing the credential threshold and rendering the transaction invalid. +testVerifyChangeSponsorKeySponsoredTransferFailureIncreaseCredentialThresholdP10 :: Expectation +testVerifyChangeSponsorKeySponsoredTransferFailureIncreaseCredentialThresholdP10 = do + expectation <- Helpers.runTestBlockState $ do + initialState <- constructInitialBlockState @'P10 + verRes <- verifyTx initialState testTransaction + case verRes of + TVer.Ok (TVer.ExtendedTransactionSuccess{}) -> return () + _ -> liftIO . assertFailure $ "Expected ExtendedTransactionSuccess{..} but saw " ++ show verRes + let transactions = [TGAccountTransactions [(testTransaction, Just verRes)]] + keyChangeState <- do + mbs0 <- thawBlockState initialState + gc <- bsoGetCryptoParams mbs0 + let cred = dummyCredential gc (acc 0) (SigScheme.correspondingVerifyKey (keypair 200)) (YearMonth 3000 1) (YearMonth 2000 1) + let addCreds = Map.singleton 1 cred + -- Add a new credential to the sponsor account, updating the threshold to 2. + mbs1 <- bsoUpdateAccountCredentials mbs0 0 [] addCreds 2 + freezeBlockState mbs1 + (result, finalState) <- Helpers.runScheduler Helpers.defaultTestConfig keyChangeState transactions + expAccBalances <- assertAccountBalances finalState initialAmounts + return $ do + let resultTransactions = Helpers.srTransactions result + assertEqual + "Failed transactions" + [((testTransaction, Just verRes), IncorrectSignature)] + (ftFailed resultTransactions) + assertEqual "Added transactions" [] (ftAdded resultTransactions) + expAccBalances + expectation + where + acc = Helpers.accountAddressFromSeed + keypair = Helpers.keyPairFromSeed + testTransaction = + fromAccountTransactionV1 0 $ + signAccountTransactionV1 + (makeHeaderV1 (acc 2) (Just (acc 0)) 1 1000) + (encodePayload (Transfer (acc 1) 500)) + [(0, [(0, keypair 2)])] + (Just [(0, [(0, keypair 0)])]) + +-- | Test a sponsored transaction success case where the transaction is first verified, then the +-- sender's keys are changed (while keeping the signature valid). +testVerifyChangeSenderKeySponsoredTransferSuccessP10 :: Expectation +testVerifyChangeSenderKeySponsoredTransferSuccessP10 = do + expectation <- Helpers.runTestBlockState $ do + initialState <- constructInitialBlockState @'P10 + verRes <- verifyTx initialState testTransaction + case verRes of + TVer.Ok (TVer.ExtendedTransactionSuccess{}) -> return () + _ -> liftIO . assertFailure $ "Expected ExtendedTransactionSuccess{..} but saw " ++ show verRes + let transactions = [TGAccountTransactions [(testTransaction, Just verRes)]] + keyChangeState <- do + mbs0 <- thawBlockState initialState + let newKeys = + CredentialPublicKeys + { credKeys = + Map.fromList + [ (0, SigScheme.correspondingVerifyKey (keypair 2)), + (1, SigScheme.correspondingVerifyKey (keypair 100)) + ], + credThreshold = 1 + } + -- Add a new key to credential 0 of the sender. + mbs1 <- bsoSetAccountCredentialKeys mbs0 2 0 newKeys + gc <- bsoGetCryptoParams mbs1 + let cred = dummyCredential gc (acc 0) (SigScheme.correspondingVerifyKey (keypair 200)) (YearMonth 3000 1) (YearMonth 2000 1) + let addCreds = Map.singleton 1 cred + -- Add a new credential to the sender account. + mbs2 <- bsoUpdateAccountCredentials mbs1 2 [] addCreds 1 + freezeBlockState mbs2 + (result, finalState) <- Helpers.runScheduler Helpers.defaultTestConfig keyChangeState transactions + expAccBalances <- + assertAccountBalances + finalState + (initialAmounts & ix 0 -~ 63500 & ix 2 -~ 500 & ix 1 +~ 500) + return $ do + let resultTransactions = Helpers.srTransactions result + assertEqual "Failed transactions" [] (ftFailed resultTransactions) + assertEqual + "Added transactions" + [((toBlockItem testTransaction, Just verRes), summary)] + (ftAdded resultTransactions) + expAccBalances + expectation + where + acc = Helpers.accountAddressFromSeed + keypair = Helpers.keyPairFromSeed + testTransaction = + fromAccountTransactionV1 0 $ + signAccountTransactionV1 + (makeHeaderV1 (acc 2) (Just (acc 0)) 1 1000) + (encodePayload (Transfer (acc 1) 500)) + [(0, [(0, keypair 2)])] + (Just [(0, [(0, keypair 0)])]) + summary = + TransactionSummary + { tsSender = Just (acc 2), + tsHash = getHash testTransaction, + tsCost = 0, + tsEnergyCost = 635, + tsType = TSTAccountTransaction (Just TTTransfer), + tsResult = + TxSuccess + { vrEvents = + [ Transferred + { etFrom = AddressAccount (acc 2), + etTo = AddressAccount (acc 1), + etAmount = 500 + } + ] + }, + tsIndex = 0, + tsSponsorDetails = + CTrue + ( Just + ( SponsorDetails + { sdSponsor = acc 0, + sdCost = 63500 + } + ) + ) + } + +-- | Test a sponsored transaction case where the transaction is first verified, then the +-- sender's keys are changed increasing the threshold and rendering the transaction invalid. +testVerifyChangeSenderKeySponsoredTransferFailureIncreaseThresholdP10 :: Expectation +testVerifyChangeSenderKeySponsoredTransferFailureIncreaseThresholdP10 = do + expectation <- Helpers.runTestBlockState $ do + initialState <- constructInitialBlockState @'P10 + verRes <- verifyTx initialState testTransaction + case verRes of + TVer.Ok (TVer.ExtendedTransactionSuccess{}) -> return () + _ -> liftIO . assertFailure $ "Expected ExtendedTransactionSuccess{..} but saw " ++ show verRes + let transactions = [TGAccountTransactions [(testTransaction, Just verRes)]] + keyChangeState <- do + mbs0 <- thawBlockState initialState + let newKeys = + CredentialPublicKeys + { credKeys = + Map.fromList + [ (0, SigScheme.correspondingVerifyKey (keypair 2)), + (1, SigScheme.correspondingVerifyKey (keypair 100)) + ], + credThreshold = 2 + } + -- Add a new key to credential 0 of the sender increasing the threshold to 2. + mbs1 <- bsoSetAccountCredentialKeys mbs0 2 0 newKeys + freezeBlockState mbs1 + (result, finalState) <- Helpers.runScheduler Helpers.defaultTestConfig keyChangeState transactions + expAccBalances <- assertAccountBalances finalState initialAmounts + return $ do + let resultTransactions = Helpers.srTransactions result + assertEqual + "Failed transactions" + [((testTransaction, Just verRes), IncorrectSignature)] + (ftFailed resultTransactions) + assertEqual "Added transactions" [] (ftAdded resultTransactions) + expAccBalances + expectation + where + acc = Helpers.accountAddressFromSeed + keypair = Helpers.keyPairFromSeed + testTransaction = + fromAccountTransactionV1 0 $ + signAccountTransactionV1 + (makeHeaderV1 (acc 2) (Just (acc 0)) 1 1000) + (encodePayload (Transfer (acc 1) 500)) + [(0, [(0, keypair 2)])] + (Just [(0, [(0, keypair 0)])]) + +-- | Test a sponsored transaction case where the transaction is first verified, then the +-- sender's keys are changed increasing the credential threshold and rendering the transaction invalid. +testVerifyChangeSenderKeySponsoredTransferFailureIncreaseCredentialThresholdP10 :: Expectation +testVerifyChangeSenderKeySponsoredTransferFailureIncreaseCredentialThresholdP10 = do + expectation <- Helpers.runTestBlockState $ do + initialState <- constructInitialBlockState @'P10 + verRes <- verifyTx initialState testTransaction + case verRes of + TVer.Ok (TVer.ExtendedTransactionSuccess{}) -> return () + _ -> liftIO . assertFailure $ "Expected ExtendedTransactionSuccess{..} but saw " ++ show verRes + let transactions = [TGAccountTransactions [(testTransaction, Just verRes)]] + keyChangeState <- do + mbs0 <- thawBlockState initialState + gc <- bsoGetCryptoParams mbs0 + let dummyPubKey = SigScheme.correspondingVerifyKey (keypair 200) + let cred = dummyCredential gc (acc 2) dummyPubKey (YearMonth 3000 1) (YearMonth 2000 1) + let addCreds = Map.singleton 1 cred + -- Add a new credential to the sender increasing the threshold to 2. + mbs1 <- bsoUpdateAccountCredentials mbs0 2 [] addCreds 2 + freezeBlockState mbs1 + (result, finalState) <- Helpers.runScheduler Helpers.defaultTestConfig keyChangeState transactions + expAccBalances <- assertAccountBalances finalState initialAmounts + return $ do + let resultTransactions = Helpers.srTransactions result + assertEqual + "Failed transactions" + [((testTransaction, Just verRes), IncorrectSignature)] + (ftFailed resultTransactions) + assertEqual "Added transactions" [] (ftAdded resultTransactions) + expAccBalances + expectation + where + acc = Helpers.accountAddressFromSeed + keypair = Helpers.keyPairFromSeed + testTransaction = + fromAccountTransactionV1 0 $ + signAccountTransactionV1 + (makeHeaderV1 (acc 2) (Just (acc 0)) 1 1000) + (encodePayload (Transfer (acc 1) 500)) + [(0, [(0, keypair 2)])] + (Just [(0, [(0, keypair 0)])]) + +tests :: Spec +tests = parallel $ do + it "Sponsored transfer @P9" testSponsoredTransferP9 + it "Extended transaction (transfer, no sponsor) @P9" testExtendedTransactionP9 + + it "Sponsored transfer (reject) @P10" testSponsoredTransferRejectP10 + it "Sponsored transfer (success) @P10" testSponsoredTransferSuccessP10 + it "Extended transaction (transfer, no sponsor, success) @P10" testExtendedTransactionSuccessP10 + it "Self-sponsored transfer (success) @P10" testSelfSponsoredTransferSuccessP10 + it "Pre-verified sponosored transfer (success) @P10" testVerifySponsoredTransferSuccessP10 + it "Verify sponsored then change sponsor keys (success) @P10" testVerifyChangeSponsorKeySponsoredTransferSuccessP10 + it "Verify sponsored then change sponsor keys - increase threshold (failure) @P10" testVerifyChangeSponsorKeySponsoredTransferFailureIncreaseThresholdP10 + it "Verify sponsored then change sponsor keys - increase credential threshold (failure) @P10" testVerifyChangeSponsorKeySponsoredTransferFailureIncreaseCredentialThresholdP10 + it "Verify sponsored then change sender keys (success) @P10" testVerifyChangeSenderKeySponsoredTransferSuccessP10 + it "Verify sponsored then change sender keys - increase threshold (failure) @P10" testVerifyChangeSenderKeySponsoredTransferFailureIncreaseThresholdP10 + it "Verify sponsored then change sender keys - increase credential threshold (failure) @P10" testVerifyChangeSenderKeySponsoredTransferFailureIncreaseCredentialThresholdP10 diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/StakedAmountLocked.hs b/concordium-consensus/tests/scheduler/SchedulerTests/StakedAmountLocked.hs index 29fd1cb303..2d8eddc202 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/StakedAmountLocked.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/StakedAmountLocked.hs @@ -135,7 +135,7 @@ testCase0 _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockState = diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/TokenModule.hs b/concordium-consensus/tests/scheduler/SchedulerTests/TokenModule.hs index d7e755abd0..433f3196e9 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/TokenModule.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/TokenModule.hs @@ -1598,7 +1598,7 @@ testTokenOutOfEnergy = describe "tokenOutOfEnergy" $ do } ] checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor P9) -> BS.PersistentBlockState 'P9 -> Helpers.PersistentBSM 'P9 Assertion checkState result state = do @@ -1610,7 +1610,7 @@ testTokenOutOfEnergy = describe "tokenOutOfEnergy" $ do doAssertReloadedState blockStateAssertions :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor P9) -> BS.PersistentBlockState 'P9 -> Helpers.PersistentBSM 'P9 Assertion blockStateAssertions result state = do diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/TransactionExpirySpec.hs b/concordium-consensus/tests/scheduler/SchedulerTests/TransactionExpirySpec.hs index 22a2bb41ff..bff0a5a666 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/TransactionExpirySpec.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/TransactionExpirySpec.hs @@ -169,7 +169,7 @@ testExpiryTime expiry transactions _ = isExpired _ = False checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockstate = diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/TransactionGroupingSpec2.hs b/concordium-consensus/tests/scheduler/SchedulerTests/TransactionGroupingSpec2.hs index c5184deafb..65003a4073 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/TransactionGroupingSpec2.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/TransactionGroupingSpec2.hs @@ -315,7 +315,7 @@ testGroups _ groups = do return (Helpers.getResults ftAdded, ftFailed, ftUnprocessed, concat (Types.perAccountTransactions ts)) where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result blockstate = @@ -343,7 +343,7 @@ tests = mkExpected [] ev ei eu = (reverse ev, reverse ei, reverse eu) mkExpected ((t, expectedRes) : rest) ev ei eu = case expectedRes of - Added -> mkExpected rest ((Types.normalTransaction t) : ev) ei eu + Added -> mkExpected rest ((Types.toBlockItem t) : ev) ei eu Failed fk -> mkExpected rest ev ((t, fk) : ei) eu Unprocessed -> mkExpected rest ev ei (t : eu) @@ -366,7 +366,7 @@ tests = case expectedRes of -- NOTE: With a custom expectation could print list of -- invalid/unproc in case of failure. - Added -> (Types.normalTransaction t) `elem` map fst validTs + Added -> (Types.toBlockItem t) `elem` map fst validTs Failed fk -> (t, fk) `elem` map (\(x, y) -> (fst x, y)) invalid Unprocessed -> t `elem` map fst unproc ) diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/TransfersWithScheduleTest.hs b/concordium-consensus/tests/scheduler/SchedulerTests/TransfersWithScheduleTest.hs index e9907476b0..e3de27830e 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/TransfersWithScheduleTest.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/TransfersWithScheduleTest.hs @@ -73,7 +73,7 @@ scheduledTransferWithMemoRejectsP1 = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor Types.P1) -> BS.PersistentBlockState PV1 -> Helpers.PersistentBSM PV1 Assertion checkState result state = @@ -336,7 +336,7 @@ scheduledTransferRejectsSelfTransferUsingAliases _ pvString = doBlockStateAssertions where checkState :: - Helpers.SchedulerResult -> + Helpers.SchedulerResult (Types.TransactionOutcomesVersionFor pv) -> BS.PersistentBlockState pv -> Helpers.PersistentBSM pv Assertion checkState result state = diff --git a/concordium-consensus/tests/scheduler/Spec.hs b/concordium-consensus/tests/scheduler/Spec.hs index 9026be1f3c..59daf5337d 100644 --- a/concordium-consensus/tests/scheduler/Spec.hs +++ b/concordium-consensus/tests/scheduler/Spec.hs @@ -19,6 +19,7 @@ import qualified SchedulerTests.RejectReasons (tests) import qualified SchedulerTests.RejectReasonsRustContract (tests) import qualified SchedulerTests.SimpleTransferSpec (tests) import qualified SchedulerTests.SimpleTransfersTest (tests) +import qualified SchedulerTests.SponsoredTransactions (tests) import qualified SchedulerTests.StakedAmountLocked (tests) import qualified SchedulerTests.TokenCreation (tests) import qualified SchedulerTests.TokenHolderTransactions (tests) @@ -86,6 +87,7 @@ main = hspec $ do SchedulerTests.StakedAmountLocked.tests SchedulerTests.RejectReasons.tests SchedulerTests.RejectReasonsRustContract.tests + SchedulerTests.SponsoredTransactions.tests SchedulerTests.SmartContracts.V0.SmartContractTests.tests SchedulerTests.SmartContracts.V0.RelaxedRestrictions.tests SchedulerTests.SmartContracts.V1.Counter.tests diff --git a/concordium-node/Cargo.lock b/concordium-node/Cargo.lock index 8537e6e368..3c42b7ca19 100644 --- a/concordium-node/Cargo.lock +++ b/concordium-node/Cargo.lock @@ -757,7 +757,7 @@ dependencies = [ [[package]] name = "concordium_base" -version = "8.0.0-alpha.3" +version = "9.0.0" dependencies = [ "aes", "anyhow", @@ -780,6 +780,7 @@ dependencies = [ "ed25519-dalek", "either", "ff", + "generic-array 0.14.7", "hex", "hmac", "itertools 0.14.0", @@ -817,7 +818,7 @@ dependencies = [ [[package]] name = "concordium_node" -version = "9.0.7" +version = "10.0.0" dependencies = [ "anyhow", "app_dirs2", diff --git a/concordium-node/Cargo.toml b/concordium-node/Cargo.toml index c4d13156ed..446a1b2b39 100644 --- a/concordium-node/Cargo.toml +++ b/concordium-node/Cargo.toml @@ -1,6 +1,6 @@ [package] name = "concordium_node" -version = "9.0.7" # must be kept in sync with 'is_compatible_version' in 'src/configuration.rs' +version = "10.0.0" # must be kept in sync with 'is_compatible_version' in 'src/configuration.rs' description = "Concordium Node" authors = ["Concordium "] exclude = [".gitignore", ".gitlab-ci.yml", "test/**/*","**/**/.gitignore","**/**/.gitlab-ci.yml"] diff --git a/concordium-node/src/consensus_ffi/helpers.rs b/concordium-node/src/consensus_ffi/helpers.rs index f1bc5a259c..dfdf38f5b5 100644 --- a/concordium-node/src/consensus_ffi/helpers.rs +++ b/concordium-node/src/consensus_ffi/helpers.rs @@ -192,6 +192,12 @@ pub enum ConsensusFfiResponse { DoubleSign, #[error("Consensus entered an unrecoverable state")] ConsensusFailure, + #[error("Sponsor account does not exist")] + NonexistingSponsorAccount, + #[error("Sponsor account is missing")] + MissingSponsorAccount, + #[error("Sponsor signature is missing")] + MissingSponsorSignature, } impl ConsensusFfiResponse { @@ -268,7 +274,10 @@ impl ConsensusFfiResponse { | MissingImportFile | ContinueCatchUp | DoubleSign - | ConsensusFailure => false, + | ConsensusFailure + | NonexistingSponsorAccount + | MissingSponsorAccount + | MissingSponsorSignature => false, PendingBlock => packet_type != PacketType::Block, Success | PendingFinalization | Asynchronous => true, } @@ -352,6 +361,9 @@ impl TryFrom for ConsensusFfiResponse { 30 => Ok(InsufficientFunds), 31 => Ok(DoubleSign), 32 => Ok(ConsensusFailure), + 33 => Ok(NonexistingSponsorAccount), + 34 => Ok(MissingSponsorAccount), + 35 => Ok(MissingSponsorSignature), _ => Err(ConsensusFfiResponseConversionError { unknown_code: value, }), diff --git a/concordium-node/src/grpc2.rs b/concordium-node/src/grpc2.rs index 477738b078..e576b12a6c 100644 --- a/concordium-node/src/grpc2.rs +++ b/concordium-node/src/grpc2.rs @@ -22,7 +22,10 @@ pub mod types { use crate::configuration::PROTOCOL_MAX_TRANSACTION_SIZE; use super::Require; - use concordium_base::{common::Versioned, transactions::PayloadLike}; + use concordium_base::{ + common::{Version, Versioned}, + transactions::PayloadLike, + }; use std::convert::{TryFrom, TryInto}; /// Types generated from the protocol-level-tokens.proto file. @@ -443,6 +446,39 @@ pub mod types { } } + impl TryFrom + for ( + concordium_base::transactions::TransactionHeaderV1, + concordium_base::transactions::EncodedPayload, + ) + { + type Error = tonic::Status; + + fn try_from(value: PreAccountTransactionV1) -> Result { + let header = value.header.require()?; + let payload = value.payload.require()?; + let sender = header.sender.require()?.try_into()?; + let nonce = header.sequence_number.require()?.into(); + let energy_amount = header.energy_amount.require()?.into(); + let expiry = header.expiry.require()?.into(); + let payload: concordium_base::transactions::EncodedPayload = payload.try_into()?; + let payload_size = payload.size(); + let sponsor = match header.sponsor { + Some(s) => Some(s.try_into()?), + None => None, + }; + let header = concordium_base::transactions::TransactionHeaderV1 { + sender, + nonce, + energy_amount, + payload_size, + expiry, + sponsor, + }; + Ok((header, payload)) + } + } + impl TryFrom for concordium_base::common::types::Signature { type Error = tonic::Status; @@ -484,6 +520,20 @@ pub mod types { } } + impl TryFrom + for concordium_base::common::types::TransactionSignaturesV1 + { + type Error = tonic::Status; + fn try_from(value: AccountTransactionV1Signatures) -> Result { + let sender_signatures = value.sender_signatures.require()?.try_into()?; + let sponsor_signatures = value.sponsor_signatures.map(|s| s.try_into()).transpose()?; + Ok(Self { + sender: sender_signatures, + sponsor: sponsor_signatures, + }) + } + } + impl TryFrom for concordium_base::updates::UpdateInstructionSignature { type Error = tonic::Status; @@ -575,9 +625,275 @@ pub mod types { signatures.serial(&mut data); Ok(data) } + send_block_item_request::BlockItem::AccountTransactionV1(atv1) => { + let patv1 = PreAccountTransactionV1 { + header: atv1.header, + payload: atv1.payload, + }; + let (header, payload) = patv1.try_into()?; + let signatures = atv1.signatures.require()?.try_into()?; + let atv1 = concordium_base::transactions::AccountTransactionV1 { + signatures, + header, + payload, + }; + Ok(concordium_base::common::to_bytes(&Versioned::new( + 0.into(), + concordium_base::transactions::BlockItem::AccountTransactionV1(atv1), + ))) + } + send_block_item_request::BlockItem::RawBlockItem(bytes) => { + let mut data = concordium_base::common::to_bytes(&Version::from(0)); + // Add raw bytes in a separate step to avoid encoding the length + data.extend_from_slice(&bytes); + Ok(data) + } } } } + + #[cfg(test)] + mod tests { + use super::*; + use std::collections::HashMap; + #[test] + fn test_send_block_item_request_get_v0_format_account_transaction() { + // Prepare minimal valid AccountTransaction fields. + let sender = Some(AccountAddress { + value: vec![37u8; 32], + }); + let sequence_number = Some(SequenceNumber { value: 1 }); + let energy_amount = Some(Energy { value: 1000 }); + let expiry = Some(TransactionTime { value: 123456 }); + let header = Some(AccountTransactionHeader { + sender, + sequence_number, + energy_amount, + expiry, + }); + + // Use a simple transfer payload. + let receiver = Some(AccountAddress { + value: vec![1u8; 32], + }); + let amount = Some(Amount { value: 42 }); + let payload = Some(AccountTransactionPayload { + payload: Some(account_transaction_payload::Payload::Transfer( + TransferPayload { receiver, amount }, + )), + }); + + let signature = Some(AccountTransactionSignature { + signatures: HashMap::from([( + 0, + AccountSignatureMap { + signatures: HashMap::from([( + 0, + Signature { + value: vec![2u8; 64], + }, + )]), + }, + )]), + }); + + let at = AccountTransaction { + header, + payload, + signature, + }; + + let req = SendBlockItemRequest { + block_item: Some(send_block_item_request::BlockItem::AccountTransaction(at)), + }; + + // Call get_v0_format and check the result. + let result = req.get_v0_format(); + assert!(result.is_ok()); + let data = result.unwrap(); + + assert_eq!( + data, + [ + 0, // Version (0) + 0, // Tag for AccountTransaction (0) + 1, // One account signature + 0, // Credential index 0 + 1, // One credential signature + 0, // Key index 0 + 0, 64, // Signature length (64) + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, // Signature (64 bytes, all 2) + 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, + 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, + 37, // Sender (32 bytes, all 37) + 0, 0, 0, 0, 0, 0, 0, 1, // Sequence number (1) + 0, 0, 0, 0, 0, 0, 3, 232, // Energy amount (1000) + 0, 0, 0, 41, // Payload size (41 bytes) + 0, 0, 0, 0, 0, 1, 226, 64, // Expiry (123456) + 3, // Transfer payload + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, // Receiver (32 bytes, all 1) + 0, 0, 0, 0, 0, 0, 0, 42 // Amount (42) + ] + ); + } + #[test] + fn test_send_block_item_request_get_v0_format_account_transaction_v1() { + // Prepare minimal valid AccountTransactionV1 fields. + let sender = Some(AccountAddress { + value: vec![42u8; 32], + }); + let sequence_number = Some(SequenceNumber { value: 2 }); + let energy_amount = Some(Energy { value: 2000 }); + let expiry = Some(TransactionTime { value: 654321 }); + let sponsor = Some(AccountAddress { + value: vec![99u8; 32], + }); + let header = Some(AccountTransactionHeaderV1 { + sender, + sequence_number, + energy_amount, + expiry, + sponsor, + }); + + // Use a simple transfer with memo payload. + let receiver = Some(AccountAddress { + value: vec![12u8; 32], + }); + let amount = Some(Amount { value: 123 }); + let memo = Some(Memo { + value: vec![7u8; 32], + }); + let payload = Some(AccountTransactionPayload { + payload: Some(account_transaction_payload::Payload::TransferWithMemo( + TransferWithMemoPayload { + receiver, + amount, + memo, + }, + )), + }); + + let signature = Some(AccountTransactionSignature { + signatures: HashMap::from([( + 1, + AccountSignatureMap { + signatures: HashMap::from([( + 2, + Signature { + value: vec![5u8; 64], + }, + )]), + }, + )]), + }); + + let sponsor_signatures = Some(AccountTransactionSignature { + signatures: HashMap::from([( + 0, + AccountSignatureMap { + signatures: HashMap::from([( + 0, + Signature { + value: vec![8u8; 64], + }, + )]), + }, + )]), + }); + + let signatures = Some(AccountTransactionV1Signatures { + sender_signatures: signature, + sponsor_signatures, + }); + + let atv1 = AccountTransactionV1 { + header, + payload, + signatures, + }; + + let req = SendBlockItemRequest { + block_item: Some(send_block_item_request::BlockItem::AccountTransactionV1( + atv1, + )), + }; + + // Call get_v0_format and check the result. + let result = req.get_v0_format(); + assert!(result.is_ok()); + let data = result.unwrap(); + + assert_eq!( + data, + [ + 0, // Version (0) + 3, // Tag for AccountTransactionV1 (3) + 1, // Sender: One account signature + 1, // Credential index 1 + 1, // One credential signature + 2, // Key index 2 + 0, 64, // Signature length (64) + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, // Signature (64 bytes, all 5) + 1, // Sponsor: One account signature + 0, // Credential index 0 + 1, // One credential signature + 0, // Key index 0 + 0, 64, // Signature length (64) + 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, + 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, + 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, // Signature (64 bytes, all 8) + 0, 1, // Bitmap fields (indicating presence of sponsor address) + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, // Sender (32 bytes, all 42) + 0, 0, 0, 0, 0, 0, 0, 2, // Sequence number (2) + 0, 0, 0, 0, 0, 0, 7, 208, // Energy amount (2000) + 0, 0, 0, 75, // Payload size (75 bytes) + 0, 0, 0, 0, 0, 9, 251, 241, // Expiry (123456) + 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, + 99, // Sponsor (32 bytes, all 99) + 22, // Transfer with memo payload + 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, + 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, + 12, // Receiver (32 bytes, all 12) + 0, 32, // Memo length (32 bytes) + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, // Receiver (32 bytes, all 7) + 0, 0, 0, 0, 0, 0, 0, 123 // Amount (123) + ] + ); + } + + #[test] + fn test_send_block_item_request_get_v0_format_raw_block_item() { + use super::*; + // Prepare a raw block item with some bytes. + let raw_bytes = vec![1, 2, 3, 4, 5, 6, 7, 8, 9, 10]; + let req = SendBlockItemRequest { + block_item: Some(send_block_item_request::BlockItem::RawBlockItem( + raw_bytes.clone(), + )), + }; + + // Call get_v0_format and check the result. + let result = req.get_v0_format(); + assert!(result.is_ok()); + let data = result.unwrap(); + + // The result should start with the version prefix (0u8 as Version). + // The rest should be the raw bytes. + // Version serialization is just 1 byte for 0. + assert_eq!(data[0], 0); + assert_eq!(&data[1..], &raw_bytes[..]); + } + } } /// The service generated from the configuration in the `build.rs` file. diff --git a/plt-deployment-unit/Cargo.lock b/plt-deployment-unit/Cargo.lock index 989f338b8c..56e8a3cf14 100644 --- a/plt-deployment-unit/Cargo.lock +++ b/plt-deployment-unit/Cargo.lock @@ -365,7 +365,7 @@ dependencies = [ [[package]] name = "concordium_base" -version = "8.0.0-alpha.3" +version = "9.0.0" dependencies = [ "anyhow", "ark-bls12-381", @@ -385,6 +385,7 @@ dependencies = [ "ed25519-dalek", "either", "ff", + "generic-array", "hex", "itertools 0.14.0", "leb128", @@ -728,9 +729,9 @@ checksum = "e6d5a32815ae3f33302d95fdcb2ce17862f8c65363dcfd29360480ba1001fc9c" [[package]] name = "generic-array" -version = "0.14.9" +version = "0.14.7" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4bb6743198531e02858aeaea5398fcc883e71851fcbcb5a2f773e2fb6cb1edf2" +checksum = "85649ca51fd72272d7821adaf274ad91c288277713d9c18820d8499a7ff69e9a" dependencies = [ "typenum", "version_check",