extra tests for transaction status when it's committed.

plutus-chain-index/src/Plutus/ChainIndex/TxIdState.hs

@@ -12,8 +12,7 @@
 {-# LANGUAGE ViewPatterns          #-}
 
 module Plutus.ChainIndex.TxIdState(
-    isConfirmed
-    , increaseDepth
+    increaseDepth
     , initialStatus
     , transactionStatus
     , fromTx
@@ -41,13 +40,6 @@ initialStatus :: OnChainTx -> TxStatus
 initialStatus =
   TentativelyConfirmed 0 . eitherTx (const TxInvalid) (const TxValid)
 
--- | Whether a 'TxStatus' counts as confirmed given the minimum depth
-isConfirmed :: Depth -> TxStatus -> Bool
-isConfirmed minDepth = \case
-    TentativelyConfirmed d _ | d >= minDepth -> True
-    Committed{}                              -> True
-    _                                        -> False
-
 -- | Increase the depth of a tentatively confirmed transaction
 increaseDepth :: TxStatus -> TxStatus
 increaseDepth (TentativelyConfirmed d s)
@@ -68,18 +60,31 @@ transactionStatus currentBlock txIdState txId
        (Nothing, _)      -> Right Unknown
 
        (Just TxConfirmedState{blockAdded=Last (Just block'), validity=Last (Just validity')}, Nothing) ->
-         if block' + (fromIntegral chainConstant) >= currentBlock
-            then Right $ newStatus block' validity'
-            else Right $ Committed validity'
+         if lockedIn block'
+            then Right $ Committed validity'
+            else Right $ newStatus block' validity'
 
        (Just TxConfirmedState{timesConfirmed=confirms, blockAdded=Last (Just block'), validity=Last (Just validity')}, Just deletes) ->
          if confirms > deletes
+            -- It's fine, it's confirmed
             then Right $ newStatus block' validity'
-            else Right $ Unknown
+            -- Otherwise, throw an error if it looks deleted but we're too far
+            -- into the future.
+            else if lockedIn block'
+                    -- Illegal - We can't roll this transaction back.
+                    then Left $ InvalidRollbackAttempt currentBlock txId txIdState
+                    else Right $ Unknown
 
        _ -> Left $ TxIdStateInvalid currentBlock txId txIdState
     where
-      newStatus block' validity' = TentativelyConfirmed (Depth $ fromIntegral $ currentBlock - block') validity'
+      -- A block is 'locked in' if at least 'chainConstant' number of blocks
+      -- has elapsed since the block was added.
+      lockedIn addedInBlock = currentBlock > addedInBlock + fromIntegral chainConstant
+
+      newStatus block' validity' =
+        if lockedIn block'
+           then Committed validity'
+           else TentativelyConfirmed (Depth $ fromIntegral $ currentBlock - block') validity'
       confirmed = Map.lookup txId (txnsConfirmed txIdState)
       deleted   = Map.lookup txId (txnsDeleted txIdState)
 

plutus-chain-index/src/Plutus/ChainIndex/Types.hs

@@ -220,11 +220,12 @@ data Diagnostics =
         deriving stock (Eq, Ord, Show, Generic)
         deriving anyclass (ToJSON, FromJSON)
 
-data TxStatusFailure =
+data TxStatusFailure
       -- | We couldn't return the status because the 'TxIdState' was in a ...
       -- state ... that we didn't know how to decode in
       -- 'Plutus.ChainIndex.TxIdState.transactionStatus'.
-      TxIdStateInvalid BlockNumber TxId TxIdState
+      = TxIdStateInvalid BlockNumber TxId TxIdState
+      | InvalidRollbackAttempt BlockNumber TxId TxIdState
       deriving (Show, Eq)
 
 data TxIdState = TxIdState

plutus-chain-index/test/Spec.hs

@@ -26,7 +26,8 @@ import           Plutus.ChainIndex.Tx                 (citxTxId, txOutsWithRef)
 import           Plutus.ChainIndex.TxIdState          (increaseDepth, transactionStatus)
 import qualified Plutus.ChainIndex.TxIdState          as TxIdState
 import           Plutus.ChainIndex.Types              (BlockNumber (..), Depth (..), Tip (..), TxConfirmedState (..),
-                                                       TxIdState (..), TxStatus (..), TxValidity (..), tipAsPoint)
+                                                       TxIdState (..), TxStatus (..), TxStatusFailure (..),
+                                                       TxValidity (..), tipAsPoint)
 import           Plutus.ChainIndex.UtxoState          (InsertUtxoSuccess (..), RollbackResult (..), TxUtxoBalance (..))
 import qualified Plutus.ChainIndex.UtxoState          as UtxoState
 import           Test.Tasty
@@ -102,6 +103,9 @@ rollbackTxIdState = property $ do
       deleted tx txIdState = (Map.lookup (tx ^. citxTxId) $ txnsDeleted $ getState txIdState)
       status bn tx txIdState = transactionStatus (BlockNumber bn) (getState txIdState) (tx ^. citxTxId)
 
+      isInvalidRollback (Left (InvalidRollbackAttempt _ _ _)) = True
+      isInvalidRollback _                                     = False
+
   -- It's inserted at f2, and is confirmed once and not deleted, resulting
   -- in a tentatively-confirmed status.
   confirmed txB f2 === Just 1
@@ -114,12 +118,19 @@ rollbackTxIdState = property $ do
   deleted txB f3   === Just 1
   status 2 txB f3  === (Right $ Unknown)
 
+  -- If we check the status far into the future, this should be an error, as
+  -- we're trying to rollback something that is committed.
+  isInvalidRollback (status 100 txB f3) === True
+
   -- At f4, it's confirmed twice, and deleted once, resulting in a
   -- tentatively-confirmed status again.
   confirmed txB f4 === Just 2
   deleted txB f4   === Just 1
   status 3 txB f4  === (Right $ TentativelyConfirmed (Depth 1) TxValid)
 
+  -- Much later, it should be committed.
+  status 100 txB f4 === Right (Committed TxValid)
+
 transactionDepthIncreases :: Property
 transactionDepthIncreases = property $ do
   ((tipA, txA), (tipB, txB)) <- forAll