Skip to content

Commit 6b676f4

Browse files
wenkokkejorisdral
wenkokke
authored and
jorisdral
committed
feat(lsm-tree-tests): add salt
1 parent 3c80749 commit 6b676f4

File tree

17 files changed

+185
-69
lines changed

17 files changed

+185
-69
lines changed

‎test/Database/LSMTree/Class/Common.hs‎

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,8 @@ module Database.LSMTree.Class.Common (
55
, IsSession (..)
66
, SessionArgs (..)
77
, withSession
8+
, testSalt
9+
, testSessionSalt
810
, module Types
911
) where
1012

@@ -17,6 +19,7 @@ import Database.LSMTree as Types (IOLike, Range (..), SerialiseKey,
1719
SerialiseValue, SnapshotLabel (..), SnapshotName,
1820
UnionCredits (..), UnionDebt (..))
1921
import qualified Database.LSMTree as R
22+
import Database.LSMTree.Internal.Paths (SessionSalt (..))
2023
import System.FS.API (FsPath, HasFS)
2124
import System.FS.BlockIO.API (HasBlockIO)
2225

@@ -77,6 +80,12 @@ withSession seshArgs = bracket (openSession seshArgs) closeSession
7780
Real instance
7881
-------------------------------------------------------------------------------}
7982

83+
testSalt :: R.Salt
84+
testSalt = 4
85+
86+
testSessionSalt :: SessionSalt
87+
testSessionSalt = SessionSalt testSalt
88+
8089
instance IsSession R.Session where
8190
data SessionArgs R.Session m where
8291
SessionArgs ::
@@ -85,7 +94,7 @@ instance IsSession R.Session where
8594
-> SessionArgs R.Session m
8695

8796
openSession (SessionArgs hfs hbio dir) = do
88-
R.openSession nullTracer hfs hbio dir
97+
R.openSession nullTracer hfs hbio testSalt dir
8998
closeSession = R.closeSession
9099
deleteSnapshot = R.deleteSnapshot
91100
listSnapshots = R.listSnapshots

‎test/Test/Database/LSMTree/Generators.hs‎

Lines changed: 12 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -19,13 +19,15 @@ import qualified Database.LSMTree.Internal.Index as Index
1919
import qualified Database.LSMTree.Internal.MergingRun as MR
2020
import Database.LSMTree.Internal.PageAcc (entryWouldFitInPage,
2121
sizeofEntry)
22-
import Database.LSMTree.Internal.Paths (RunFsPaths (..))
22+
import Database.LSMTree.Internal.Paths (RunFsPaths (..),
23+
SessionSalt (..))
2324
import Database.LSMTree.Internal.RawBytes (RawBytes (..))
2425
import qualified Database.LSMTree.Internal.RawBytes as RB
2526
import qualified Database.LSMTree.Internal.RunAcc as RunAcc
2627
import qualified Database.LSMTree.Internal.RunBuilder as RunBuilder
2728
import Database.LSMTree.Internal.RunNumber (RunNumber (..))
2829
import Database.LSMTree.Internal.Serialise
30+
import Database.LSMTree.Internal.Types (Salt)
2931
import Database.LSMTree.Internal.UniqCounter
3032
import qualified System.FS.API as FS
3133
import qualified System.FS.BlockIO.API as FS
@@ -108,6 +110,12 @@ tests = testGroup "Test.Database.LSMTree.Generators" [
108110
]
109111
]
110112

113+
testSalt :: Salt
114+
testSalt = 5
115+
116+
testSessionSalt :: SessionSalt
117+
testSessionSalt = SessionSalt testSalt
118+
111119
runParams :: Index.IndexType -> RunBuilder.RunParams
112120
runParams indexType =
113121
RunBuilder.RunParams {
@@ -162,7 +170,7 @@ prop_withRunDoesntLeak hfs hbio rd = do
162170
let path = FS.mkFsPath ["something-1"]
163171
let fsPaths = RunFsPaths path (RunNumber 0)
164172
FS.createDirectory hfs path
165-
withRunAt hfs hbio (runParams indexType) fsPaths rd $ \_run -> do
173+
withRunAt hfs hbio testSessionSalt (runParams indexType) fsPaths rd $ \_run -> do
166174
pure (QC.property True)
167175

168176
prop_withMergingRunDoesntLeak ::
@@ -175,7 +183,7 @@ prop_withMergingRunDoesntLeak hfs hbio mrd = do
175183
let path = FS.mkFsPath ["something-2"]
176184
FS.createDirectory hfs path
177185
counter <- newUniqCounter 0
178-
withMergingRun hfs hbio resolveVal (runParams indexType) path counter mrd $
186+
withMergingRun hfs hbio resolveVal testSessionSalt (runParams indexType) path counter mrd $
179187
\_mr -> do
180188
pure (QC.property True)
181189

@@ -191,7 +199,7 @@ prop_withMergingTreeDoesntLeak hfs hbio mrd = do
191199
let path = FS.mkFsPath ["something-3"]
192200
FS.createDirectory hfs path
193201
counter <- newUniqCounter 0
194-
withMergingTree hfs hbio resolveVal (runParams indexType) path counter mrd $
202+
withMergingTree hfs hbio resolveVal testSessionSalt (runParams indexType) path counter mrd $
195203
\_tree -> do
196204
pure (QC.property True)
197205

‎test/Test/Database/LSMTree/Internal.hs‎

Lines changed: 13 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ import Database.LSMTree.Internal.BlobRef
2121
import Database.LSMTree.Internal.Config
2222
import Database.LSMTree.Internal.Entry
2323
import Database.LSMTree.Internal.Serialise
24+
import Database.LSMTree.Internal.Types (Salt)
2425
import Database.LSMTree.Internal.Unsafe
2526
import qualified System.FS.API as FS
2627
import Test.QuickCheck
@@ -44,6 +45,10 @@ tests = testGroup "Test.Database.LSMTree.Internal" [
4445
]
4546
]
4647

48+
49+
testSalt :: Salt
50+
testSalt = 6
51+
4752
testTableConfig :: TableConfig
4853
testTableConfig = defaultTableConfig {
4954
-- Write buffer size is small on purpose, so that the test actually
@@ -58,7 +63,7 @@ newSession ::
5863
newSession (Positive (Small bufferSize)) es =
5964
ioProperty $
6065
withTempIOHasBlockIO "newSession" $ \hfs hbio ->
61-
withSession nullTracer hfs hbio (FS.mkFsPath []) $ \session ->
66+
withSession nullTracer hfs hbio testSalt (FS.mkFsPath []) $ \session ->
6267
withTable session conf (updates const es')
6368
where
6469
conf = testTableConfig {
@@ -73,9 +78,9 @@ restoreSession ::
7378
restoreSession (Positive (Small bufferSize)) es =
7479
ioProperty $
7580
withTempIOHasBlockIO "restoreSession" $ \hfs hbio -> do
76-
withSession nullTracer hfs hbio (FS.mkFsPath []) $ \session1 ->
81+
withSession nullTracer hfs hbio testSalt (FS.mkFsPath []) $ \session1 ->
7782
withTable session1 conf (updates const es')
78-
withSession nullTracer hfs hbio (FS.mkFsPath []) $ \session2 ->
83+
withSession nullTracer hfs hbio testSalt (FS.mkFsPath []) $ \session2 ->
7984
withTable session2 conf (updates const es')
8085
where
8186
conf = testTableConfig {
@@ -86,8 +91,8 @@ restoreSession (Positive (Small bufferSize)) es =
8691
sessionDirLocked :: Property
8792
sessionDirLocked = ioProperty $
8893
withTempIOHasBlockIO "sessionDirLocked" $ \hfs hbio -> do
89-
bracket (openSession nullTracer hfs hbio (FS.mkFsPath [])) closeSession $ \_sesh1 ->
90-
bracket (try @SessionDirLockedError $ openSession nullTracer hfs hbio (FS.mkFsPath [])) tryCloseSession $ \case
94+
bracket (openSession nullTracer hfs hbio testSalt (FS.mkFsPath [])) closeSession $ \_sesh1 ->
95+
bracket (try @SessionDirLockedError $ openSession nullTracer hfs hbio testSalt (FS.mkFsPath [])) tryCloseSession $ \case
9196
Left (ErrSessionDirLocked _dir) -> pure ()
9297
x -> assertFailure $ "Opening a session twice in the same directory \
9398
\should fail with an ErrSessionDirLocked error, but \
@@ -97,15 +102,15 @@ sessionDirCorrupted :: Assertion
97102
sessionDirCorrupted =
98103
withTempIOHasBlockIO "sessionDirCorrupted" $ \hfs hbio -> do
99104
FS.createDirectory hfs (FS.mkFsPath ["unexpected-directory"])
100-
bracket (try @SessionDirCorruptedError (openSession nullTracer hfs hbio (FS.mkFsPath []))) tryCloseSession $ \case
105+
bracket (try @SessionDirCorruptedError (openSession nullTracer hfs hbio testSalt (FS.mkFsPath []))) tryCloseSession $ \case
101106
Left (ErrSessionDirCorrupted _dir) -> pure ()
102107
x -> assertFailure $ "Restoring a session in a directory with a wrong \
103108
\layout should fail with a ErrSessionDirCorrupted, but \
104109
\it returned this instead: " <> showLeft "Session" x
105110

106111
sessionDirDoesNotExist :: Assertion
107112
sessionDirDoesNotExist = withTempIOHasBlockIO "sessionDirDoesNotExist" $ \hfs hbio -> do
108-
bracket (try @SessionDirDoesNotExistError (openSession nullTracer hfs hbio (FS.mkFsPath ["missing-dir"]))) tryCloseSession $ \case
113+
bracket (try @SessionDirDoesNotExistError (openSession nullTracer hfs hbio testSalt (FS.mkFsPath ["missing-dir"]))) tryCloseSession $ \case
109114
Left (ErrSessionDirDoesNotExist _dir) -> pure ()
110115
x -> assertFailure $ "Opening a session in a non-existent directory should \
111116
\fail with a ErrSessionDirDoesNotExist error, but it \
@@ -140,7 +145,7 @@ prop_roundtripCursor ::
140145
-> Property
141146
prop_roundtripCursor lb ub kops = ioProperty $
142147
withTempIOHasBlockIO "prop_roundtripCursor" $ \hfs hbio -> do
143-
withSession nullTracer hfs hbio (FS.mkFsPath []) $ \sesh -> do
148+
withSession nullTracer hfs hbio testSalt (FS.mkFsPath []) $ \sesh -> do
144149
withTable sesh conf $ \t -> do
145150
updates resolve (coerce kops) t
146151
fromCursor <- withCursor resolve (toOffsetKey lb) t $ \c ->

‎test/Test/Database/LSMTree/Internal/BloomFilter.hs‎

Lines changed: 11 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,10 @@ import Test.QuickCheck.Instances ()
2323
import Test.Tasty (TestTree, testGroup)
2424
import Test.Tasty.QuickCheck hiding ((.&.))
2525

26+
import Data.BloomFilter.Blocked (Salt)
2627
import qualified Data.BloomFilter.Blocked as Bloom
2728
import Database.LSMTree.Internal.BloomFilter
29+
import Database.LSMTree.Internal.Paths (SessionSalt (..))
2830
import Database.LSMTree.Internal.Serialise (SerialisedKey,
2931
serialiseKey)
3032

@@ -43,6 +45,12 @@ tests = testGroup "Database.LSMTree.Internal.BloomFilter"
4345
prop_bloomQueries
4446
]
4547

48+
testSalt :: Salt
49+
testSalt = 5
50+
51+
testSessionSalt :: SessionSalt
52+
testSessionSalt = SessionSalt testSalt
53+
4654
roundtrip_prop :: Positive (Small Int) -> Positive Int -> [Word64] -> Property
4755
roundtrip_prop (Positive (Small hfN)) (Positive bits) ws =
4856
counterexample (show bs) $
@@ -52,7 +60,7 @@ roundtrip_prop (Positive (Small hfN)) (Positive bits) ws =
5260
where
5361
sz = Bloom.BloomSize { sizeBits = limitBits bits,
5462
sizeHashes = hfN }
55-
lhs = Bloom.create sz (\b -> mapM_ (Bloom.insert b) ws)
63+
lhs = Bloom.create sz testSalt (\b -> mapM_ (Bloom.insert b) ws)
5664
bs = LBS.toStrict (bloomFilterToLBS lhs)
5765

5866
limitBits :: Int -> Int
@@ -116,7 +124,7 @@ prop_bloomQueries :: FPR
116124
-> Property
117125
prop_bloomQueries (FPR fpr) filters keys =
118126
let filters' :: [Bloom SerialisedKey]
119-
filters' = map (Bloom.fromList (Bloom.policyForFPR fpr)
127+
filters' = map (Bloom.fromList (Bloom.policyForFPR fpr) testSalt
120128
. map (\(Small k) -> serialiseKey k))
121129
filters
122130

@@ -152,5 +160,4 @@ prop_bloomQueries (FPR fpr) filters keys =
152160
referenceResults
153161
===
154162
map (\(RunIxKeyIx rix kix) -> (rix, kix))
155-
(VP.toList (bloomQueries (V.fromList filters')
156-
(V.fromList keys')))
163+
(VP.toList (bloomQueries testSessionSalt (V.fromList filters') (V.fromList keys')))

‎test/Test/Database/LSMTree/Internal/Lookup.hs‎

Lines changed: 14 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,7 @@ import qualified Database.LSMTree.Internal.Index as Index (IndexType (Ordinary),
5353
search)
5454
import Database.LSMTree.Internal.Lookup
5555
import Database.LSMTree.Internal.Page (PageNo (PageNo), PageSpan (..))
56+
import Database.LSMTree.Internal.Paths
5657
import qualified Database.LSMTree.Internal.RawBytes as RB
5758
import Database.LSMTree.Internal.RawOverflowPage
5859
import Database.LSMTree.Internal.RawPage
@@ -62,6 +63,7 @@ import Database.LSMTree.Internal.RunBuilder
6263
(RunDataCaching (CacheRunData), RunParams (RunParams))
6364
import Database.LSMTree.Internal.Serialise
6465
import Database.LSMTree.Internal.Serialise.Class
66+
import Database.LSMTree.Internal.Types
6567
import Database.LSMTree.Internal.UniqCounter
6668
import qualified Database.LSMTree.Internal.WriteBuffer as WB
6769
import qualified Database.LSMTree.Internal.WriteBufferBlobs as WBB
@@ -123,6 +125,12 @@ runParams indexType =
123125
runParamIndex = indexType
124126
}
125127

128+
testSalt :: Salt
129+
testSalt = 17
130+
131+
testSessionSalt :: SessionSalt
132+
testSessionSalt = SessionSalt testSalt
133+
126134
{-------------------------------------------------------------------------------
127135
Models
128136
-------------------------------------------------------------------------------}
@@ -141,7 +149,7 @@ prop_bloomQueriesModel dats =
141149
blooms = fmap snd3 runs
142150
lookupss = concatMap lookups $ getSmallList dats
143151
real = map (\(RunIxKeyIx rix kix) -> (rix,kix)) $ VP.toList $
144-
bloomQueries (V.fromList blooms) (V.fromList lookupss)
152+
bloomQueries testSessionSalt (V.fromList blooms) (V.fromList lookupss)
145153
model = bloomQueriesModel (fmap Map.keysSet runDatas) lookupss
146154

147155
-- | A bloom filter is a probablistic set that can return false positives, but
@@ -204,6 +212,7 @@ prop_prepLookupsModel dats = real === model
204212
ks = V.fromList lookupss
205213
(kixs, ioops) <- prepLookups
206214
arena
215+
testSessionSalt
207216
(V.map snd3 rs)
208217
(V.map thrd3 rs)
209218
(V.map fst3 rs) ks
@@ -245,6 +254,7 @@ prop_inMemRunLookupAndConstruction dat =
245254
(kixs, ioops) <- let r = V.singleton (runWithHandle run)
246255
in prepLookups
247256
arena
257+
testSessionSalt
248258
(V.map snd3 r)
249259
(V.map thrd3 r)
250260
(V.map fst3 r)
@@ -332,6 +342,7 @@ prop_roundtripFromWriteBufferLookupIO (SmallList dats) =
332342
hbio
333343
arenaManager
334344
resolveV
345+
testSessionSalt
335346
wb wbblobs
336347
runs
337348
(V.map (\(DeRef r) -> Run.runFilter r) runs)
@@ -374,7 +385,7 @@ withWbAndRuns hfs hbio indexType (wbdat:rundats) action =
374385
let wb = WB.fromMap wbkops
375386
let rds = map (RunData . runData) rundats
376387
counter <- newUniqCounter 1
377-
withRuns hfs hbio (runParams indexType) (FS.mkFsPath []) counter rds $
388+
withRuns hfs hbio testSessionSalt (runParams indexType) (FS.mkFsPath []) counter rds $
378389
\runs ->
379390
action wb wbblobs (V.fromList runs)
380391

@@ -443,7 +454,7 @@ mkTestRun dat = (rawPages, b, ic)
443454

444455
-- one-shot run construction
445456
(pages, b, ic) = runST $ do
446-
racc <- Run.new nentries (RunAllocFixed 10) Index.Ordinary
457+
racc <- Run.new nentries (RunAllocFixed 10) testSessionSalt Index.Ordinary
447458
let kops = Map.toList dat
448459
psopss <- traverse (uncurry (Run.addKeyOp racc)) kops
449460
(mp, _ , b', ic', _) <- Run.unsafeFinalise racc

‎test/Test/Database/LSMTree/Internal/Merge.hs‎

Lines changed: 14 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -18,12 +18,13 @@ import Database.LSMTree.Internal.Merge (MergeType (..))
1818
import qualified Database.LSMTree.Internal.Merge as Merge
1919
import Database.LSMTree.Internal.PageAcc (entryWouldFitInPage)
2020
import Database.LSMTree.Internal.Paths (RunFsPaths (..),
21-
pathsForRunFiles)
21+
SessionSalt (..), pathsForRunFiles)
2222
import qualified Database.LSMTree.Internal.Run as Run
2323
import qualified Database.LSMTree.Internal.RunAcc as RunAcc
2424
import qualified Database.LSMTree.Internal.RunBuilder as RunBuilder
2525
import Database.LSMTree.Internal.RunNumber
2626
import Database.LSMTree.Internal.Serialise
27+
import Database.LSMTree.Internal.Types (Salt)
2728
import Database.LSMTree.Internal.UniqCounter
2829
import qualified System.FS.API as FS
2930
import qualified System.FS.API.Lazy as FS
@@ -67,6 +68,12 @@ runParams =
6768
runParamIndex = Index.Ordinary
6869
}
6970

71+
testSalt :: Salt
72+
testSalt = 17
73+
74+
testSessionSalt :: SessionSalt
75+
testSessionSalt = SessionSalt testSalt
76+
7077
-- | Creating multiple runs from write buffers and merging them leads to the
7178
-- same run as merging the write buffers and creating a run.
7279
--
@@ -81,13 +88,13 @@ prop_MergeDistributes ::
8188
prop_MergeDistributes fs hbio mergeType stepSize (SmallList rds) = do
8289
let path = FS.mkFsPath []
8390
counter <- newUniqCounter 0
84-
withRuns fs hbio runParams path counter rds' $ \runs -> do
91+
withRuns fs hbio testSessionSalt runParams path counter rds' $ \runs -> do
8592
let stepsNeeded = sum (map (Map.size . unRunData) rds)
8693

8794
fsPathLhs <- RunFsPaths path . uniqueToRunNumber <$> incrUniqCounter counter
8895
(stepsDone, lhs) <- mergeRuns fs hbio mergeType stepSize fsPathLhs runs
8996
let runData = RunData $ mergeWriteBuffers mergeType $ fmap unRunData rds'
90-
withRun fs hbio runParams path counter runData $ \rhs -> do
97+
withRun fs hbio testSessionSalt runParams path counter runData $ \rhs -> do
9198

9299
(lhsSize, lhsFilter, lhsIndex, lhsKOps,
93100
lhsKOpsFileContent, lhsBlobFileContent) <- getRunContent lhs
@@ -159,7 +166,7 @@ prop_AbortMerge fs hbio mergeType (Positive stepSize) (SmallList wbs) = do
159166
let path = FS.mkFsPath []
160167
let pathOut = RunFsPaths path (RunNumber 0)
161168
counter <- newUniqCounter 1
162-
withRuns fs hbio runParams path counter wbs' $ \runs -> do
169+
withRuns fs hbio testSessionSalt runParams path counter wbs' $ \runs -> do
163170
mergeToClose <- makeInProgressMerge pathOut runs
164171
traverse_ Merge.abort mergeToClose
165172

@@ -172,7 +179,7 @@ prop_AbortMerge fs hbio mergeType (Positive stepSize) (SmallList wbs) = do
172179
wbs' = fmap serialiseRunData wbs
173180

174181
makeInProgressMerge path runs =
175-
Merge.new fs hbio runParams mergeType resolveVal
182+
Merge.new fs hbio testSessionSalt runParams mergeType resolveVal
176183
path (V.fromList runs) >>= \case
177184
Nothing -> pure Nothing -- not in progress
178185
Just merge -> do
@@ -199,11 +206,11 @@ mergeRuns ::
199206
[Ref (Run.Run IO h)] ->
200207
IO (Int, Ref (Run.Run IO h))
201208
mergeRuns fs hbio mergeType (Positive stepSize) fsPath runs = do
202-
Merge.new fs hbio runParams mergeType resolveVal
209+
Merge.new fs hbio testSessionSalt runParams mergeType resolveVal
203210
fsPath (V.fromList runs)
204211
>>= \case
205212
Just m -> Merge.stepsToCompletionCounted m stepSize
206-
Nothing -> (,) 0 <$> unsafeCreateRunAt fs hbio runParams fsPath
213+
Nothing -> (,) 0 <$> unsafeCreateRunAt fs hbio testSessionSalt runParams fsPath
207214
(RunData Map.empty)
208215

209216
type SerialisedEntry = Entry.Entry SerialisedValue SerialisedBlob

0 commit comments

Comments
 (0)