SCP-2734: API for watching the state of tx outputs.

* Added awaitTxOutStatusChange API call in plutus-contract and updated the emulator to respond to those calls. * Added waitTxOutStatusChange API call in plutus-pab, updated the request handler to respond to those calls. * Created type `TxOutBalance` which keeps track of spent and unspent transaction outptus of a set of transactions. * Added types for representing the transaction output status. Refactored the type of the old transaction status as well. * Refactored testing module in plutus-chain-index. * TxUtxoBalance in now in it's own module in plutus-chain-index. * The testing in plutus-pab is much faster because the time per slot is now 1ms instead of 1s.
IntersectMBO · Sep 24, 2021 · 4e1041f · 4e1041f
1 parent 58c093a
commit 4e1041f
Show file tree

Hide file tree

Showing 35 changed files with 994 additions and 404 deletions.
diff --git a/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-chain-index.nix b/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-chain-index.nix
diff --git a/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-contract.nix b/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-contract.nix
diff --git a/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-pab.nix b/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-pab.nix
diff --git a/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-chain-index.nix b/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-chain-index.nix
diff --git a/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-contract.nix b/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-contract.nix
diff --git a/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-pab.nix b/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-pab.nix
diff --git a/nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-chain-index.nix b/nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-chain-index.nix
diff --git a/nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-contract.nix b/nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-contract.nix
diff --git a/nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-pab.nix b/nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-pab.nix
diff --git a/playground-common/src/PSGenerator/Common.hs b/playground-common/src/PSGenerator/Common.hs
@@ -39,8 +39,8 @@ import           Playground.Types                          (ContractCall, Functi
 import           Plutus.ChainIndex.ChainIndexError         (ChainIndexError)
 import           Plutus.ChainIndex.ChainIndexLog           (ChainIndexLog)
 import           Plutus.ChainIndex.Tx                      (ChainIndexTx, ChainIndexTxOutputs)
-import           Plutus.ChainIndex.Types                   (BlockNumber, Depth, Page, PageSize, Point, Tip, TxStatus,
-                                                            TxValidity)
+import           Plutus.ChainIndex.Types                   (BlockNumber, Depth, Page, PageSize, Point, RollbackState,
+                                                            Tip, TxOutState, TxValidity)
 import           Plutus.ChainIndex.UtxoState               (InsertUtxoFailed, InsertUtxoPosition, RollbackFailed)
 import           Plutus.Contract.CardanoAPI                (FromCardanoError)
 import           Plutus.Contract.Checkpoint                (CheckpointError)
@@ -405,7 +405,8 @@ ledgerTypes =
     , (equal <*> (genericShow <*> mkSumType)) (Proxy @ActiveEndpoint)
     , (equal <*> (genericShow <*> mkSumType)) (Proxy @UnbalancedTx)
     , (equal <*> (genericShow <*> mkSumType)) (Proxy @TxValidity)
-    , (equal <*> (genericShow <*> mkSumType)) (Proxy @TxStatus)
+    , (equal <*> (genericShow <*> mkSumType)) (Proxy @TxOutState)
+    , (equal <*> (genericShow <*> mkSumType)) (Proxy @(RollbackState A))
     , (equal <*> (genericShow <*> mkSumType)) (Proxy @BlockNumber)
     , (equal <*> (genericShow <*> mkSumType)) (Proxy @Depth)
     ]

diff --git a/plutus-chain-index/plutus-chain-index.cabal b/plutus-chain-index/plutus-chain-index.cabal
@@ -45,6 +45,8 @@ library
         Plutus.ChainIndex.Server
         Plutus.ChainIndex.Tx
         Plutus.ChainIndex.TxIdState
+        Plutus.ChainIndex.TxOutBalance
+        Plutus.ChainIndex.TxUtxoBalance
         Plutus.ChainIndex.Types
         Plutus.ChainIndex.UtxoState
         Plutus.Monitoring.Util

diff --git a/plutus-chain-index/src/Plutus/ChainIndex.hs b/plutus-chain-index/src/Plutus/ChainIndex.hs
@@ -8,5 +8,7 @@ import           Plutus.ChainIndex.Effects         as Export
 import           Plutus.ChainIndex.Handlers        as Export
 import           Plutus.ChainIndex.Tx              as Export
 import           Plutus.ChainIndex.TxIdState       as Export hiding (fromBlock, fromTx, rollback)
+import           Plutus.ChainIndex.TxOutBalance    as Export hiding (fromBlock, fromTx, isSpentOutput, isUnspentOutput,
+                                                              rollback)
 import           Plutus.ChainIndex.Types           as Export
-import           Plutus.ChainIndex.UtxoState       as Export hiding (fromBlock, fromTx, rollback)
+import           Plutus.ChainIndex.UtxoState       as Export
diff --git a/plutus-chain-index/src/Plutus/ChainIndex/Emulator/Handlers.hs b/plutus-chain-index/src/Plutus/ChainIndex/Emulator/Handlers.hs
@@ -46,9 +46,9 @@ import           Plutus.ChainIndex.Emulator.DiskState (DiskState, addressMap, da
                                                        scriptMap, txMap)
 import qualified Plutus.ChainIndex.Emulator.DiskState as DiskState
 import           Plutus.ChainIndex.Tx                 (ChainIndexTx, _ValidTx, citxOutputs)
-import           Plutus.ChainIndex.Types              (Tip (..), pageOf)
-import           Plutus.ChainIndex.UtxoState          (InsertUtxoSuccess (..), RollbackResult (..), TxUtxoBalance,
-                                                       UtxoIndex, isUnspentOutput, tip)
+import qualified Plutus.ChainIndex.TxUtxoBalance      as TxUtxoBalance
+import           Plutus.ChainIndex.Types              (Tip (..), TxUtxoBalance, pageOf)
+import           Plutus.ChainIndex.UtxoState          (InsertUtxoSuccess (..), RollbackResult (..), UtxoIndex, tip)
 import qualified Plutus.ChainIndex.UtxoState          as UtxoState
 import           Plutus.V1.Ledger.Api                 (Credential (PubKeyCredential, ScriptCredential))
 
@@ -127,12 +127,12 @@ handleQuery = \case
         utxoState <- gets (measure . view utxoIndex)
         case tip utxoState of
             TipAtGenesis -> throwError QueryFailedNoTip
-            tp           -> pure (tp, isUnspentOutput r utxoState)
+            tp           -> pure (tp, TxUtxoBalance.isUnspentOutput r utxoState)
     UtxoSetAtAddress cred -> do
         state <- get
         let outRefs = view (diskState . addressMap . at cred) state
             utxoState = view (utxoIndex . to measure) state
-            page = pageOf def $ Set.filter (\r -> isUnspentOutput r utxoState) (fromMaybe mempty outRefs)
+            page = pageOf def $ Set.filter (\r -> TxUtxoBalance.isUnspentOutput r utxoState) (fromMaybe mempty outRefs)
         case tip utxoState of
             TipAtGenesis -> do
                 logWarn TipIsGenesis
@@ -152,7 +152,7 @@ handleControl ::
 handleControl = \case
     AppendBlock tip_ transactions -> do
         oldState <- get @ChainIndexEmulatorState
-        case UtxoState.insert (UtxoState.fromBlock tip_ transactions) (view utxoIndex oldState) of
+        case UtxoState.insert (TxUtxoBalance.fromBlock tip_ transactions) (view utxoIndex oldState) of
             Left err -> do
                 let reason = InsertionFailed err
                 logError $ Err reason
@@ -164,7 +164,7 @@ handleControl = \case
                 logDebug $ InsertionSuccess tip_ insertPosition
     Rollback tip_ -> do
         oldState <- get @ChainIndexEmulatorState
-        case UtxoState.rollback tip_ (view utxoIndex oldState) of
+        case TxUtxoBalance.rollback tip_ (view utxoIndex oldState) of
             Left err -> do
                 let reason = RollbackFailed err
                 logError $ Err reason
@@ -178,7 +178,7 @@ handleControl = \case
         utxos <- gets $
             Set.toList
             . Set.map txOutRefId
-            . UtxoState.unspentOutputs
+            . TxUtxoBalance.unspentOutputs
             . UtxoState.utxoState
             . view utxoIndex
         newDiskState <- foldMap DiskState.fromTx . catMaybes <$> mapM getTxFromTxId utxos

diff --git a/plutus-chain-index/src/Plutus/ChainIndex/Handlers.hs b/plutus-chain-index/src/Plutus/ChainIndex/Handlers.hs
@@ -44,10 +44,10 @@ import           Plutus.ChainIndex.ChainIndexLog   (ChainIndexLog (..))
 import           Plutus.ChainIndex.DbStore
 import           Plutus.ChainIndex.Effects         (ChainIndexControlEffect (..), ChainIndexQueryEffect (..))
 import           Plutus.ChainIndex.Tx
+import qualified Plutus.ChainIndex.TxUtxoBalance   as TxUtxoBalance
 import           Plutus.ChainIndex.Types           (BlockId (BlockId), BlockNumber (BlockNumber), Diagnostics (..),
-                                                    Tip (..), pageOf)
-import           Plutus.ChainIndex.UtxoState       (InsertUtxoSuccess (..), RollbackResult (..), TxUtxoBalance,
-                                                    UtxoIndex)
+                                                    Tip (..), TxUtxoBalance, pageOf)
+import           Plutus.ChainIndex.UtxoState       (InsertUtxoSuccess (..), RollbackResult (..), UtxoIndex)
 import qualified Plutus.ChainIndex.UtxoState       as UtxoState
 import           Plutus.V1.Ledger.Api              (Credential (PubKeyCredential, ScriptCredential))
 import           PlutusTx.Builtins.Internal        (BuiltinByteString (..))
@@ -74,11 +74,11 @@ handleQuery = \case
         utxoState <- gets @ChainIndexState FT.measure
         case UtxoState.tip utxoState of
             TipAtGenesis -> throwError QueryFailedNoTip
-            tp           -> pure (tp, UtxoState.isUnspentOutput r utxoState)
+            tp           -> pure (tp, TxUtxoBalance.isUnspentOutput r utxoState)
     UtxoSetAtAddress cred -> do
         utxoState <- gets @ChainIndexState FT.measure
         outRefs <- queryList . select $ _addressRowOutRef <$> filter_ (\row -> _addressRowCred row ==. val_ (toByteString cred)) (all_ (addressRows db))
-        let page = pageOf def $ Set.fromList $ filter (\r -> UtxoState.isUnspentOutput r utxoState) outRefs
+        let page = pageOf def $ Set.fromList $ filter (\r -> TxUtxoBalance.isUnspentOutput r utxoState) outRefs
         case UtxoState.tip utxoState of
             TipAtGenesis -> do
                 logWarn TipIsGenesis
@@ -174,7 +174,7 @@ handleControl ::
 handleControl = \case
     AppendBlock tip_ transactions -> do
         oldState <- get @ChainIndexState
-        case UtxoState.insert (UtxoState.fromBlock tip_ transactions) oldState of
+        case UtxoState.insert (TxUtxoBalance.fromBlock tip_ transactions) oldState of
             Left err -> do
                 let reason = InsertionFailed err
                 logError $ Err reason
@@ -186,7 +186,7 @@ handleControl = \case
                 logDebug $ InsertionSuccess tip_ insertPosition
     Rollback tip_ -> do
         oldState <- get @ChainIndexState
-        case UtxoState.rollback tip_ oldState of
+        case TxUtxoBalance.rollback tip_ oldState of
             Left err -> do
                 let reason = RollbackFailed err
                 logError $ Err reason
@@ -201,7 +201,7 @@ handleControl = \case
         utxos <- gets $
             Set.toList
             . Set.map txOutRefId
-            . UtxoState.unspentOutputs
+            . TxUtxoBalance.unspentOutputs
             . UtxoState.utxoState
         insertRows <- foldMap fromTx . catMaybes <$> mapM getTxFromTxId utxos
         combined $

diff --git a/plutus-chain-index/src/Plutus/ChainIndex/TxIdState.hs b/plutus-chain-index/src/Plutus/ChainIndex/TxIdState.hs
@@ -24,23 +24,23 @@ import qualified Data.Map                    as Map
 import           Data.Monoid                 (Last (..), Sum (..))
 import           Ledger                      (OnChainTx, TxId, eitherTx)
 import           Plutus.ChainIndex.Tx        (ChainIndexTx (..), ChainIndexTxOutputs (..), citxOutputs, citxTxId)
-import           Plutus.ChainIndex.Types     (BlockNumber (..), Depth (..), Point (..), Tip (..), TxConfirmedState (..),
-                                              TxIdState (..), TxStatus (..), TxStatusFailure (..), TxValidity (..),
-                                              pointsToTip)
+import           Plutus.ChainIndex.Types     (BlockNumber (..), Depth (..), Point (..), RollbackState (..), Tip (..),
+                                              TxConfirmedState (..), TxIdState (..), TxStatus, TxStatusFailure (..),
+                                              TxValidity (..), pointsToTip)
 import           Plutus.ChainIndex.UtxoState (RollbackFailed (..), RollbackResult (..), UtxoIndex, UtxoState (..), tip,
                                               viewTip)
 
 
 -- | The 'TxStatus' of a transaction right after it was added to the chain
 initialStatus :: OnChainTx -> TxStatus
-initialStatus =
-  TentativelyConfirmed 0 . eitherTx (const TxInvalid) (const TxValid)
+initialStatus tx =
+  TentativelyConfirmed 0 (eitherTx (const TxInvalid) (const TxValid) tx) ()
 
 -- | Increase the depth of a tentatively confirmed transaction
 increaseDepth :: TxStatus -> TxStatus
-increaseDepth (TentativelyConfirmed d s)
-  | d < succ chainConstant = TentativelyConfirmed (d + 1) s
-  | otherwise              = Committed s
+increaseDepth (TentativelyConfirmed d s ())
+  | d < succ chainConstant = TentativelyConfirmed (d + 1) s ()
+  | otherwise              = Committed s ()
 increaseDepth e            = e
 
 -- TODO: Configurable!
@@ -57,13 +57,13 @@ transactionStatus currentBlock txIdState txId
 
        (Just TxConfirmedState{blockAdded=Last (Just block'), validity=Last (Just validity')}, Nothing) ->
          if isCommitted block'
-            then Right $ Committed validity'
-            else Right $ newStatus block' validity'
+            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'
+            then Right $ newStatus block' validity' ()
             -- Otherwise, throw an error if it looks deleted but we're too far
             -- into the future.
             else if isCommitted block'