Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

simplify the LSQ server test #937

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Original file line number Diff line number Diff line change
Expand Up @@ -78,25 +78,29 @@ tests = testGroup "LocalStateQueryServer"
-- chain, a state and send the 'QueryLedgerTip'. Collect these results.
-- * Check that when acquiring failed, it rightfully failed. Otherwise, check
-- whether the returned tip matches the block.
prop_localStateQueryServer
:: SecurityParam
prop_localStateQueryServer ::
SecurityParam
-> BlockTree
-> Permutation
-> Positive (Small Int)
-> Property
prop_localStateQueryServer k bt p (Positive (Small n)) = checkOutcome k chain actualOutcome
prop_localStateQueryServer k bt p = checkOutcome k chain actualOutcome
where
chain :: Chain TestBlock
chain = treePreferredChain bt

points :: [Target (Point TestBlock)]
points = permute p $
replicate n VolatileTip
++ (SpecificPoint . blockPoint <$> treeToBlocks bt)
-- A random sequence of targets: one for each block in the tree and also a
-- random number of immtip/voltip queries
Comment on lines +91 to +92
Copy link
Member

@amesgen amesgen Feb 5, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

A random sequence of targets: one for each block in the tree and also a random number of immtip/voltip queries

Isn't the change that is explained in the PR description exactly about removing the fact that there is a random number of voltip queries, instead just using one?

--
-- The fact that the queries are ordered /shouldn't/ ultimately matter,
-- since the server has selected the same chain the entire time.
targets :: [Target (Point TestBlock)]
targets = permute p $
VolatileTip
: ImmutableTip
: (SpecificPoint . blockPoint <$> treeToBlocks bt)

actualOutcome :: [(Target (Point TestBlock), Either AcquireFailure (Point TestBlock))]
actualOutcome = runSimOrThrow $ do
let client = mkClient points
let client = mkClient targets
server <- mkServer k chain
(\(a, _, _) -> a) <$>
connect
Expand Down Expand Up @@ -128,8 +132,8 @@ checkOutcome k chain = conjoin . map (uncurry checkResult)
immutableSlot = Chain.headSlot $
Chain.drop (fromIntegral (maxRollbacks k)) chain

checkResult
:: Target (Point TestBlock)
checkResult ::
Target (Point TestBlock)
-> Either AcquireFailure (Point TestBlock)
-> Property
checkResult (SpecificPoint pt) = \case
Expand All @@ -144,7 +148,7 @@ checkOutcome k chain = conjoin . map (uncurry checkResult)
| otherwise
-> tabulate "Acquired" ["AcquireFailurePointNotOnChain"] $ property True
Left AcquireFailurePointTooOld
| pointSlot pt >= immutableSlot
| pointSlot pt >= immutableSlot -- TODO what if the immtip is a multi-leader slot?
Copy link
Member

@amesgen amesgen Feb 5, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

When we ask for a point with the same slot as the immutable tip, but with a different hash, we get a AcquireFailurePointNotOnChain, right?

Nothing
| pointSlot pt < pointSlot immutablePoint
-> SendMsgFailure AcquireFailurePointTooOld idle
| otherwise
-> SendMsgFailure AcquireFailurePointNotOnChain idle

-> counterexample
("Point " <> show pt <>
" newer than the immutable tip, but got AcquireFailurePointTooOld")
Expand All @@ -153,21 +157,21 @@ checkOutcome k chain = conjoin . map (uncurry checkResult)
-> tabulate "Acquired" ["AcquireFailurePointTooOld"] $ property True
checkResult VolatileTip = \case
Right _result -> tabulate "Acquired" ["Success"] True
Left failure -> counterexample ("acquire tip point resulted in " ++ show failure) False
Left failure -> counterexample ("Acquiring the volatile tip resulted in " ++ show failure) False
checkResult ImmutableTip = \case
Right _result -> tabulate "Acquired" ["Success"] True
Left failure -> counterexample ("acquire tip point resulted in " ++ show failure) False
Left failure -> counterexample ("Acquiring the immutable tip resulted in " ++ show failure) False

mkClient
:: Monad m
mkClient ::
Monad m
=> [Target (Point TestBlock)]
-> LocalStateQueryClient
TestBlock
(Point TestBlock)
(Query TestBlock)
m
[(Target (Point TestBlock), Either AcquireFailure (Point TestBlock))]
mkClient points = localStateQueryClient [(pt, BlockQuery QueryLedgerTip) | pt <- points]
mkClient targets = localStateQueryClient [(tgt, BlockQuery QueryLedgerTip) | tgt <- targets]

mkServer ::
IOLike m
Expand Down
Loading