Skip to content

Commit cdd0516

Browse files
committed
Reproduce the midnight issue in test
Signed-off-by: Sasha Bogicevic <[email protected]>
1 parent 2bb89cf commit cdd0516

File tree

2 files changed

+100
-0
lines changed

2 files changed

+100
-0
lines changed

hydra-cluster/hydra-cluster.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -170,6 +170,7 @@ test-suite tests
170170
, filepath
171171
, hspec
172172
, hspec-golden-aeson
173+
, http-conduit
173174
, hydra-cardano-api
174175
, hydra-cluster
175176
, hydra-node

hydra-cluster/test/Test/EndToEndSpec.hs

Lines changed: 99 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -57,6 +57,7 @@ import Hydra.Cluster.Scenarios (
5757
canSubmitTransactionThroughAPI,
5858
checkFanout,
5959
headIsInitializingWith,
60+
hydraNodeBaseUrl,
6061
initWithWrongKeys,
6162
nodeCanSupportMultipleEtcdClusters,
6263
nodeReObservesOnChainTxs,
@@ -98,6 +99,8 @@ import HydraNode (
9899
withHydraNode,
99100
withPreparedHydraNode,
100101
)
102+
import Network.HTTP.Conduit (parseUrlThrow)
103+
import Network.HTTP.Simple (getResponseBody, httpJSON)
101104
import System.Directory (removeDirectoryRecursive, removeFile)
102105
import System.FilePath ((</>))
103106
import Test.Hydra.Cluster.Utils (chainPointToSlot)
@@ -419,6 +422,102 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do
419422
send n1 $ input "Fanout" []
420423
waitForAllMatch 10 [n1] $ checkFanout headId u0
421424

425+
it "Head can continue after TxInvalid" $ \tracer ->
426+
-- failAfter 60 $
427+
withClusterTempDir $ \tmpDir -> do
428+
let clusterIx = 0
429+
withBackend (contramap FromCardanoNode tracer) tmpDir $ \_ backend -> do
430+
let nodeSocket' = case Backend.getOptions backend of
431+
Direct DirectOptions{nodeSocket} -> nodeSocket
432+
_ -> error "Unexpected Blockfrost backend"
433+
aliceKeys@(aliceCardanoVk, _) <- generate genKeyPair
434+
bobKeys@(bobCardanoVk, _) <- generate genKeyPair
435+
carolKeys@(carolCardanoVk, _) <- generate genKeyPair
436+
437+
let cardanoKeys = [aliceKeys, bobKeys, carolKeys]
438+
hydraKeys = [aliceSk, bobSk, carolSk]
439+
440+
let firstNodeId = clusterIx * 3
441+
442+
hydraScriptsTxId <- publishHydraScriptsAs backend Faucet
443+
let contestationPeriod = 2
444+
let hydraTracer = contramap FromHydraNode tracer
445+
446+
withHydraCluster hydraTracer tmpDir nodeSocket' firstNodeId cardanoKeys hydraKeys hydraScriptsTxId contestationPeriod $ \nodes -> do
447+
waitForNodesConnected hydraTracer 20 nodes
448+
let [n1, n2, n3] = toList nodes
449+
450+
-- Funds to be used as fuel by Hydra protocol transactions
451+
seedFromFaucet_ backend aliceCardanoVk 100_000_000 (contramap FromFaucet tracer)
452+
seedFromFaucet_ backend bobCardanoVk 100_000_000 (contramap FromFaucet tracer)
453+
seedFromFaucet_ backend carolCardanoVk 100_000_000 (contramap FromFaucet tracer)
454+
455+
send n1 $ input "Init" []
456+
headId <-
457+
waitForAllMatch 10 [n1, n2, n3] $ headIsInitializingWith (Set.fromList [alice, bob, carol])
458+
459+
-- Get some UTXOs to commit to a head
460+
(aliceExternalVk, aliceExternalSk) <- generate genKeyPair
461+
committedUTxOByAlice <- seedFromFaucet backend aliceExternalVk aliceCommittedToHead (contramap FromFaucet tracer)
462+
requestCommitTx n1 committedUTxOByAlice <&> signTx aliceExternalSk >>= Backend.submitTransaction backend
463+
464+
(bobExternalVk, bobExternalSk) <- generate genKeyPair
465+
committedUTxOByBob <- seedFromFaucet backend bobExternalVk bobCommittedToHead (contramap FromFaucet tracer)
466+
requestCommitTx n2 committedUTxOByBob <&> signTx bobExternalSk >>= Backend.submitTransaction backend
467+
468+
requestCommitTx n3 mempty >>= Backend.submitTransaction backend
469+
470+
let u0 = committedUTxOByAlice <> committedUTxOByBob
471+
472+
waitFor hydraTracer 10 [n1, n2, n3] $ output "HeadIsOpen" ["utxo" .= u0, "headId" .= headId]
473+
474+
let firstCommittedUTxO = Prelude.head $ UTxO.toList committedUTxOByBob
475+
let Right tx =
476+
mkSimpleTx
477+
firstCommittedUTxO
478+
(inHeadAddress bobExternalVk, lovelaceToValue paymentFromAliceToBob)
479+
bobExternalSk
480+
481+
let unsign (Tx body _) = Tx body []
482+
483+
send n1 $ input "NewTx" ["transaction" .= unsign tx]
484+
485+
validationError <- waitForAllMatch 10 [n1, n2, n3] $ \v -> do
486+
guard $ v ^? key "tag" == Just "TxInvalid"
487+
v ^? key "validationError" . key "reason" . _JSON
488+
489+
validationError `shouldContain` "MissingVKeyWitnessesUTXOW"
490+
491+
send n3 $ input "NewTx" ["transaction" .= tx]
492+
493+
waitFor hydraTracer 20 [n1, n2, n3] $
494+
output "TxValid" ["transactionId" .= txId tx, "headId" .= headId]
495+
496+
waitForAllMatch 20 [n1, n2, n3] $ \v -> do
497+
guard $ v ^? key "tag" == Just "SnapshotConfirmed"
498+
499+
headUTxO :: UTxO.UTxO <-
500+
parseUrlThrow ("GET " <> hydraNodeBaseUrl n1 <> "/snapshot/utxo")
501+
>>= httpJSON
502+
<&> getResponseBody
503+
504+
send n1 $ input "Close" []
505+
506+
deadline <- waitMatch 3 n1 $ \v -> do
507+
guard $ v ^? key "tag" == Just "HeadIsClosed"
508+
guard $ v ^? key "headId" == Just (toJSON headId)
509+
snapshotNumber <- v ^? key "snapshotNumber"
510+
guard $ snapshotNumber == Aeson.Number 1
511+
v ^? key "contestationDeadline" . _JSON
512+
513+
-- Expect to see ReadyToFanout within 3 seconds after deadline
514+
remainingTime <- diffUTCTime deadline <$> getCurrentTime
515+
waitFor hydraTracer (remainingTime + 3) [n1] $
516+
output "ReadyToFanout" ["headId" .= headId]
517+
518+
send n1 $ input "Fanout" []
519+
waitForAllMatch 10 [n1] $ checkFanout headId headUTxO
520+
422521
it "supports mirror party" $ \tracer ->
423522
failAfter 60 $
424523
withClusterTempDir $ \tmpDir -> do

0 commit comments

Comments
 (0)