Skip to content

Commit

Permalink
Include balancing of wallet in draft commit tx tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@ch1bo
ch1bo committed May 6, 2024
1 parent 5a86d4e commit 07d0f9d
Show file tree
Hide file tree
Showing 2 changed files with 77 additions and 53 deletions.
48 changes: 30 additions & 18 deletions hydra-node/src/Hydra/Chain/Direct/Handlers.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -76,6 +76,7 @@ import Hydra.Chain.Direct.Wallet (
TinyWalletLog,
)
import Hydra.ContestationPeriod (toNominalDiffTime)
import Hydra.HeadId (HeadId)
import Hydra.Ledger (ChainSlot (ChainSlot), UTxOType)
import Hydra.Ledger.Cardano (adjustUTxO)
import Hydra.Logging (Tracer, traceWith)
Expand Down Expand Up @@ -148,7 +149,7 @@ mkChain ::
LocalChainState m Tx ->
SubmitTx m ->
Chain Tx m
mkChain tracer queryTimeHandle wallet@TinyWallet{getUTxO} ctx LocalChainState{getLatest} submitTx =
mkChain tracer queryTimeHandle wallet ctx LocalChainState{getLatest} submitTx =
Chain
{ postTx = \tx -> do
ChainStateAt{spendableUTxO} <- atomically getLatest
Expand All @@ -158,26 +159,37 @@ mkChain tracer queryTimeHandle wallet@TinyWallet{getUTxO} ctx LocalChainState{ge
atomically (prepareTxToPost timeHandle wallet ctx spendableUTxO tx)
>>= finalizeTx wallet ctx spendableUTxO mempty
submitTx vtx
, -- Handle that creates a draft commit tx using the user utxo and a _blueprint_ transaction.
-- Possible errors are handled at the api server level.
draftCommitTx = \headId commitBlueprintTx -> do
, draftCommitTx = \headId commitBlueprintTx -> do
ChainStateAt{spendableUTxO} <- atomically getLatest
walletUtxos <- atomically getUTxO
let walletTxIns = fromLedgerTxIn <$> Map.keys walletUtxos
let CommitBlueprintTx{lookupUTxO, blueprintTx} = commitBlueprintTx
let userTxIns = txIns' blueprintTx
let matchedWalletUtxo = filter (`elem` walletTxIns) userTxIns
-- prevent trying to spend internal wallet's utxo
if null matchedWalletUtxo
then
traverse (finalizeTx wallet ctx spendableUTxO lookupUTxO) $
commit' ctx headId spendableUTxO commitBlueprintTx
else pure $ Left SpendingNodeUtxoForbidden
, -- Submit a cardano transaction to the cardano-node using the
-- LocalTxSubmission protocol.
submitTx
draftCommitTx_ wallet ctx spendableUTxO headId commitBlueprintTx
, submitTx
}

draftCommitTx_ ::
(MonadSTM m, MonadThrow m) =>
TinyWallet m ->
ChainContext ->
UTxOType Tx ->
HeadId ->
CommitBlueprintTx Tx ->
m (Either (PostTxError Tx) Tx)
draftCommitTx_ wallet ctx spendableUTxO headId commitBlueprintTx = do
walletUtxos <- atomically getUTxO
let walletTxIns = fromLedgerTxIn <$> Map.keys walletUtxos
let matchedWalletUtxo = filter (`elem` walletTxIns) userTxIns
-- prevent trying to spend internal wallet's utxo
if null matchedWalletUtxo
then
traverse (finalizeTx wallet ctx spendableUTxO lookupUTxO) $
commit' ctx headId spendableUTxO commitBlueprintTx
else pure $ Left SpendingNodeUtxoForbidden
where
TinyWallet{getUTxO} = wallet

userTxIns = txIns' blueprintTx

CommitBlueprintTx{lookupUTxO, blueprintTx} = commitBlueprintTx

-- | Balance and sign the given partial transaction.
finalizeTx ::
MonadThrow m =>
Expand Down
82 changes: 47 additions & 35 deletions hydra-node/test/Hydra/Chain/Direct/TxSpec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,8 +46,10 @@ import Hydra.Chain.Direct.Fixture (
testPolicyId,
testSeedInput,
)
import Hydra.Chain.Direct.Fixture qualified as Fixture
import Hydra.Chain.Direct.Handlers (draftCommitTx_)
import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO)
import Hydra.Chain.Direct.State (HasKnownUTxO (getKnownUTxO), InitialState (..), commit', genChainStateWithTx, genHydraContext, genStInitial)
import Hydra.Chain.Direct.State (HasKnownUTxO (getKnownUTxO), InitialState (..), genChainStateWithTx, genHydraContext, genStInitial, ownParty, ownVerificationKey)
import Hydra.Chain.Direct.State qualified as Transition
import Hydra.Chain.Direct.Tx (
HeadObservation (..),
Expand All @@ -66,7 +68,8 @@ import Hydra.Chain.Direct.Tx (
txInToHeadSeed,
verificationKeyToOnChainId,
)
import Hydra.Chain.Direct.Wallet (ErrCoverFee (..), coverFee_)
import Hydra.Chain.Direct.Wallet (ErrCoverFee (..), coverFee_, getUTxO, newTinyWallet)
import Hydra.Chain.Direct.WalletSpec (mockChainQuery)
import Hydra.Contract.Commit qualified as Commit
import Hydra.Contract.HeadTokens (headPolicyId, mkHeadTokenScript)
import Hydra.Contract.Initial qualified as Initial
Expand All @@ -77,6 +80,7 @@ import Hydra.Ledger.Cardano (
addVkInputs,
emptyTxBody,
genOneUTxOFor,
genSigningKey,
genTxOutWithReferenceScript,
genUTxO1,
genUTxOAdaOnlyOfSize,
Expand All @@ -85,6 +89,7 @@ import Hydra.Ledger.Cardano (
unsafeBuildTransaction,
)
import Hydra.Ledger.Cardano.Evaluate (EvaluationReport, maxTxExecutionUnits, propTransactionEvaluates)
import Hydra.Logging (nullTracer)
import Hydra.Party (Party)
import PlutusLedgerApi.Test.Examples qualified as Plutus
import Test.Cardano.Ledger.Shelley.Arbitrary (genMetadata')
Expand All @@ -100,6 +105,7 @@ import Test.QuickCheck (
elements,
forAll,
forAllBlind,
ioProperty,
label,
property,
vectorOf,
Expand Down Expand Up @@ -206,40 +212,46 @@ spec =
forAllBlind (genHydraContext maximumNumberOfParties) $ \hctx ->
forAllBlind (genStInitial hctx) $ \(ctx, stInitial@InitialState{headId}) ->
forAllBlind genBlueprintTxWithUTxO $ \(lookupUTxO, blueprintTx) ->
counterexample ("Blueprint tx: " <> renderTxWithUTxO lookupUTxO blueprintTx) $ do
let spendableUTxO = getKnownUTxO stInitial <> lookupUTxO <> getKnownUTxO ctx
case commit' ctx headId spendableUTxO CommitBlueprintTx{lookupUTxO, blueprintTx} of
Left err -> property False & counterexample ("Failed to construct commit: " <> toString (pShow err))
Right commitTx ->
counterexample ("\n\n\nCommit tx: " <> renderTxWithUTxO lookupUTxO commitTx) $ do
let blueprintBody = toLedgerTx blueprintTx ^. bodyTxL
let commitTxBody = toLedgerTx commitTx ^. bodyTxL

conjoin
[ propTransactionEvaluates (blueprintTx, lookupUTxO)
& counterexample "Blueprint transaction failed to evaluate"
, propTransactionEvaluates (commitTx, spendableUTxO)
& counterexample "Commit transaction failed to evaluate"
, conjoin
[ getAuxMetadata blueprintTx `propIsSubmapOf` getAuxMetadata commitTx
& counterexample "Blueprint metadata incomplete"
, propHasValidAuxData blueprintTx
& counterexample "Blueprint tx has invalid aux data"
, propHasValidAuxData commitTx
& counterexample "Commit tx has invalid aux data"
counterexample ("Blueprint tx: " <> renderTxWithUTxO lookupUTxO blueprintTx) $
ioProperty $ do
let sk = genSigningKey `genForParty` ownParty ctx -- NOTE: signature is not not checked
vk = ownVerificationKey ctx
wallet <- newTinyWallet nullTracer Fixture.testNetworkId (vk, sk) (mockChainQuery vk) (pure Fixture.epochInfo)
walletUTxO <- UTxO.fromPairs . map (bimap fromLedgerTxIn fromLedgerTxOut) . Map.toList <$> atomically (getUTxO wallet)
let spendableUTxO = getKnownUTxO stInitial <> lookupUTxO <> getKnownUTxO ctx <> walletUTxO
draftCommitTx_ wallet ctx spendableUTxO headId CommitBlueprintTx{lookupUTxO, blueprintTx} >>= \case
Left err -> pure $ property False & counterexample ("Failed to construct commit: " <> toString (pShow err))
Right commitTx ->
pure $
counterexample ("\n\n\nCommit tx: " <> renderTxWithUTxO lookupUTxO commitTx) $ do
let blueprintBody = toLedgerTx blueprintTx ^. bodyTxL
let commitTxBody = toLedgerTx commitTx ^. bodyTxL

conjoin
[ propTransactionEvaluates (blueprintTx, lookupUTxO)
& counterexample "Blueprint transaction failed to evaluate"
, propTransactionEvaluates (commitTx, spendableUTxO)
& counterexample "Commit transaction failed to evaluate"
, conjoin
[ getAuxMetadata blueprintTx `propIsSubmapOf` getAuxMetadata commitTx
& counterexample "Blueprint metadata incomplete"
, propHasValidAuxData blueprintTx
& counterexample "Blueprint tx has invalid aux data"
, propHasValidAuxData commitTx
& counterexample "Commit tx has invalid aux data"
]
, blueprintBody ^. vldtTxBodyL === commitTxBody ^. vldtTxBodyL
& counterexample "Validity range mismatch"
, (blueprintBody ^. inputsTxBodyL) `propIsSubsetOf` (commitTxBody ^. inputsTxBodyL)
& counterexample "Blueprint inputs missing"
, property
((`all` (blueprintBody ^. outputsTxBodyL)) (`notElem` (commitTxBody ^. outputsTxBodyL)))
& counterexample "Blueprint outputs not discarded"
, (blueprintBody ^. reqSignerHashesTxBodyL) `propIsSubsetOf` (commitTxBody ^. reqSignerHashesTxBodyL)
& counterexample "Blueprint required signatures missing"
, (blueprintBody ^. referenceInputsTxBodyL) `propIsSubsetOf` (commitTxBody ^. referenceInputsTxBodyL)
& counterexample "Blueprint reference inputs missing"
]
, blueprintBody ^. vldtTxBodyL === commitTxBody ^. vldtTxBodyL
& counterexample "Validity range mismatch"
, (blueprintBody ^. inputsTxBodyL) `propIsSubsetOf` (commitTxBody ^. inputsTxBodyL)
& counterexample "Blueprint inputs missing"
, property
((`all` (blueprintBody ^. outputsTxBodyL)) (`notElem` (commitTxBody ^. outputsTxBodyL)))
& counterexample "Blueprint outputs not discarded"
, (blueprintBody ^. reqSignerHashesTxBodyL) `propIsSubsetOf` (commitTxBody ^. reqSignerHashesTxBodyL)
& counterexample "Blueprint required signatures missing"
, (blueprintBody ^. referenceInputsTxBodyL) `propIsSubsetOf` (commitTxBody ^. referenceInputsTxBodyL)
& counterexample "Blueprint reference inputs missing"
]

-- | Check auxiliary data of a transaction against 'pparams' and whether the aux
-- data hash is consistent.
Expand Down

0 comments on commit 07d0f9d

Please sign in to comment.