Feature/sponsored transactions

.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

.github/workflows/release.yaml

@@ -268,7 +268,7 @@ jobs:
 
       - name: Install DigiCert Client tools (Windows only)
         id: digicert_client
-        uses: digicert/ssm-[email protected]
+        uses: digicert/code-signing-software-trust-action@v1.0.0
 
       - name: Import Windows certificate (Windows only)
         id: windows_certificate

.gitignore

@@ -65,3 +65,6 @@ xcuserdata/
 /scripts/distribution/macOS-package/NodeConfigurationInstallerPlugin/*.gcno
 # Code coverage report
 lcov.info
+# Test artefacts
+.stack-work-coverage*
+*.blob

CHANGELOG.md

@@ -2,13 +2,17 @@
 
 ## Unreleased changes
 
+## 10.0.0 (DevNet)
+
 - Updated the token module interface in accordance with adjustments to the PLT specification
   <https://proposals.concordium.com/CIS/cis-7.html>
   where token name, metadata and governance account are now optional in the token module initialization parameterts and
   the token module state. They are still required by the current token module implementation, and initialization
   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
 

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

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

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

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

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

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)