COR-1345: verification for CreatePLT in TransactionVerifier (#1431)

* COR-1345: verify tx for CreatePLT in TransactionVerifier

We add an additional check in the verifyChainUpdate function for
txs with payloads of type CreatePLTUpdatePayload and assert that the
effective time of the transaction is zero in this case.

* update changelog

* address review comments

* new unit tests for transaction verification

At this point this only tests the new verification for CreatePLT.

* Update concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs

Co-authored-by: Thomas Dinsdale-Young <td202@users.noreply.github.com>

* add guard for spv >= P9

* add P7 back in tests

---------

Co-authored-by: drsk <rsk@concordium.com>
Co-authored-by: Thomas Dinsdale-Young <td202@users.noreply.github.com>

Author: 3 people

CHANGELOG.md

@@ -1,6 +1,9 @@
 # Changelog
 
 ## Unreleased changes
+- Protocol-level tokens:
+  - Additional check in transaction verification asserting that the effective
+    time equals zero of CreatePLT update transactions.
 
 - Add P8 -> P9 update.
 - Update GHC version to 9.10.2 (lts-24.0).

concordium-consensus/src/Concordium/Scheduler.hs

@@ -210,6 +210,7 @@ checkTransactionVerificationResult (TVer.NotOk TVer.NormalTransactionDepositInsu
 checkTransactionVerificationResult (TVer.NotOk (TVer.NormalTransactionDuplicateNonce nonce)) = Left $ NonSequentialNonce nonce
 checkTransactionVerificationResult (TVer.NotOk TVer.Expired) = Left ExpiredTransaction
 checkTransactionVerificationResult (TVer.NotOk TVer.InvalidPayloadSize) = Left InvalidPayloadSize
+checkTransactionVerificationResult (TVer.NotOk TVer.ChainUpdateEffectiveTimeNonZeroForCreatePLT) = Left InvalidUpdateTime
 
 -- | Execute a transaction on the current block state, charging valid accounts
 -- for the resulting energy cost.

concordium-consensus/src/Concordium/Skov/Monad.hs

@@ -140,6 +140,7 @@ transactionVerificationResultToUpdateResult (TV.NotOk TV.NormalTransactionDeposi
 transactionVerificationResultToUpdateResult (TV.NotOk (TV.NormalTransactionDuplicateNonce _)) = ResultDuplicateNonce
 transactionVerificationResultToUpdateResult (TV.NotOk TV.Expired) = ResultStale
 transactionVerificationResultToUpdateResult (TV.NotOk TV.InvalidPayloadSize) = ResultSerializationFail
+transactionVerificationResultToUpdateResult (TV.NotOk TV.ChainUpdateEffectiveTimeNonZeroForCreatePLT) = ResultChainUpdateInvalidEffectiveTime
 
 class
     ( Monad m,

concordium-consensus/src/Concordium/TransactionVerification.hs

@@ -130,6 +130,8 @@ data NotOkResult
       CredentialDeploymentInvalidSignatures
     | -- | The 'ChainUpdate' had an expiry set too late.
       ChainUpdateEffectiveTimeBeforeTimeout
+    | -- | The 'ChainUpdate' is creating a PLT, but its effective time is non-zero.
+      ChainUpdateEffectiveTimeNonZeroForCreatePLT
     | -- | The `UpdateSequenceNumber` of the 'ChainUpdate' was too old.
       --  Reason for 'NotOk': the UpdateSequenceNumber can never be valid in a later block if the
       --  nonce is already used.
@@ -271,6 +273,11 @@ verifyChainUpdate ui@Updates.UpdateInstruction{..} =
                 unless (Types.validatePayloadSize (Types.protocolVersion @(Types.MPV m)) (Updates.updatePayloadSize uiHeader)) $
                     throwError $
                         NotOk InvalidPayloadSize
+                case uiPayload of
+                    Updates.CreatePLTUpdatePayload _
+                        | Updates.updateEffectiveTime uiHeader > 0 ->
+                            throwError $ NotOk ChainUpdateEffectiveTimeNonZeroForCreatePLT
+                    _otherwise -> return ()
                 -- Check that the timeout is no later than the effective time,
                 -- or the update is immediate
                 when (Updates.updateTimeout uiHeader >= Updates.updateEffectiveTime uiHeader && Updates.updateEffectiveTime uiHeader /= 0) $

concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Common.hs

@@ -150,6 +150,8 @@ forEveryProtocolVersion check =
           check SP5 "P5",
           check SP6 "P6",
           check SP7 "P7"
+          -- check SP8 "P8",
+          -- check SP9 "P9"
         ]
 
 -- | Run tests for each protocol version using consensus v1 (P6 and onwards).

concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs

@@ -71,6 +71,8 @@ import Concordium.Types.Option
 import Concordium.Types.Parameters
 import Concordium.Types.TransactionOutcomes
 import Concordium.Types.Transactions
+import Concordium.Types.Updates
+import Concordium.Utils
 
 import Concordium.GlobalState.Transactions
 import Concordium.KonsensusV1.Transactions
@@ -329,8 +331,8 @@ dummyAccountAddress = fst $ randomAccountAddress (mkStdGen 42)
 --  relation to the tree state in this test, hence
 --  when processed it will fail on looking up the sender.
 --  Note. that the signature is not correct either.
-dummyTransaction :: Transaction
-dummyTransaction =
+dummyNormalTransaction :: Transaction
+dummyNormalTransaction =
     addMetadata NormalTransaction 0 $
         makeAccountTransaction
             dummyTransactionSignature
@@ -347,9 +349,73 @@ dummyTransaction =
             }
     payload = encodePayload $ Transfer dummyAccountAddress 10
 
--- | The block item for 'dummyTransaction'.
-dummyTransactionBI :: BlockItem
-dummyTransactionBI = normalTransaction dummyTransaction
+-- | A dummy update instruction.
+dummyUpdateInstruction :: TransactionTime -> WithMetadata UpdateInstruction
+dummyUpdateInstruction effTime =
+    addMetadata ChainUpdate 0 $
+        makeUpdateInstruction
+            RawUpdateInstruction
+                { ruiSeqNumber = 1,
+                  ruiEffectiveTime = effTime,
+                  ruiTimeout = 2,
+                  ruiPayload = cplt
+                }
+            (Map.singleton 0 dummyAuthorizationKeyPair)
+  where
+    cplt =
+        CreatePLTUpdatePayload $
+            CreatePLT
+                { _cpltTokenId = TokenId "dummyToken",
+                  _cpltTokenModule = TokenModuleRef $ Hash.hash "dummyToken",
+                  _cpltDecimals = 4,
+                  _cpltInitializationParameters = TokenParameter ""
+                }
+
+-- | The block item for 'dummyNormalTransaction'.
+dummyNormalTransactionBI :: BlockItem
+dummyNormalTransactionBI = normalTransaction dummyNormalTransaction
+
+-- | The block item for 'dummyUpdateInstruction'.
+dummyChainUpdateBI :: TransactionTime -> BlockItem
+dummyChainUpdateBI effTime = chainUpdate $ dummyUpdateInstruction effTime
+
+-- | Test for transaction verification
+testTransactionVerification ::
+    forall pv.
+    (IsConsensusV1 pv, IsProtocolVersion pv, PVSupportsPLT pv) =>
+    SProtocolVersion pv ->
+    Spec
+testTransactionVerification _ = describe "transaction verification" $ do
+    it "ChainUpdate: CreatePLT: Ok" $ do
+        (verResult, _) <- runMyTestMonad @pv myIdentityProviders theTime $
+            do
+                t <- utcTimeToTimestamp <$> currentTime
+                ctx <- getCtx
+                verifyBlockItem t (dummyChainUpdateBI 0) ctx
+        assertEqual
+            "A correct transaction should be verified"
+            (TVer.Ok TVer.ChainUpdateSuccess{keysHash = getHash (dummyKeyCollection @(AuthorizationsVersionFor pv)), seqNumber = 1})
+            verResult
+    it "ChainUpdate: CreatePLT: Non-zero effective time for CreatePLT" $ do
+        (verResult, _) <- runMyTestMonad @pv myIdentityProviders theTime $
+            do
+                t <- utcTimeToTimestamp <$> currentTime
+                ctx <- getCtx
+                verifyBlockItem t (dummyChainUpdateBI 1) ctx
+        assertEqual
+            "A CreatePLT update with non-zero effective time should be rejected"
+            (TVer.NotOk TVer.ChainUpdateEffectiveTimeNonZeroForCreatePLT)
+            verResult
+  where
+    -- Create a context suitable for verifying a transaction within a 'Individual' context.
+    getCtx = do
+        _ctxBs <- bpState <$> gets' _lastFinalized
+        let chainParams = dummyChainParameters @(ChainParametersVersionFor pv)
+        let _ctxMaxBlockEnergy = chainParams ^. cpConsensusParameters . cpBlockEnergyLimit
+        return $! Context{_ctxTransactionOrigin = TVer.Individual, ..}
+
+    theTime :: UTCTime
+    theTime = posixSecondsToUTCTime 1 -- after genesis
 
 -- | Testing various cases for processing a block item individually.
 testProcessBlockItem ::
@@ -384,7 +450,7 @@ testProcessBlockItem _ = describe "processBlockItem" $ do
     it "MaybeOk transaction" $ do
         -- We use a normal transfer transaction here with an invalid sender as it will yield a
         -- 'MaybeOk' verification result.
-        (pbiRes, sd') <- runMyTestMonad @pv dummyIdentityProviders theTime (processBlockItem dummyTransactionBI)
+        (pbiRes, sd') <- runMyTestMonad @pv dummyIdentityProviders theTime (processBlockItem dummyNormalTransactionBI)
         assertEqual
             "The credential deployment should be rejected (the identity provider has correct id but wrong keys used for the credential deployment)"
             (NotAdded $ TVer.MaybeOk $ TVer.NormalTransactionInvalidSender dummyAccountAddress)
@@ -454,7 +520,7 @@ testProcessBlockItems sProtocolVersion = describe "processBlockItems" $ do
     it "A non verifiable transaction first in the block makes it fail and stop processing the rest" $ do
         (processed, sd') <-
             runMyTestMonad dummyIdentityProviders theTime $
-                processBlockItems (blockToProcess [dummyCredentialDeployment, dummyTransactionBI]) =<< _lastFinalized <$> get
+                processBlockItems (blockToProcess [dummyCredentialDeployment, dummyNormalTransactionBI]) =<< _lastFinalized <$> get
         assertBool
             "Block should not have been successfully processed"
             (null processed)
@@ -465,7 +531,7 @@ testProcessBlockItems sProtocolVersion = describe "processBlockItems" $ do
     it "A non verifiable transaction last in the block makes it fail but the valid ones have been put into the state." $ do
         (processed, sd') <-
             runMyTestMonad dummyIdentityProviders theTime $
-                processBlockItems (blockToProcess [dummyTransactionBI, dummyCredentialDeployment]) =<< _lastFinalized <$> get
+                processBlockItems (blockToProcess [dummyNormalTransactionBI, dummyCredentialDeployment]) =<< _lastFinalized <$> get
         assertBool
             "Block should not have been successfully processed"
             (null processed)
@@ -476,7 +542,7 @@ testProcessBlockItems sProtocolVersion = describe "processBlockItems" $ do
     it "A block consisting of verifiable transactions only is accepted" $ do
         (processed, sd') <-
             runMyTestMonad myIdentityProviders theTime $
-                processBlockItems (blockToProcess [dummyTransactionBI, dummyCredentialDeployment]) =<< _lastFinalized <$> get
+                processBlockItems (blockToProcess [dummyNormalTransactionBI, dummyCredentialDeployment]) =<< _lastFinalized <$> get
         assertBool
             "Block should have been successfully processed"
             (isJust processed)
@@ -550,3 +616,6 @@ tests = describe "KonsensusV1.TransactionProcessing" $ do
                 testProcessBlockItem spv
             describe "Batch transaction processing" $ do
                 testProcessBlockItems spv
+    describe "P9" $ do
+        describe "Transaction verification" $
+            testTransactionVerification SP9