Skip to content

Commit 6fbee36

Browse files
jorisdraljorisdral
committed
WIP: add a test with good and bad salts
1 parent e29e17d commit 6fbee36

File tree

4 files changed

+139
-1
lines changed

4 files changed

+139
-1
lines changed

‎lsm-tree.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -771,6 +771,7 @@ test-suite lsm-tree-test
771771
Database.LSMTree.Model.IO
772772
Database.LSMTree.Model.Session
773773
Database.LSMTree.Model.Table
774+
Test.Database.LSMTree
774775
Test.Database.LSMTree.Class
775776
Test.Database.LSMTree.Generators
776777
Test.Database.LSMTree.Internal

‎src-extras/Database/LSMTree/Extras.hs‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
module Database.LSMTree.Extras (
22
showPowersOf10
33
, showPowersOf
4+
, showRangesOf
45
, groupsOfN
56
, vgroupsOfN
67
) where
@@ -26,6 +27,17 @@ showPowersOf factor n
2627
ub = fromJust (find (n <) (iterate (* factor) factor))
2728
lb = ub `div` factor
2829

30+
showRangesOf :: Int -> Int -> String
31+
showRangesOf range n
32+
| range <= 0 = error "showRangesOf: range must be larger than 0"
33+
| n == 0 = "n == 0"
34+
| m == 0 = printf "%d < n < %d" lb ub
35+
| otherwise = printf "%d <= n < %d" lb ub
36+
where
37+
m = n `div` range
38+
lb = m * range
39+
ub = (m + 1) * range
40+
2941
-- | Make groups of @n@ elements from a list @xs@
3042
groupsOfN :: Int -> [a] -> [NonEmpty a]
3143
groupsOfN n

‎test/Main.hs‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ module Main (main) where
44

55
import qualified Control.RefCount
66

7+
import qualified Test.Database.LSMTree
78
import qualified Test.Database.LSMTree.Class
89
import qualified Test.Database.LSMTree.Generators
910
import qualified Test.Database.LSMTree.Internal
@@ -51,7 +52,8 @@ import Test.Tasty
5152
main :: IO ()
5253
main = do
5354
defaultMain $ testGroup "lsm-tree"
54-
[ Test.Database.LSMTree.Internal.Arena.tests
55+
[ Test.Database.LSMTree.tests
56+
, Test.Database.LSMTree.Internal.Arena.tests
5557
, Test.Database.LSMTree.Class.tests
5658
, Test.Database.LSMTree.Generators.tests
5759
, Test.Database.LSMTree.Internal.tests

‎test/Test/Database/LSMTree.hs‎

Lines changed: 123 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,123 @@
1+
{-# LANGUAGE LambdaCase #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE RecordWildCards #-}
4+
5+
module Test.Database.LSMTree (tests) where
6+
7+
import Control.Tracer
8+
import Data.Function (on)
9+
import Data.Monoid
10+
import qualified Data.Vector as V
11+
import qualified Data.Vector.Algorithms as VA
12+
import Data.Void
13+
import Data.Word
14+
import Database.LSMTree
15+
import Database.LSMTree.Extras (showRangesOf)
16+
import Database.LSMTree.Extras.Generators ()
17+
import qualified System.FS.API as FS
18+
import Test.QuickCheck
19+
import Test.Tasty
20+
import Test.Tasty.QuickCheck
21+
import Test.Util.FS
22+
23+
tests :: TestTree
24+
tests = testGroup "Test.Database.LSMTree" [
25+
testProperty "prop_goodAndBandSessionSalt" prop_goodAndBandSessionSalt
26+
]
27+
28+
-- | For now, the session salt is always set by the user when opening a session.
29+
-- This is fine for new sessions, because there is no data in the session
30+
-- directory yet, but if the user passes the wrong salt when restoring a
31+
-- session, then bad things can happen. In particular, bloom filters stored in a
32+
-- snapshot might have been created with one salt, but if we query them with a
33+
-- different salt, then the query results are bad. This test verifies that
34+
-- reopening a session and snapshot with a good salt leads to good lookup
35+
-- results, and it verifies that doign the same with a bad salt leads to bad
36+
-- lookup results.
37+
--
38+
-- NOTE: this only tests with /positive/ lookups, i.e., lookups for keys that
39+
-- are known to exist in the tables.
40+
--
41+
-- TODO: store the session salt in the session directory, so that the user can
42+
-- not set a bad salt.
43+
prop_goodAndBandSessionSalt ::
44+
Positive (Small Int)
45+
-> V.Vector (Key, Value)
46+
-> Property
47+
prop_goodAndBandSessionSalt (Positive (Small bufferSize)) ins =
48+
checkCoverage $
49+
ioProperty $
50+
withTempIOHasBlockIO "prop_sessionSalt" $ \hfs hbio -> do
51+
-- Open a session and create a snapshot for some arbitrary table contents
52+
withSession nullTracer hfs hbio goodSalt sessionDir $ \session ->
53+
withTableWith conf session $ \(table :: Table IO Key Value Void) -> do
54+
inserts table $ V.map (\(k, v) -> (k, v, Nothing)) insWithoutDupKeys
55+
saveSnapshot "snap" "KeyValueBlob" table
56+
57+
-- Determine the expected results of key lookups
58+
let
59+
expectedValues :: V.Vector (Maybe Value)
60+
expectedValues = V.map (Just . snd) insWithoutDupKeys
61+
62+
-- Restore the session using the good salt, open the snapshot, perform lookups
63+
goodLookups <-
64+
withSession nullTracer hfs hbio goodSalt sessionDir $ \session ->
65+
withTableFromSnapshot session "snap" "KeyValueBlob" $ \(table :: Table IO Key Value Void) -> do
66+
lookups table $ V.map fst insWithoutDupKeys
67+
68+
-- Determine the result of key lookups using the good salt
69+
let
70+
goodValues :: V.Vector (Maybe Value)
71+
goodValues = V.map getValue goodLookups
72+
73+
-- Restore the session using a bad salt, open the snapshot, perform lookups
74+
badLookups <-
75+
withSession nullTracer hfs hbio badSalt sessionDir $ \session ->
76+
withTableFromSnapshot session "snap" "KeyValueBlob" $ \(table :: Table IO Key Value Void) -> do
77+
lookups table $ V.map fst insWithoutDupKeys
78+
79+
-- Determine the result of key lookups using a bad salt
80+
let
81+
badValues :: V.Vector (Maybe Value)
82+
badValues = V.map getValue badLookups
83+
84+
pure $
85+
tabulate "number of keys" [ showRangesOf 10 (V.length insWithoutDupKeys) ] $
86+
-- For a significant portion of the cases, the lookups results obtained
87+
-- using a bad salt should mismatch the expected lookup results
88+
cover 40 ( expectedValues /= badValues ) "bad salt leads to bad lookups" $
89+
-- The lookup results using a bad salt should /always/ match the
90+
-- expected lookup results.
91+
expectedValues === goodValues
92+
where
93+
-- Duplicate keys in inserts make the property more complicated, because
94+
-- keys that are inserted /earlier/ (towards the head of the vector) are
95+
-- overridden by keys that are inserted /later/ (towards the tail of the
96+
-- vector). So, we remove duplicate keys instead
97+
insWithoutDupKeys :: V.Vector (Key, Value)
98+
insWithoutDupKeys = VA.nubBy (compare `on` fst) ins
99+
100+
goodSalt :: Salt
101+
goodSalt = 17
102+
103+
badSalt :: Salt
104+
badSalt = 19
105+
106+
sessionDir = FS.mkFsPath []
107+
108+
conf = defaultTableConfig {
109+
confWriteBufferAlloc = AllocNumEntries bufferSize
110+
}
111+
112+
newtype Key = Key Word64
113+
deriving stock (Show, Eq, Ord)
114+
deriving newtype (Arbitrary, SerialiseKey)
115+
116+
newtype Value = Value Word64
117+
deriving stock (Show, Eq)
118+
deriving newtype (Arbitrary, SerialiseValue)
119+
deriving ResolveValue via Sum Word64
120+
121+
newtype Blob = Blob Void
122+
deriving stock (Show, Eq)
123+
deriving newtype SerialiseValue

0 commit comments

Comments
 (0)