Skip to content

Commit

Permalink
wip: adjustments:
Browse files Browse the repository at this point in the history
- wait longer before collecting final Values from wallets
- node waiting ensures some slots are produced before proceed
  • Loading branch information
mikekeke committed Aug 18, 2022
1 parent bbc760e commit 541fabc
Show file tree
Hide file tree
Showing 3 changed files with 22 additions and 9 deletions.
11 changes: 7 additions & 4 deletions src/Test/Plutip/Contract.hs
Original file line number Diff line number Diff line change
Expand Up @@ -276,9 +276,12 @@ maybeAddValuesCheck ioRes tws =
valuesCheckCase =
testCase "Values check" $
ioRes
>>= either (assertFailure . Text.unpack) (const $ pure ())
. checkValues
. outcome
>>= \res -> do
( either (assertFailure . Text.unpack) (const $ pure ())
. checkValues
. outcome
)
res

checkValues o =
left (Text.pack . show) o
Expand Down Expand Up @@ -328,7 +331,7 @@ withContractAs walletIdx toContract = do
-- contract that gets all the values present at the test wallets.
valuesAtWallet :: Contract w s e (NonEmpty Value)
valuesAtWallet =
void (waitNSlots 1)
void (waitNSlots 10)
>> traverse (valueAt . (`pubKeyHashAddress` Nothing)) collectValuesPkhs

-- run the test contract
Expand Down
13 changes: 10 additions & 3 deletions src/Test/Plutip/Internal/LocalCluster.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@ module Test.Plutip.Internal.LocalCluster (
),
) where

import Cardano.Api (ChainTip (ChainTip), SlotNo (SlotNo))
import Cardano.Api qualified as CAPI
import Cardano.BM.Configuration.Model qualified as CM
import Cardano.BM.Data.Severity qualified as Severity
Expand Down Expand Up @@ -233,11 +234,17 @@ checkProcessesAvailable requiredProcesses = do

waitForRelayNode :: Tracer IO TestsLog -> RunningNode -> IO ()
waitForRelayNode trCluster rn = do
liftIO $ recoverAll policy (const getTip)
liftIO $ recoverAll policy wait
where
policy = constantDelay 500000 <> limitRetries 5
getTip = trace >> void (Tools.queryTip rn)
policy = constantDelay 500000 <> limitRetries 50
getTip = trace >> Tools.queryTip rn
trace = traceWith trCluster WaitingRelayNode
wait _ = do
-- give some time for setup
(ChainTip (SlotNo ((> 5) -> True)) _ _) <- getTip
pure ()

-- putStrLn $ "TIP: " ++ show tip

-- | Launch the chain index in a separate thread.
launchChainIndex :: PlutipConfig -> RunningNode -> FilePath -> IO Int
Expand Down
7 changes: 5 additions & 2 deletions test/Spec/Integration.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,7 @@ import Spec.TestContract.SimpleContracts (
payTo,
)
import Spec.TestContract.ValidateTimeRange (failingTimeContract, successTimeContract)
import Test.Plutip.Config (WorkingDirectory (Fixed), clusterWorkingDir)
import Test.Plutip.Contract (
TestWallets,
ValueOrdering (VLt),
Expand Down Expand Up @@ -69,7 +70,7 @@ import Test.Tasty (TestTree)
test :: TestTree
test =
withConfiguredCluster
def
def {clusterWorkingDir = Fixed "/home/mike/dev/dev-tmp/plutip-cluster" True}
"Basic integration: launch, add wallet, tx from wallet to wallet"
$ [
-- Basic Succeed or Failed tests
Expand Down Expand Up @@ -108,6 +109,7 @@ test =
assertExecution
"Pay from wallet to wallet"
(initAda [100] <> initAndAssertAda [100, 13] 123)
-- (initAda [100] <> initAda [100, 13])
(withContract $ \[pkh1] -> payTo pkh1 10_000_000)
[shouldSucceed]
, assertExecution
Expand Down Expand Up @@ -208,7 +210,8 @@ test =
, errorSatisfies "Fail validation with 'I always fail'" errCheck
]
]
++ testValueAssertionsOrderCorrectness

-- ++ testValueAssertionsOrderCorrectness

-- Tests for https://github.com/mlabs-haskell/plutip/issues/84
testValueAssertionsOrderCorrectness ::
Expand Down

0 comments on commit 541fabc

Please sign in to comment.