Skip to content

Commit a0b1abc

Browse files
authored
Merge pull request #442 from IntersectMBO/jdral/snapshot-metadata
Define snapshot versioning and metadata
2 parents 336f38e + 9a9adc5 commit a0b1abc

File tree

11 files changed

+151
-23
lines changed

11 files changed

+151
-23
lines changed

lsm-tree.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -179,6 +179,7 @@ library
179179
, lsm-tree:kmerge
180180
, lsm-tree:monkey
181181
, primitive ^>=0.9
182+
, text ^>=2.1.1
182183
, vector ^>=0.13
183184
, vector-algorithms ^>=0.9
184185

src/Database/LSMTree/Common.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,6 @@ module Database.LSMTree.Common (
1818
-- * Small types
1919
, Internal.Range (..)
2020
-- * Snapshots
21-
, Internal.SnapshotLabel
2221
, Labellable (..)
2322
, deleteSnapshot
2423
, listSnapshots
@@ -54,6 +53,7 @@ import Control.Monad.Fix (MonadFix)
5453
import Control.Monad.Primitive (PrimMonad)
5554
import Control.Tracer (Tracer)
5655
import Data.Kind (Type)
56+
import Data.Text (Text)
5757
import Data.Typeable (Proxy, Typeable)
5858
import qualified Database.LSMTree.Internal as Internal
5959
import qualified Database.LSMTree.Internal.BlobRef as Internal
@@ -192,7 +192,7 @@ closeSession (Internal.Session' sesh) = Internal.closeSession sesh
192192
-- directly instead, instead of deriving the label from a type using this type
193193
-- class.
194194
class Labellable a where
195-
makeSnapshotLabel :: Proxy a -> Internal.SnapshotLabel
195+
makeSnapshotLabel :: Proxy a -> Text
196196

197197
{-# SPECIALISE deleteSnapshot ::
198198
Session IO

src/Database/LSMTree/Internal.hs

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1077,12 +1077,10 @@ readCursorWhile resolve keyIsWanted n Cursor {..} fromEntry = do
10771077
Snapshots
10781078
-------------------------------------------------------------------------------}
10791079

1080-
type SnapshotLabel = String
1081-
10821080
{-# SPECIALISE snapshot ::
10831081
ResolveSerialisedValue
10841082
-> SnapshotName
1085-
-> String
1083+
-> SnapshotLabel
10861084
-> Table IO h
10871085
-> IO Int #-}
10881086
-- | See 'Database.LSMTree.Normal.snapshot''.

src/Database/LSMTree/Internal/Config.hs

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -262,7 +262,10 @@ bloomFilterAllocForLevel conf (LevelNo l) =
262262
(fromIntegralChecked n)
263263
(fromIntegralChecked sr)
264264
levelCount
265-
in case allocPerLevel !? (l - 1) of
265+
in -- TODO: monkey-style allocation does not currently work as
266+
-- expected, so it is disabled for now.
267+
error "boomFilterAllocForLevel: monkey allocation temporarily disabled" $
268+
case allocPerLevel !? (l - 1) of
266269
-- Default to an empty bloom filter in case the level wasn't
267270
-- accounted for. See 'AllocMonkey'.
268271
Nothing -> RunAllocMonkey 0

src/Database/LSMTree/Internal/Snapshot.hs

Lines changed: 122 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,18 @@
22
{-# OPTIONS_GHC -Wno-orphans #-}
33

44
module Database.LSMTree.Internal.Snapshot (
5+
-- * Versioning
6+
SnapshotVersion (..)
7+
, major
8+
, minor
9+
, fromMajorMinor
10+
, prettySnapshotVersion
11+
, currentSnapshotVersion
12+
-- * Snapshot metadata
13+
, SnapshotMetaData (..)
14+
, SnapshotLabel (..)
515
-- * Snapshot format
6-
numSnapRuns
16+
, numSnapRuns
717
, SnapLevels
818
, SnapLevel (..)
919
, SnapMergingRun (..)
@@ -23,6 +33,7 @@ import Control.Monad.Primitive (PrimMonad)
2333
import Control.TempRegistry
2434
import Data.Foldable (forM_)
2535
import Data.Primitive.PrimVar
36+
import Data.Text (Text)
2637
import qualified Data.Vector as V
2738
import Database.LSMTree.Internal.Config
2839
import Database.LSMTree.Internal.Entry
@@ -39,6 +50,116 @@ import Database.LSMTree.Internal.UniqCounter (UniqCounter,
3950
import System.FS.API (HasFS)
4051
import System.FS.BlockIO.API (HasBlockIO)
4152

53+
{-------------------------------------------------------------------------------
54+
Versioning
55+
-------------------------------------------------------------------------------}
56+
57+
-- | The version of a snapshot.
58+
--
59+
-- When encoding snapshot metadata, 'currentSnapshotVersion' is included in the
60+
-- file. When snapshot metadata is decoded, then the decoded version is checked
61+
-- for compatibility against 'currentSnapshotVersion'. Decoding will fail if the
62+
-- versions are incompatible.
63+
--
64+
-- A version @x.y@ has two components: a major version number @x@ and a minor
65+
-- version number @y@. The major version number is used to signal breaking
66+
-- changes. The minor version number is used to signal non-breaking changes that
67+
-- are backwards compatible. To be precise, @x.y@ is guaranteed to be backwards
68+
-- compatible with @x'.y'@ as long as @x == x'@ and @y' <= y@. If @x > x'@, then
69+
-- backwards compatibility *may* be provided, but is not guaranteed. Forward
70+
-- compatibilitty is never guaranteed.
71+
--
72+
-- If @x.y@ is our current version, and if it @x.y@ is backwards compatible with
73+
-- @x'.y'@, then @x.y@ can decode snapshots that were encoded at version
74+
-- @x'.y'@.
75+
--
76+
-- The version number determines the format of the snapshot metadata file, but
77+
-- it also doubles as versioning information for the entire snapshot itself. For
78+
-- example, if a breaking change is made to the merge scheduling algorithm that
79+
-- would lead to errors when loading an older snapshot, then the major version
80+
-- should be increased as well.
81+
data SnapshotVersion = V0_0
82+
deriving stock (Show, Eq)
83+
84+
-- >>> major currentSnapshotVersion
85+
-- 0
86+
major :: SnapshotVersion -> Word
87+
major V0_0 = 0
88+
89+
-- >>> minor currentSnapshotVersion
90+
-- 0
91+
minor :: SnapshotVersion -> Word
92+
minor V0_0 = 0
93+
94+
fromMajorMinor :: Word -> Word -> Maybe SnapshotVersion
95+
fromMajorMinor 0 0 = Just V0_0
96+
fromMajorMinor _ _ = Nothing
97+
98+
-- >>> prettySnapshotVersion currentSnapshotVersion
99+
-- "v0.0"
100+
prettySnapshotVersion :: SnapshotVersion -> String
101+
prettySnapshotVersion version = prettyVersion (major version) (minor version)
102+
103+
-- >>> prettyVersion 17 32
104+
-- "v17.32"
105+
prettyVersion :: Word -> Word -> String
106+
prettyVersion majo mino =
107+
showChar 'v'
108+
. shows majo
109+
. showChar '.'
110+
. shows mino
111+
$ ""
112+
113+
-- >>> currentSnapshotVersion
114+
-- V0_0
115+
currentSnapshotVersion :: SnapshotVersion
116+
currentSnapshotVersion = V0_0
117+
118+
_isCompatible :: SnapshotVersion -> Either String ()
119+
_isCompatible otherVersion = do
120+
case ( currentSnapshotVersion, otherVersion ) of
121+
(V0_0, V0_0) -> Right ()
122+
123+
{-------------------------------------------------------------------------------
124+
Snapshot metadata
125+
-------------------------------------------------------------------------------}
126+
127+
-- | Custom text to include in a snapshot file
128+
newtype SnapshotLabel = SnapshotLabel Text
129+
deriving stock (Show, Eq, Read)
130+
131+
data SnapshotTableType = SnapNormalTable | SnapMonoidalTable
132+
deriving stock (Show, Eq, Read)
133+
134+
data SnapshotMetaData = SnapshotMetaData {
135+
-- | Custom, user-supplied text that is included in the metadata.
136+
--
137+
-- The main use case for this field is for the user to supply textual
138+
-- information about the key\/value\/blob type for the table that
139+
-- corresponds to the snapshot. This information can then be used to
140+
-- dynamically check that a snapshot is opened at the correct
141+
-- key\/value\/blob type.
142+
--
143+
-- One could argue that the 'SnapshotName' could be used to to hold this
144+
-- information, but the file name of snapshot meta data is not guarded by a
145+
-- checksum, wherease the contents of the file are. Therefore using the
146+
-- 'SnapshotLabel' is safer.
147+
snapMetaLabel :: !SnapshotLabel
148+
-- | Whether a table is normal or monoidal.
149+
--
150+
-- TODO: if we at some point decide to get rid of the normal vs. monoidal
151+
-- distinction, we can get rid of this field.
152+
, snapMetaTableType :: !SnapshotTableType
153+
-- | The 'TableConfig' for the snapshotted table.
154+
--
155+
-- Some of these configuration options can be overridden when a snapshot is
156+
-- opened: see 'TableConfigOverride'.
157+
, snapMetaConfig :: !TableConfig
158+
-- | The shape of the LSM tree.
159+
, snapMetaLevels :: !SnapLevels
160+
}
161+
deriving stock (Show, Eq)
162+
42163
{-------------------------------------------------------------------------------
43164
Levels snapshot format
44165
-------------------------------------------------------------------------------}

src/Database/LSMTree/Monoidal.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
13
-- TODO: remove once the API is implemented.
24
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
35

@@ -86,7 +88,6 @@ module Database.LSMTree.Monoidal (
8688
-- * Durability (snapshots)
8789
, SnapshotName
8890
, Common.mkSnapshotName
89-
, Common.SnapshotLabel
9091
, Common.Labellable (..)
9192
, snapshot
9293
, open
@@ -137,6 +138,7 @@ import qualified Database.LSMTree.Internal as Internal
137138
import qualified Database.LSMTree.Internal.Entry as Entry
138139
import Database.LSMTree.Internal.RawBytes (RawBytes)
139140
import qualified Database.LSMTree.Internal.Serialise as Internal
141+
import qualified Database.LSMTree.Internal.Snapshot as Internal
140142
import qualified Database.LSMTree.Internal.Vector as V
141143

142144
-- $resource-management
@@ -559,8 +561,7 @@ snapshot :: forall m k v.
559561
snapshot snap (Internal.MonoidalTable t) =
560562
void $ Internal.snapshot (resolve @v Proxy) snap label t
561563
where
562-
-- to ensure we don't open a monoidal table as normal later
563-
label = Common.makeSnapshotLabel (Proxy @(k, v)) <> " (monoidal)"
564+
label = Internal.SnapshotLabel $ Common.makeSnapshotLabel (Proxy @(k, v))
564565

565566
{-# SPECIALISE open ::
566567
(SerialiseKey k, SerialiseValue v, ResolveValue v, Common.Labellable (k, v))
@@ -604,8 +605,7 @@ open :: forall m k v.
604605
open (Internal.Session' sesh) override snap =
605606
Internal.MonoidalTable <$> Internal.open sesh label override snap (resolve @v Proxy)
606607
where
607-
-- to ensure that the table is really a monoidal table
608-
label = Common.makeSnapshotLabel (Proxy @(k, v)) <> " (monoidal)"
608+
label = Internal.SnapshotLabel $ Common.makeSnapshotLabel (Proxy @(k, v))
609609

610610
{-------------------------------------------------------------------------------
611611
Multiple writable tables

src/Database/LSMTree/Normal.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
13
-- TODO: remove once the API is implemented.
24
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
35

@@ -87,7 +89,6 @@ module Database.LSMTree.Normal (
8789
-- * Durability (snapshots)
8890
, SnapshotName
8991
, Common.mkSnapshotName
90-
, Common.SnapshotLabel
9192
, Common.Labellable (..)
9293
, snapshot
9394
, open
@@ -127,6 +128,7 @@ import qualified Database.LSMTree.Internal as Internal
127128
import qualified Database.LSMTree.Internal.BlobRef as Internal
128129
import qualified Database.LSMTree.Internal.Entry as Entry
129130
import qualified Database.LSMTree.Internal.Serialise as Internal
131+
import qualified Database.LSMTree.Internal.Snapshot as Internal
130132
import qualified Database.LSMTree.Internal.Vector as V
131133
import qualified System.FS.API as FS
132134

@@ -685,8 +687,7 @@ snapshot :: forall m k v blob.
685687
-> m ()
686688
snapshot snap (Internal.NormalTable t) = void $ Internal.snapshot const snap label t
687689
where
688-
-- to ensure we don't open a normal table as monoidal later
689-
label = Common.makeSnapshotLabel (Proxy @(k, v, blob)) <> " (normal)"
690+
label = Internal.SnapshotLabel $ Common.makeSnapshotLabel (Proxy @(k, v, blob))
690691

691692
{-# SPECIALISE open ::
692693
( SerialiseKey k
@@ -733,8 +734,7 @@ open :: forall m k v blob.
733734
open (Internal.Session' sesh) override snap =
734735
Internal.NormalTable <$!> Internal.open sesh label override snap const
735736
where
736-
-- to ensure that the table is really a normal table
737-
label = Common.makeSnapshotLabel (Proxy @(k, v, blob)) <> " (normal)"
737+
label = Internal.SnapshotLabel $ Common.makeSnapshotLabel (Proxy @(k, v, blob))
738738

739739
{-------------------------------------------------------------------------------
740740
Mutiple writable tables

test/Test/Database/LSMTree/Class/Monoidal.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
1-
{-# LANGUAGE BlockArguments #-}
1+
{-# LANGUAGE BlockArguments #-}
2+
{-# LANGUAGE OverloadedStrings #-}
23

34
module Test.Database.LSMTree.Class.Monoidal (tests) where
45

test/Test/Database/LSMTree/Class/Normal.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
1-
{-# LANGUAGE BlockArguments #-}
1+
{-# LANGUAGE BlockArguments #-}
2+
{-# LANGUAGE OverloadedStrings #-}
23

34
module Test.Database.LSMTree.Class.Normal (
45
tests

test/Test/Database/LSMTree/Internal.hs

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
1-
{-# LANGUAGE LambdaCase #-}
2-
{-# LANGUAGE RecordWildCards #-}
1+
{-# LANGUAGE LambdaCase #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE RecordWildCards #-}
34

45
{- HLINT ignore "Use <=<" -}
56

@@ -28,6 +29,7 @@ import Database.LSMTree.Internal.Entry
2829
import Database.LSMTree.Internal.MergeSchedule
2930
import Database.LSMTree.Internal.Paths (mkSnapshotName)
3031
import Database.LSMTree.Internal.Serialise
32+
import Database.LSMTree.Internal.Snapshot (SnapshotLabel (..))
3133
import qualified System.FS.API as FS
3234
import qualified Test.Database.LSMTree.Internal.Lookup as Test
3335
import Test.Database.LSMTree.Internal.Lookup
@@ -172,8 +174,8 @@ prop_interimOpenTable dat = ioProperty $
172174
withTable sesh conf $ \t -> do
173175
updates const upds t
174176
let snap = fromMaybe (error "invalid name") $ mkSnapshotName "snap"
175-
numRunsSnapped <- snapshot const snap "someLabel" t
176-
t' <- open sesh "someLabel" configNoOverride snap const
177+
numRunsSnapped <- snapshot const snap (SnapshotLabel "someLabel") t
178+
t' <- open sesh (SnapshotLabel "someLabel") configNoOverride snap const
177179
lhs <- fetchBlobs hfs =<< lookups const ks t
178180
rhs <- fetchBlobs hfs =<< lookups const ks t'
179181
-- We must fetch blobs because comparing blob references is meaningless

0 commit comments

Comments
 (0)