diff --git a/.travis.yml b/.travis.yml new file mode 100644 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,10 @@ +language: haskell + +addons: + apt: + packages: + - libleveldb-dev + +ghc: + - 8.2 + - 8.4 diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +0.3.0 Enzo Haussecker Thu Aug 02 2018 + + * Add thread safety to parallel download combinators + * Separate impure code from base module + * Remove deprecated functions + 0.2.1 Enzo Haussecker Wed Jul 25 2018 * Fix bug related to temporary reference creation diff --git a/dfinity-radix-tree.cabal b/dfinity-radix-tree.cabal --- a/dfinity-radix-tree.cabal +++ b/dfinity-radix-tree.cabal @@ -1,5 +1,5 @@ Name: dfinity-radix-tree -Version: 0.2.1 +Version: 0.3.0 Synopsis: A generic data integrity layer. Description: This library allows you to construct a Merkle tree on top of any underlying @@ -27,6 +27,7 @@ base16-bytestring, bloomfilter, bytestring, + concurrent-extra, conduit, containers, cryptohash-sha256, @@ -44,6 +45,7 @@ Haskell2010 Exposed-Modules: Network.DFINITY.RadixTree + Network.DFINITY.RadixTree.Conduit GHC-Options: -O2 -Wall @@ -54,6 +56,7 @@ Network.DFINITY.RadixTree.Bits Network.DFINITY.RadixTree.Bloom Network.DFINITY.RadixTree.Lenses + Network.DFINITY.RadixTree.Lock Network.DFINITY.RadixTree.Memory Network.DFINITY.RadixTree.Serialise Network.DFINITY.RadixTree.Types diff --git a/src/Network/DFINITY/RadixTree.hs b/src/Network/DFINITY/RadixTree.hs --- a/src/Network/DFINITY/RadixTree.hs +++ b/src/Network/DFINITY/RadixTree.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS -Wall #-} {-# OPTIONS -Werror=incomplete-patterns #-} +{-# OPTIONS -fno-warn-unused-top-binds #-} -- | -- Module : Network.DFINITY.RadixTree @@ -26,7 +26,6 @@ -- ** Create , createRadixTree - , subtreeRadixTree -- ** Insert , insertRadixTree @@ -39,47 +38,34 @@ -- ** Query , lookupRadixTree - , lookupMerkleizedRadixTree - , lookupNonMerkleizedRadixTree -- ** Test , isEmptyRadixTree , isValidRadixRoot - -- ** Stream - , sourceMerkleizedRadixTree - , sinkMerkleizedRadixTree - -- ** Debug , contentsRadixTree , contentsMerkleizedRadixTree , contentsNonMerkleizedRadixTree + , printRadixTree , printMerkleizedRadixTree , printNonMerkleizedRadixTree ) where -import Codec.Serialise (deserialise, deserialiseOrFail) -import Control.Concurrent (forkIO, killThread) -import Control.Concurrent.BoundedChan (BoundedChan, readChan, tryWriteChan) -import Control.Concurrent.MVar (modifyMVar_, newMVar, readMVar) import Control.Exception (throw) -import Control.Monad (foldM, forM_, forever, void, when) +import Control.Monad (foldM, forM_) import Control.Monad.IO.Class (MonadIO(..)) -import Control.Monad.Trans.Resource (MonadResource, ResourceT, allocate, release) -import Crypto.Hash.SHA256 (hash) +import Control.Monad.Trans.Resource (ResourceT) import Data.BloomFilter as Bloom (elem, insert, insertList) import Data.Bool (bool) -import Data.ByteString.Char8 as Byte (ByteString, take) -import Data.ByteString.Lazy (fromStrict) -import Data.ByteString.Short (fromShort, toShort) -import Data.Conduit (ConduitM, await, yield) +import Data.ByteString (ByteString) +import Data.ByteString.Short (fromShort) import Data.Default.Class (def) -import Data.List as List (delete, foldl', null) import Data.List.NonEmpty (NonEmpty(..), fromList) -import Data.LruCache as LRU (empty, insert, lookup) -import Data.Map.Strict as Map ((!), delete, empty, insert, keys, lookup, member, null, singleton) +import Data.LruCache as LRU (empty) +import Data.Map.Strict as Map (empty) import Data.Maybe (fromJust, isJust, isNothing, listToMaybe) import Data.Tuple (swap) import Database.LevelDB (DB) @@ -124,26 +110,6 @@ cache = LRU.empty cacheSize -- | --- Create a radix tree from a radix tree. -subtreeRadixTree - :: RadixDatabase m database - => RadixRoot -- ^ State root. - -> RadixTree database -- ^ Radix tree. - -> m (RadixTree database) -{-# SPECIALISE subtreeRadixTree - :: RadixRoot - -> RadixTree DB - -> ResourceT IO (RadixTree DB) #-} -subtreeRadixTree root RadixTree {..} = do - result <- loadCold root cache _radixDatabase - case result of - Nothing -> throw $ StateRootDoesNotExist root - _ -> pure $ RadixTree bloom _radixBloomSize Map.empty cache _radixCacheSize root _radixDatabase 0 root - where - bloom = emptyRadixBloom _radixBloomSize - cache = LRU.empty _radixCacheSize - --- | -- Check if a radix tree is empty. isEmptyRadixTree :: RadixTree database -- ^ Radix tree. @@ -203,10 +169,10 @@ let prefixes' = prefix:prefixes let key' = drop n key -- Check the termination criteria. - let residue = not $ List.null overflow + let residue = not $ null overflow let bit = head key' let child = bool _radixLeft _radixRight bit - if List.null key' || residue || isNothing child + if null key' || residue || isNothing child then pure $ Right (fromList roots', fromList nodes', fromList prefixes', overflow, key', cache') else do -- Recurse. @@ -246,7 +212,7 @@ loadHot _radixRoot _radixBuffer _radixCache _radixDatabase -- | --- Insert a key and value into a radix tree. +-- Insert a value into a radix tree. insertRadixTree :: RadixDatabase m database => ByteString -- ^ Key. @@ -285,7 +251,7 @@ prefix = createPrefix $ toBits key node = setPrefix prefix $ Just value `setLeaf` def root = createRootFromNonce _radixNonce - bloom = Bloom.insert root _radixBloom + bloom = insert root _radixBloom nonce = _radixNonce + 1 buffer = storeHot root node _radixBuffer @@ -440,7 +406,7 @@ deleteRadixTreeNoChildrenNoParent (_, _, _, _, _, cache) tree@RadixTree {..} = seq bloom $ setBloom bloom $ setBuffer buffer $ setCache cache $ setRoot state tree where - bloom = Bloom.insert defaultRoot _radixBloom + bloom = insert defaultRoot _radixBloom buffer = storeHot defaultRoot def _radixBuffer state = defaultRoot @@ -529,23 +495,21 @@ -- | -- Lookup a value in a radix tree. -lookupRadixTree' +lookupRadixTree :: RadixDatabase m database - => (ByteString -> RadixTree database -> m (Either RadixError RadixSearchResult)) -- ^ Search algorithm. - -> ByteString -- ^ Key. + => ByteString -- ^ Key. -> RadixTree database -- ^ Radix tree. -> m (Maybe (ByteString, RadixTree database)) -{-# SPECIALISE lookupRadixTree' - :: (ByteString -> RadixTree DB -> ResourceT IO (Either RadixError RadixSearchResult)) - -> ByteString +{-# SPECIALISE lookupRadixTree + :: ByteString -> RadixTree DB -> ResourceT IO (Maybe (ByteString, RadixTree DB)) #-} -lookupRadixTree' search key tree = do - found <- search key tree +lookupRadixTree key tree = do + found <- searchNonMerkleizedRadixTree key tree case found of Left err -> throw err Right (_, RadixNode {..}:|_, _, prefixOverflow, keyOverflow, cache') -> - if not $ List.null prefixOverflow && List.null keyOverflow + if not $ null prefixOverflow && null keyOverflow then pure Nothing else pure $ do value <- _radixLeaf @@ -553,42 +517,6 @@ pure (value, tree') -- | --- A convenient alias for `lookupNonMerkleizedRadixTree`. -lookupRadixTree - :: RadixDatabase m database - => ByteString -- ^ Key. - -> RadixTree database -- ^ Radix tree. - -> m (Maybe (ByteString, RadixTree database)) -{-# SPECIALISE lookupRadixTree - :: ByteString - -> RadixTree DB - -> ResourceT IO (Maybe (ByteString, RadixTree DB)) #-} -lookupRadixTree = lookupNonMerkleizedRadixTree - --- | --- Lookup a value in a Merkleized radix tree. -lookupMerkleizedRadixTree - :: RadixDatabase m database - => ByteString -- ^ Key. - -> RadixTree database -- ^ Radix tree. - -> m (Maybe (ByteString, RadixTree database)) -{-# DEPRECATED lookupMerkleizedRadixTree "The function is will be removed in the next release. Please use 'lookupRadixTree' instead." #-} -lookupMerkleizedRadixTree = lookupRadixTree' searchMerkleizedRadixTree - --- | --- Lookup a value in a non-Merkleized radix tree. -lookupNonMerkleizedRadixTree - :: RadixDatabase m database - => ByteString -- ^ Key. - -> RadixTree database -- ^ Radix tree. - -> m (Maybe (ByteString, RadixTree database)) -{-# SPECIALISE lookupNonMerkleizedRadixTree - :: ByteString - -> RadixTree DB - -> ResourceT IO (Maybe (ByteString, RadixTree DB)) #-} -lookupNonMerkleizedRadixTree = lookupRadixTree' searchNonMerkleizedRadixTree - --- | -- Mask a node in a Merkleized radix tree. merkleSpoof :: RadixRoot -- ^ State root. @@ -602,7 +530,7 @@ storeHot root $ test `setChild` Just mask $ node -- | --- Merkleize a radix tree. This will flush the buffer to disk. +-- Merkleize a radix tree. This will flush the buffer to the database. merkleizeRadixTree :: RadixDatabase m database => RadixTree database-- ^ Radix tree. @@ -645,124 +573,6 @@ (root'', cache''') <- loop right cache'' let node' = setChildren (Just root', Just root'') node storeCold node' cache''' _radixDatabase - --- | --- Create a conduit from a Merkleized radix tree. -sourceMerkleizedRadixTree - :: MonadResource m - => RadixDatabase (ConduitM () ByteString m) database - => [Bool] -- ^ Bit mask. - -> Int -- ^ LRU cache size in items. - -> BoundedChan RadixRoot -- ^ Terminal state root producer. - -> RadixTree database -- ^ Radix tree. - -> ConduitM () ByteString m () -{-# SPECIALISE sourceMerkleizedRadixTree - :: [Bool] - -> Int - -> BoundedChan RadixRoot - -> RadixTree DB - -> ConduitM () ByteString (ResourceT IO) () #-} -sourceMerkleizedRadixTree mask cacheSize chan - | cacheSize <= 0 = throw $ InvalidArgument "invalid LRU cache size" - | otherwise = \ tree -> do - cache <- liftIO $ newMVar $ LRU.empty cacheSize - (,) action _ <- flip allocate killThread $ forkIO $ forever $ do - root <- readChan chan - modifyMVar_ cache $ pure . LRU.insert root () - loop cache tree [] - release action - where - loop cache tree@RadixTree {..} roots = do - seen <- liftIO $ readMVar cache - let roots' = _radixCheckpoint:roots - if flip any roots' $ isJust . flip LRU.lookup seen - then pure () - else do - let key = fromShort _radixCheckpoint - result <- load _radixDatabase key - case result of - Nothing -> pure () - Just bytes -> do - let RadixNode {..} = deserialise $ fromStrict bytes - let success = all id $ zipWith (==) mask $ toBits $ fromShort _radixCheckpoint - when success $ yield bytes - forM_ [_radixLeft, _radixRight] $ \ case - Nothing -> pure () - Just root -> loop cache `flip` roots' $ setCheckpoint root tree - --- | --- Create a Merkleized radix tree from a conduit. -sinkMerkleizedRadixTree - :: MonadResource m - => RadixDatabase (ConduitM ByteString () m) database - => RadixRoot -- ^ Target state root. - -> BoundedChan RadixRoot -- ^ Terminal state root consumer. - -> RadixTree database -- ^ Radix tree. - -> ConduitM ByteString () m (Either [RadixRoot] (RadixTree database)) -{-# SPECIALISE sinkMerkleizedRadixTree - :: RadixRoot - -> BoundedChan RadixRoot - -> RadixTree DB - -> ConduitM ByteString () (ResourceT IO) (Either [RadixRoot] (RadixTree DB)) #-} -sinkMerkleizedRadixTree checkpoint chan tree@RadixTree {..} = - loop1 Map.empty $ singleton checkpoint Nothing where - loop1 = \ buffer want -> - if Map.null want - then pure $ Right $ setCheckpoint checkpoint $ setRoot checkpoint tree - else await >>= \ case - Nothing -> pure $ Left $ keys want - Just bytes -> - case deserialiseOrFail $ fromStrict bytes of - Right RadixNode {..} -> do - let key = Byte.take 20 $ hash bytes - let root = toShort key - let wanted = member root want - exists <- if wanted - then pure False - else isJust <$> load _radixDatabase key - if exists - then loop1 buffer $ Map.delete root want - else do - children <- foldM step [] $ maybe id (:) _radixLeft $ maybe id (:) _radixRight [] - let buffer' = Map.insert root (key, bytes, children) buffer - if not wanted - then loop1 buffer' want - else loop3 buffer' `uncurry` loop2 buffer' (want, []) root - _ -> loop1 buffer want - where - step accum root = do - valid <- isValidRadixRoot root tree - if valid - then pure accum - else pure $ root:accum - loop2 buffer accum@(want, candidates) root = - case Map.lookup root buffer of - Nothing -> accum - Just (key, bytes, []) -> (want, (root, key, bytes):candidates) - Just (_, _, children) -> - let want' = foldr step want children - in foldl' (loop2 buffer) (want', candidates) children - where - step = flip Map.insert $ Just root - loop3 buffer want = \ case - [] -> loop1 buffer want - (root, key, bytes):candidates -> do - store _radixDatabase key bytes - let buffer' = Map.delete root buffer - case want ! root of - Nothing -> do - let want' = Map.delete root want - loop1 buffer' want' - Just root' -> do - let want' = Map.delete root want - let (key', bytes', siblings') = buffer ! root' - let children' = List.delete root siblings' - if List.null children' - then loop3 buffer' want' $ (root', key', bytes'):candidates - else do - let buffer'' = Map.insert root' (key', bytes', children') buffer' - liftIO $ void $ tryWriteChan chan root - loop3 buffer'' want' candidates -- | -- Get the contents of a radix tree. diff --git a/src/Network/DFINITY/RadixTree/Conduit.hs b/src/Network/DFINITY/RadixTree/Conduit.hs new file mode 100644 --- /dev/null +++ b/src/Network/DFINITY/RadixTree/Conduit.hs @@ -0,0 +1,214 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-# OPTIONS -Wall #-} +{-# OPTIONS -Werror=incomplete-patterns #-} + +-- | +-- Module : Network.DFINITY.RadixTree.Conduit +-- Copyright : 2018 DFINITY Stiftung +-- License : GPL-3 +-- Maintainer : Enzo Haussecker +-- Stability : Stable +-- +-- A parallel download protocol. +module Network.DFINITY.RadixTree.Conduit ( + + -- ** Combinators + sourceRadixTree + , sinkRadixTree + + ) where + +import Codec.Serialise (deserialise, deserialiseOrFail) +import Control.Concurrent (forkIO, killThread) +import Control.Concurrent.BoundedChan (BoundedChan, readChan, tryWriteChan) +import Control.Concurrent.MVar (modifyMVar_, newMVar, readMVar) +import Control.Concurrent.ReadWriteLock (RWLock) +import Control.Exception (throw) +import Control.Monad (foldM, forM_, forever, void, when) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Resource (MonadResource, ResourceT, allocate, release) +import Crypto.Hash.SHA256 (hash) +import Data.ByteString.Lazy (fromStrict) +import Data.ByteString.Short (ShortByteString, fromShort, toShort) +import Data.ByteString.Char8 as Byte (ByteString, take) +import Data.Conduit (ConduitT, await, yield) +import Data.List as List (delete, null) +import Data.LruCache as LRU (empty, insert, lookup) +import Data.Map as Map (Map, (!), delete, empty, insert, keys, lookup, member, null, singleton) +import Data.Maybe (isJust) +import Data.Void (Void) +import Database.LevelDB (DB) + +import Network.DFINITY.RadixTree.Bits +import Network.DFINITY.RadixTree.Lenses +import Network.DFINITY.RadixTree.Lock +import Network.DFINITY.RadixTree.Types + +-- | +-- Create a conduit from a radix tree. +sourceRadixTree + :: forall m database. MonadResource m + => RadixDatabase (ConduitT () ByteString m) database + => [Bool] -- ^ Bit mask. + -> Int -- ^ LRU cache size in items. + -> BoundedChan RadixRoot -- ^ Terminal state root producer. + -> RadixTree database -- ^ Radix tree. + -> RWLock -- ^ Database lock. + -> ConduitT () ByteString m () +{-# SPECIALISE sourceRadixTree + :: [Bool] + -> Int + -> BoundedChan RadixRoot + -> RadixTree DB + -> RWLock + -> ConduitT () ByteString (ResourceT IO) () #-} +sourceRadixTree mask cacheSize chan tree lock + | cacheSize <= 0 = throw $ InvalidArgument "invalid LRU cache size" + | otherwise = do + cache <- liftIO $ newMVar $ LRU.empty cacheSize + action <- fmap fst $ flip allocate killThread $ forkIO $ forever $ do + root <- readChan chan + modifyMVar_ cache $ pure . LRU.insert root () + loop cache tree [] + release action + where + loop cache subtree@RadixTree {..} accum = do + let accum' = _radixCheckpoint:accum + seen <- liftIO $ readMVar cache + if flip any accum' $ isJust . flip LRU.lookup seen + then pure () + else do + let key = fromShort _radixCheckpoint + result <- withReadLock lock $ load _radixDatabase key + case result of + Nothing -> pure () + Just bytes -> do + let RadixNode {..} = deserialise $ fromStrict bytes + let success = all id $ zipWith (==) mask $ toBits $ fromShort _radixCheckpoint + when success $ yield bytes + forM_ [_radixLeft, _radixRight] $ \ case + Nothing -> pure () + Just root -> loop cache `flip` accum' $ setCheckpoint root subtree + +-- | +-- Create a radix tree from a conduit. +sinkRadixTree + :: forall m database. MonadResource m + => RadixDatabase (ConduitT ByteString Void m) database + => RadixRoot -- ^ Target state root. + -> BoundedChan RadixRoot -- ^ Terminal state root consumer. + -> RadixTree database -- ^ Radix tree. + -> RWLock -- ^ Database lock. + -> ConduitT ByteString Void m (Either [RadixRoot] (RadixTree database)) +{-# SPECIALISE sinkRadixTree + :: RadixRoot + -> BoundedChan RadixRoot + -> RadixTree DB + -> RWLock + -> ConduitT ByteString Void (ResourceT IO) (Either [RadixRoot] (RadixTree DB)) #-} +sinkRadixTree checkpoint chan tree@RadixTree {..} lock = + loop1 Map.empty $ singleton checkpoint Nothing + where + + -- Loop 1: The accumulation loop. + loop1 + :: Map RadixRoot (ShortByteString, [RadixRoot]) + -> Map RadixRoot (Maybe RadixRoot) + -> ConduitT ByteString Void m (Either [RadixRoot] (RadixTree database)) + loop1 buffer targets = + -- Have we found all the subtrees? + if Map.null targets + then pure $ Right $ setCheckpoint checkpoint $ setRoot checkpoint tree + else do + -- Wait for a node. + mval <- await + case mval of + Nothing -> pure $ Left $ keys targets + Just bytes -> + case deserialiseOrFail $ fromStrict bytes of + Left _ -> loop1 buffer targets + Right RadixNode {..} -> do + -- Does the node already exist in the database? + let key = Byte.take 20 $ hash bytes + let root = toShort key + let want = member root targets + exists <- if want + then pure False + else do + result <- withReadLock lock $ load _radixDatabase key + pure $ isJust result + if exists + then loop1 buffer $ Map.delete root targets + else do + -- Update the buffer to include the node. + children <- foldM step [] $ maybe id (:) _radixLeft $ maybe id (:) _radixRight [] + let buffer' = Map.insert root (toShort bytes, children) buffer + -- Can we trace the node back to the target state root? + if want + then loop3 buffer' `uncurry` loop2 buffer' root (targets, []) + else loop1 buffer' targets + where + step accum root = do + let key = fromShort root + result <- withReadLock lock $ load _radixDatabase key + if isJust result + then pure accum + else pure $ root:accum + + -- Loop 2: The aggregation loop. + loop2 + :: Map RadixRoot (ShortByteString, [RadixRoot]) + -> RadixRoot + -> (Map RadixRoot (Maybe RadixRoot), [(RadixRoot, ShortByteString)]) + -> (Map RadixRoot (Maybe RadixRoot), [(RadixRoot, ShortByteString)]) + loop2 buffer root accum@(targets, candidates) = + -- Get the node from the buffer and analyze. + case Map.lookup root buffer of + Nothing -> accum + Just (bytes, []) -> + -- The node is now a candidate. + let candidates' = (root, bytes):candidates + in (targets, candidates') + Just (_, children) -> + -- The children are now targets. + let targets' = foldr step1 targets children + in foldl step2 (targets', candidates) children + where + step1 = flip Map.insert $ Just root + step2 = flip $ loop2 buffer + + -- Loop 3: The write loop. + loop3 + :: Map RadixRoot (ShortByteString, [RadixRoot]) + -> Map RadixRoot (Maybe RadixRoot) + -> [(RadixRoot, ShortByteString)] + -> ConduitT ByteString Void m (Either [RadixRoot] (RadixTree database)) + loop3 buffer targets = \ case + [] -> loop1 buffer targets + (root, bytes):candidates' -> do + -- Write the node to the database. + let key = fromShort root + withWriteLock lock $ store _radixDatabase key $ fromShort bytes + -- Remove all references to the node. + let buffer' = Map.delete root buffer + let targets' = Map.delete root targets + -- Inspect the parent node. + case targets ! root of + Nothing -> loop3 buffer' targets' candidates' + Just root' -> do + let (bytes', siblings') = buffer ! root' + let children' = List.delete root siblings' + -- Has the sibling node been written to the database? + if List.null children' + then loop3 buffer' targets' $ (root', bytes'):candidates' + else do + -- Announce a terminal state root. + liftIO $ void $ tryWriteChan chan root + -- Update the parent node. + let buffer'' = Map.insert root' (bytes', children') buffer' + loop3 buffer'' targets' candidates' diff --git a/src/Network/DFINITY/RadixTree/Lock.hs b/src/Network/DFINITY/RadixTree/Lock.hs new file mode 100644 --- /dev/null +++ b/src/Network/DFINITY/RadixTree/Lock.hs @@ -0,0 +1,29 @@ +{-# OPTIONS -Wall #-} + +module Network.DFINITY.RadixTree.Lock + ( withReadLock + , withWriteLock + ) where + +import Control.Concurrent.ReadWriteLock (RWLock, acquireRead, acquireWrite, releaseRead, releaseWrite) +import Control.Monad.Trans.Resource (MonadResource, allocate, release) + +withReadLock :: MonadResource m => RWLock -> m a -> m a +withReadLock lock action = do + key <- fst <$> allocate acquireLock releaseLock + result <- action + release key + pure result + where + acquireLock = acquireRead lock + releaseLock = const $ releaseRead lock + +withWriteLock :: MonadResource m => RWLock -> m a -> m a +withWriteLock lock action = do + key <- fst <$> allocate acquireLock releaseLock + result <- action + release key + pure result + where + acquireLock = acquireWrite lock + releaseLock = const $ releaseWrite lock diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -84,7 +84,7 @@ printNonMerkleizedRadixTree tree' pure tree' Lookup key value -> do - result <- lookupNonMerkleizedRadixTree key tree + result <- lookupRadixTree key tree case result of Just (value', tree') | value == value' -> pure tree' Just (value', _) -> throw diff --git a/test/tests.json b/test/tests.json --- a/test/tests.json +++ b/test/tests.json @@ -5,7 +5,7 @@ "value": "0x4cf812be9be2c6008325050f43d06676a08612c7" } ], - "setAndGet": [ + "insert_and_lookup": [ { "op": "set", "key": "0x74657374", @@ -62,6 +62,58 @@ "op": "get", "key": "0x74657374", "value": "0x636174313131" + } + ], + "insert_and_lookup_2": [ + { + "op": "set", + "key": "0x61", + "value": "0x3239" + }, + { + "op": "set", + "key": "0x612f", + "value": "0x3136313438" + }, + { + "op": "set", + "key": "0x612f30", + "value": "0x36373132" + }, + { + "op": "set", + "key": "0x612f31", + "value": "0x3732" + }, + { + "op": "set", + "key": "0x62", + "value": "0x3237" + }, + { + "op": "set", + "key": "0x622f", + "value": "0x3136313438" + }, + { + "op": "set", + "key": "0x622f30", + "value": "0x36373132" + }, + { + "op": "set", + "key": "0x622f31", + "value": "0x3232" + }, + { + "op": "set", + "key": "0x622f31", + "value": "0x3730" + }, + { + "op": "get", + "key": "0x612f31", + "value": "0x3732" } ], "insert_and_delete": [