packages feed

dfinity-radix-tree 0.1.0 → 0.1.1

raw patch · 9 files changed

+354/−257 lines, 9 filesdep +mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: mtl

API changes (from Hackage documentation)

+ Network.DFINITY.RadixTree: contentsMerkleizedRadixTree :: RadixDatabase config m database => RadixTree database -> m [(ByteString, ByteString)]
+ Network.DFINITY.RadixTree: contentsNonMerkleizedRadixTree :: RadixDatabase config m database => RadixTree database -> m [(ByteString, ByteString)]
+ Network.DFINITY.RadixTree: contentsRadixTree :: RadixDatabase config m database => RadixTree database -> m [(ByteString, ByteString)]
+ Network.DFINITY.RadixTree: lookupRadixTree :: RadixDatabase config m database => ByteString -> RadixTree database -> m (Maybe (ByteString, RadixTree database))
+ Network.DFINITY.RadixTree: printRadixTree :: MonadIO m => RadixDatabase config m database => RadixTree database -> m ()

Files

CHANGELOG.md view
@@ -1,3 +1,9 @@+0.1.1 Enzo Haussecker <enzo@dfinity.org> Thu Jul 12 2018++ * Create aliases for verbose functions+ * Add useful functions for debugging+ * Clean-up documentation+ 0.1.0 Enzo Haussecker <enzo@dfinity.org> Tue Jul 03 2018   * Abstract database to type class
README.md view
@@ -5,16 +5,17 @@ [![License: GPLv3](https://img.shields.io/badge/License-GPLv3-blue.svg)](https://www.gnu.org/licenses/gpl-3.0)  ## Overview-This library allows you to construct a [Merkle tree](https://en.wikipedia.org/wiki/Merkle_tree) on top of any underlying key–value database. It works by organizing your key–value pairs into a binary radix tree, which is well suited for storing large dictionaries of fairly random keys, and is optimized for storing keys of the same length.+This library allows you to construct a [Merkle tree](https://en.wikipedia.org/wiki/Merkle_tree) on top of any underlying key–value database. It works by organizing your key–value pairs into a binary [radix tree](https://en.wikipedia.org/wiki/Radix_tree), which is well suited for storing large dictionaries of fairly random keys, and is optimized for storing keys of the same length.  ## Usage-Define your database as an instance of the `RadixDatabase` type class. An instance for [LevelDB](http://hackage.haskell.org/package/leveldb-haskell) is already provided.+Define your database as an instance of the [`RadixDatabase`](https://hackage.haskell.org/package/dfinity-radix-tree/docs/Network-DFINITY-RadixTree.html#t:RadixDatabase) type class. An instance for [LevelDB](http://hackage.haskell.org/package/leveldb-haskell) is already provided. ```haskell {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -import Control.Monad.Trans.Resource-import Database.LevelDB+import Control.Monad.Trans.Resource (MonadResource)+import Database.LevelDB (DB, Options, defaultReadOptions, defaultWriteOptions, get, open, put)+ import Network.DFINITY.RadixTree  instance MonadResource m => RadixDatabase (FilePath, Options) m DB where@@ -22,57 +23,51 @@    load database = get database defaultReadOptions    store database = put database defaultWriteOptions ```-Create a `RadixTree` that is parameterized by your database. If you want to make things more explicit, then define some simple type aliases and wrapper functions.+Create a [`RadixTree`](https://hackage.haskell.org/package/dfinity-radix-tree/docs/Network-DFINITY-RadixTree.html#t:RadixTree) that is parameterized by your database. If you want to make things more explicit, then you can define a simple type alias and wrapper function. ```haskell-import Control.Monad.Trans.Resource-import Data.ByteString-import Database.LevelDB+import Control.Monad.Trans.Resource (MonadResource)+import Database.LevelDB (DB, Options(..), defaultOptions)+ import Network.DFINITY.RadixTree -type MerkleTree = RadixTree DB-type MerkleRoot = RadixRoot+type RadixTree' = RadixTree DB -createMerkleTree+createRadixTree'    :: MonadResource m    => FilePath -- Database.-   -> Maybe MerkleRoot -- State root.-   -> m MerkleTree-createMerkleTree path root =+   -> Maybe RadixRoot -- State root.+   -> m RadixTree'+createRadixTree' path root =    createRadixTree bloomSize cacheSize root (path, options)    where    bloomSize = 262144    cacheSize = 2048-   options = defaultOptions {createIfMissing = True}--insertMerkleTree-   :: MonadResource m-   => ByteString -- Key.-   -> ByteString -- Value.-   -> MerkleTree -- Tree.-   -> m MerkleTree-insertMerkleTree = insertRadixTree+   options   = defaultOptions {createIfMissing = True}+```+Using the definitions above, you can create a radix tree, perform some basic operations on it, and see that its contents is uniquely defined by its [`RadixRoot`](https://hackage.haskell.org/package/dfinity-radix-tree/docs/Network-DFINITY-RadixTree.html#t:RadixRoot).+```haskell+{-# LANGUAGE OverloadedStrings #-} -deleteMerkleTree-   :: MonadResource m-   => ByteString -- Key.-   -> MerkleTree -- Tree.-   -> m MerkleTree-deleteMerkleTree = deleteRadixTree+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Resource (runResourceT)+import Data.ByteString.Base16 (encode)+import Data.ByteString.Char8 (unpack)+import Data.ByteString.Short (fromShort) -merkleizeMerkleTree-   :: MonadResource m-   => MerkleTree -- Tree.-   -> m (MerkleRoot, MerkleTree)-merkleizeMerkleTree = merkleizeRadixTree+import Network.DFINITY.RadixTree -lookupMerkleTree-   :: MonadResource m-   => ByteString -- Key.-   -> MerkleTree -- Tree.-   -> m (Maybe (ByteString, MerkleTree))-lookupMerkleTree = lookupMerkleizedRadixTree+main :: IO ()+main = runResourceT $ do+   tree  <- createRadixTree' "/path/to/database" Nothing+   tree' <- insertRadixTree "Hello" "World" tree+   root  <- fst <$> merkleizeRadixTree tree'+   liftIO $ putStrLn $ "State Root: 0x" ++ pretty root+   where pretty = unpack . encode . fromShort ```-Using the API above, we can perform operations on the tree as a proxy for the database and see that its contents is uniquely defined by its `MerkleRoot`.+Running the program above should produce the following result.+```+State Root: 0x621f6e4c28b18e58d374c9236daa1a0ccba16550+```  ## Contribute
dfinity-radix-tree.cabal view
@@ -1,5 +1,5 @@ Name:               dfinity-radix-tree-Version:            0.1.0+Version:            0.1.1 Synopsis:           A generic data integrity layer. Description:    This library allows you to construct a Merkle tree on top of any underlying@@ -36,6 +36,7 @@       lens-simple,       leveldb-haskell,       lrucaching,+      mtl,       resourcet,       semigroups,       serialise@@ -65,10 +66,10 @@       base16-bytestring,       bytestring,       cmdargs,+      containers,       data-default-class,       dfinity-radix-tree,-      leveldb-haskell,-      resourcet,+      mtl,       text,       unordered-containers    Default-Language:
src/Network/DFINITY/RadixTree.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}  {-# OPTIONS -Wall #-} {-# OPTIONS -Werror=incomplete-patterns #-}@@ -19,9 +20,9 @@      RadixDatabase(..)     -- ** Types+   , RadixError(..)    , RadixRoot    , RadixTree-   , RadixError(..)     -- ** Create    , createRadixTree@@ -37,6 +38,7 @@    , merkleizeRadixTree     -- ** Query+   , lookupRadixTree    , lookupMerkleizedRadixTree    , lookupNonMerkleizedRadixTree @@ -49,6 +51,10 @@    , sinkMerkleizedRadixTree     -- ** Debug+   , contentsRadixTree+   , contentsMerkleizedRadixTree+   , contentsNonMerkleizedRadixTree+   , printRadixTree    , printMerkleizedRadixTree    , printNonMerkleizedRadixTree @@ -167,13 +173,13 @@ searchRadixTree    :: RadixDatabase config m database    => Bool -- ^ Overwrite state root?-   -> (RadixTree database -> m (Maybe (RadixBranch, RadixCache))) -- ^ Loading strategy.+   -> (RadixTree database -> m (Maybe (RadixNode, RadixCache))) -- ^ Loading strategy.    -> ByteString -- ^ Key.    -> RadixTree database -- ^ Radix tree.    -> m (Either RadixError RadixSearchResult) {-# SPECIALISE searchRadixTree    :: Bool-   -> (RadixTree DB -> ResourceT IO (Maybe (RadixBranch, RadixCache)))+   -> (RadixTree DB -> ResourceT IO (Maybe (RadixNode, RadixCache)))    -> ByteString    -> RadixTree DB    -> ResourceT IO (Either RadixError RadixSearchResult) #-}@@ -181,12 +187,12 @@    let key' = toBits key    let tree' = tree `bool` setRoot _radixCheckpoint tree $ flag    loop Nothing [] [] [] key' tree' where-   loop implicit branches roots prefixes key tree@RadixTree {..} = do-      -- Load the root branch.+   loop implicit roots nodes prefixes key tree@RadixTree {..} = do+      -- Load the root node.       result <- strategy tree       case result of          Nothing -> pure $ Left $ StateRootDoesNotExist _radixRoot-         Just (branch@RadixBranch {..}, cache') -> do+         Just (node@RadixNode {..}, cache') -> do             -- Calculate the prefix and overflow.             let bits = maybe id (:) implicit $ maybe [] toBits _radixPrefix             let prefix = matchBits bits key@@ -194,7 +200,7 @@             let overflow = drop n bits             -- Update the accumulators.             let roots' = _radixRoot:roots-            let branches' = branch:branches+            let nodes' = node:nodes             let prefixes' = prefix:prefixes             let key' = drop n key             -- Check the termination criteria.@@ -202,13 +208,13 @@             let bit = head key'             let child = bool _radixLeft _radixRight bit             if List.null key' || residue || isNothing child-            then pure $ Right (fromList roots', fromList branches', fromList prefixes', overflow, key', cache')+            then pure $ Right (fromList roots', fromList nodes', fromList prefixes', overflow, key', cache')             else do                -- Recurse.                let root' = fromJust child                let tree' = setCache cache' $ setRoot root' tree                let implicit' = Just bit-               loop implicit' branches' roots' prefixes' key' tree'+               loop implicit' roots' nodes' prefixes' key' tree'  -- | -- Search for a value in a Merkleized radix tree.@@ -278,10 +284,10 @@    seq bloom $ setBloom bloom $ setBuffer buffer $ setRoot root tree    where    prefix = createPrefix $ toBits key-   branch = setPrefix prefix $ Just value `setLeaf` def-   root = createRoot branch+   node = setPrefix prefix $ Just value `setLeaf` def+   root = createRoot node    bloom = Bloom.insert root _radixBloom-   buffer = storeHot root branch _radixBuffer+   buffer = storeHot root node _radixBuffer  -- TODO (enzo): Documentation. insertRadixTreeAt@@ -290,14 +296,14 @@    -> RadixTree database -- ^ Radix tree.    -> RadixTree database {-# INLINABLE insertRadixTreeAt #-}-insertRadixTreeAt (_:|roots, branch:|branches, prefix:|_, _, _, cache) value tree@RadixTree {..} =+insertRadixTreeAt (_:|roots, node:|nodes, prefix:|_, _, _, cache) value tree@RadixTree {..} =    seq bloom $ setBloom bloom $ setBuffer buffer $ setCache cache $ setRoot state tree    where-   branch' = Just value `setLeaf` branch-   root' = createRoot branch'-   parent = listToMaybe $ zip3 roots branches prefix+   node' = Just value `setLeaf` node+   root' = createRoot node'+   parent = listToMaybe $ zip3 roots nodes prefix    bloom = flip insertList _radixBloom $ root':roots-   buffer = merkleSpoof root' parent $ storeHot root' branch' _radixBuffer+   buffer = merkleSpoof root' parent $ storeHot root' node' _radixBuffer    state = bool _radixRoot root' $ isNothing parent  -- TODO (enzo): Documentation.@@ -307,18 +313,18 @@    -> RadixTree database -- ^ Radix tree.    -> RadixTree database {-# INLINABLE insertRadixTreeAfter #-}-insertRadixTreeAfter (_:|roots, branch:|branches, prefix:|_, _, keyOverflow, cache) value tree@RadixTree {..} =+insertRadixTreeAfter (_:|roots, node:|nodes, prefix:|_, _, keyOverflow, cache) value tree@RadixTree {..} =    seq bloom $ setBloom bloom $ setBuffer buffer $ setCache cache $ setRoot state tree    where    prefix' = createPrefix $ drop 1 keyOverflow-   branch' = setPrefix prefix' $ Just value `setLeaf` def-   root' = createRoot branch'-   branch'' = test `setChild` Just root' $ branch-   root'' = createRoot branch''+   node' = setPrefix prefix' $ Just value `setLeaf` def+   root' = createRoot node'+   node'' = test `setChild` Just root' $ node+   root'' = createRoot node''    test = head keyOverflow-   parent = listToMaybe $ zip3 roots branches prefix+   parent = listToMaybe $ zip3 roots nodes prefix    bloom = flip insertList _radixBloom $ root'':root':roots-   buffer = merkleSpoof root'' parent $ storeHot root'' branch'' $ storeHot root' branch' _radixBuffer+   buffer = merkleSpoof root'' parent $ storeHot root'' node'' $ storeHot root' node' _radixBuffer    state = bool _radixRoot root'' $ isNothing parent  -- TODO (enzo): Documentation.@@ -328,19 +334,19 @@    -> RadixTree database -- ^ Radix tree.    -> RadixTree database {-# INLINABLE insertRadixTreeBefore #-}-insertRadixTreeBefore (_:|roots, branch:|branches, prefix:|_, prefixOverflow, _, cache) value tree@RadixTree {..} =+insertRadixTreeBefore (_:|roots, node:|nodes, prefix:|_, prefixOverflow, _, cache) value tree@RadixTree {..} =    seq bloom $ setBloom bloom $ setBuffer buffer $ setCache cache $ setRoot state tree    where    prefix' = createPrefix $ drop 1 prefixOverflow-   branch' = setPrefix prefix' branch-   root' = createRoot branch'+   node' = setPrefix prefix' node+   root' = createRoot node'    prefix'' = createPrefix $ drop 1 prefix `bool` prefix $ isNothing parent-   branch'' = setPrefix prefix'' $ test `setChild` Just root' $ Just value `setLeaf` def-   root'' = createRoot branch''+   node'' = setPrefix prefix'' $ test `setChild` Just root' $ Just value `setLeaf` def+   root'' = createRoot node''    test = head prefixOverflow-   parent = listToMaybe $ zip3 roots branches prefix+   parent = listToMaybe $ zip3 roots nodes prefix    bloom = flip insertList _radixBloom $ root'':root':roots-   buffer = merkleSpoof root'' parent $ storeHot root'' branch'' $ storeHot root' branch' _radixBuffer+   buffer = merkleSpoof root'' parent $ storeHot root'' node'' $ storeHot root' node' _radixBuffer    state = bool _radixRoot root'' $ isNothing parent  -- TODO (enzo): Documentation.@@ -350,23 +356,23 @@    -> RadixTree database -- ^ Radix tree.    -> RadixTree database {-# INLINABLE insertRadixTreeBetween #-}-insertRadixTreeBetween (_:|roots, branch:|branches, prefix:|_, prefixOverflow, keyOverflow, cache) value tree@RadixTree {..} =+insertRadixTreeBetween (_:|roots, node:|nodes, prefix:|_, prefixOverflow, keyOverflow, cache) value tree@RadixTree {..} =    seq bloom $ setBloom bloom $ setBuffer buffer $ setCache cache $ setRoot state tree    where    prefix' = createPrefix $ drop 1 keyOverflow-   branch' = setPrefix prefix' $ Just value `setLeaf` def-   root' = createRoot branch'+   node' = setPrefix prefix' $ Just value `setLeaf` def+   root' = createRoot node'    prefix'' = createPrefix $ drop 1 prefixOverflow-   branch'' = setPrefix prefix'' branch-   root'' = createRoot branch''+   node'' = setPrefix prefix'' node+   root'' = createRoot node''    prefix''' = createPrefix $ drop 1 prefix `bool` prefix $ isNothing parent-   branch''' = setPrefix prefix''' $ setChildren children def-   root''' = createRoot branch'''+   node''' = setPrefix prefix''' $ setChildren children def+   root''' = createRoot node'''    test = head keyOverflow    children = bool id swap test (Just root', Just root'')-   parent = listToMaybe $ zip3 roots branches prefix+   parent = listToMaybe $ zip3 roots nodes prefix    bloom = flip insertList _radixBloom $ root''':root'':root':roots-   buffer = merkleSpoof root''' parent $ storeHot root''' branch''' $ storeHot root'' branch'' $ storeHot root' branch' _radixBuffer+   buffer = merkleSpoof root''' parent $ storeHot root''' node''' $ storeHot root'' node'' $ storeHot root' node' _radixBuffer    state = bool _radixRoot root''' $ isNothing parent  -- |@@ -385,38 +391,38 @@    then pure tree    else searchNonMerkleizedRadixTree key tree >>= \ case       Left err -> throw err-      Right result@(_, branches, prefix:|_, [], [], cache) ->-         case branches of+      Right result@(_, nodes, prefix:|_, [], [], cache) ->+         case nodes of             -- No children and no parent.-            RadixBranch _ Nothing Nothing _:|[] ->+            RadixNode _ Nothing Nothing _:|[] ->                pure $ deleteRadixTreeNoChildrenNoParent result tree             -- No children and parent with leaf.-            RadixBranch _ Nothing Nothing _:|parent:_ | isJust $ getLeaf parent ->+            RadixNode _ Nothing Nothing _:|parent:_ | isJust $ getLeaf parent ->                pure $ deleteRadixTreeNoChildrenParentWithLeaf result tree             -- No children and parent without leaf.-            RadixBranch _ Nothing Nothing _:|parent:_ -> do+            RadixNode _ Nothing Nothing _:|parent:_ -> do                let test = not $ head prefix                let root = fromJust $ getChild test parent                loadHot root _radixBuffer cache _radixDatabase >>= \ case                   Nothing -> throw $ StateRootDoesNotExist root-                  Just (branch, cache') ->-                     pure $ deleteRadixTreeNoChildrenParentWithoutLeaf result branch cache' test tree+                  Just (node, cache') ->+                     pure $ deleteRadixTreeNoChildrenParentWithoutLeaf result node cache' test tree             -- One left child.-            RadixBranch _ child Nothing _:|_ | isJust child -> do+            RadixNode _ child Nothing _:|_ | isJust child -> do                let test = False                let root = fromJust child                loadHot root _radixBuffer cache _radixDatabase >>= \ case                   Nothing -> throw $ StateRootDoesNotExist root-                  Just (branch, cache') ->-                     pure $ deleteRadixTreeOneChild result branch cache' test tree+                  Just (node, cache') ->+                     pure $ deleteRadixTreeOneChild result node cache' test tree             -- One right child.-            RadixBranch _ Nothing child _:|_ | isJust child -> do+            RadixNode _ Nothing child _:|_ | isJust child -> do                let test = True                let root = fromJust child                loadHot root _radixBuffer cache _radixDatabase >>= \ case                   Nothing -> throw $ StateRootDoesNotExist root-                  Just (branch, cache') ->-                     pure $ deleteRadixTreeOneChild result branch cache' test tree+                  Just (node, cache') ->+                     pure $ deleteRadixTreeOneChild result node cache' test tree             -- Two children.             _ -> pure $ deleteRadixTreeTwoChildren result tree       Right _ -> pure tree@@ -440,15 +446,15 @@    -> RadixTree database -- ^ Radix tree.    -> RadixTree database {-# INLINABLE deleteRadixTreeNoChildrenParentWithLeaf #-}-deleteRadixTreeNoChildrenParentWithLeaf (_:|_:roots, _:|branch:branches, prefix:|prefixes, _, _, cache) tree@RadixTree {..} =+deleteRadixTreeNoChildrenParentWithLeaf (_:|_:roots, _:|node:nodes, prefix:|prefixes, _, _, cache) tree@RadixTree {..} =    seq bloom $ setBloom bloom $ setBuffer buffer $ setCache cache $ setRoot state tree    where-   branch' = setChild test Nothing branch-   root' = createRoot branch'+   node' = setChild test Nothing node+   root' = createRoot node'    test = head prefix-   parent = listToMaybe $ zip3 roots branches $ map head prefixes+   parent = listToMaybe $ zip3 roots nodes $ map head prefixes    bloom = flip insertList _radixBloom $ root':roots-   buffer = merkleSpoof root' parent $ storeHot root' branch' _radixBuffer+   buffer = merkleSpoof root' parent $ storeHot root' node' _radixBuffer    state = bool _radixRoot root' $ isNothing parent deleteRadixTreeNoChildrenParentWithLeaf _ _ =    throw $ InvalidArgument "unknown parent"@@ -456,22 +462,22 @@ -- TODO (enzo): Documentation. deleteRadixTreeNoChildrenParentWithoutLeaf    :: RadixSearchResult -- ^ Search result.-   -> RadixBranch -- ^ Branch.-   -> RadixCache -- ^ Cache.+   -> RadixNode -- ^ Radix node.+   -> RadixCache -- ^ Radix cache.    -> Bool -- ^ Lineage.    -> RadixTree database -- ^ Radix tree.    -> RadixTree database {-# INLINABLE deleteRadixTreeNoChildrenParentWithoutLeaf #-}-deleteRadixTreeNoChildrenParentWithoutLeaf (_:|_:roots, _:|_:branches, _:|prefixes, _, _, _) branch@RadixBranch {..} cache test tree@RadixTree {..} =+deleteRadixTreeNoChildrenParentWithoutLeaf (_:|_:roots, _:|_:nodes, _:|prefixes, _, _, _) node@RadixNode {..} cache test tree@RadixTree {..} =    seq bloom $ setBloom bloom $ setBuffer buffer $ setCache cache $ setRoot state tree    where    prefix' = createPrefix $ drop 1 bits `bool` bits $ isNothing parent-   branch' = setPrefix prefix' branch-   root' = createRoot branch'+   node' = setPrefix prefix' node+   root' = createRoot node'    bits = head prefixes ++ test:maybe [] toBits _radixPrefix-   parent = listToMaybe $ zip3 roots branches $ map head prefixes+   parent = listToMaybe $ zip3 roots nodes $ map head prefixes    bloom = flip insertList _radixBloom $ root':roots-   buffer = merkleSpoof root' parent $ storeHot root' branch' _radixBuffer+   buffer = merkleSpoof root' parent $ storeHot root' node' _radixBuffer    state = bool _radixRoot root' $ isNothing parent deleteRadixTreeNoChildrenParentWithoutLeaf _ _ _ _ _ =    throw $ InvalidArgument "unknown parent"@@ -479,22 +485,22 @@ -- TODO (enzo): Documentation. deleteRadixTreeOneChild    :: RadixSearchResult -- ^ Search result.-   -> RadixBranch -- ^ Branch.-   -> RadixCache -- ^ Cache.+   -> RadixNode -- ^ Radix node.+   -> RadixCache -- ^ Radix cache.    -> Bool -- ^ Lineage.    -> RadixTree database -- ^ Radix tree.    -> RadixTree database {-# INLINABLE deleteRadixTreeOneChild #-}-deleteRadixTreeOneChild (_:|roots, _:|branches, prefix:|_, _, _, _) branch@RadixBranch {..} cache test tree@RadixTree {..} =+deleteRadixTreeOneChild (_:|roots, _:|nodes, prefix:|_, _, _, _) node@RadixNode {..} cache test tree@RadixTree {..} =    seq bloom $ setBloom bloom $ setBuffer buffer $ setCache cache $ setRoot state tree    where    prefix' = createPrefix $ drop 1 bits `bool` bits $ isNothing parent-   branch' = setPrefix prefix' branch-   root' = createRoot branch'+   node' = setPrefix prefix' node+   root' = createRoot node'    bits = prefix ++ test:maybe [] toBits _radixPrefix-   parent = listToMaybe $ zip3 roots branches prefix+   parent = listToMaybe $ zip3 roots nodes prefix    bloom = flip insertList _radixBloom $ root':roots-   buffer = merkleSpoof root' parent $ storeHot root' branch' _radixBuffer+   buffer = merkleSpoof root' parent $ storeHot root' node' _radixBuffer    state = bool _radixRoot root' $ isNothing parent  -- TODO (enzo): Documentation.@@ -503,34 +509,34 @@    -> RadixTree database -- ^ Radix tree.    -> RadixTree database {-# INLINABLE deleteRadixTreeTwoChildren #-}-deleteRadixTreeTwoChildren (_:|roots, branch:|branches, prefix:|_, _, _, cache) tree@RadixTree {..} =+deleteRadixTreeTwoChildren (_:|roots, node:|nodes, prefix:|_, _, _, cache) tree@RadixTree {..} =    seq bloom $ setBloom bloom $ setBuffer buffer $ setCache cache $ setRoot state tree    where-   branch' = setLeaf Nothing branch-   root' = createRoot branch'-   parent = listToMaybe $ zip3 roots branches prefix+   node' = setLeaf Nothing node+   root' = createRoot node'+   parent = listToMaybe $ zip3 roots nodes prefix    bloom = flip insertList _radixBloom $ root':roots-   buffer = merkleSpoof root' parent $ storeHot root' branch' _radixBuffer+   buffer = merkleSpoof root' parent $ storeHot root' node' _radixBuffer    state = bool _radixRoot root' $ isNothing parent  -- | -- Lookup a value in a radix tree.-lookupRadixTree+lookupRadixTree'    :: RadixDatabase config m database    => (ByteString -> RadixTree database -> m (Either RadixError RadixSearchResult)) -- ^ Search algorithm.    -> ByteString -- ^ Key.    -> RadixTree database -- ^ Radix tree.    -> m (Maybe (ByteString, RadixTree database))-{-# SPECIALISE lookupRadixTree+{-# SPECIALISE lookupRadixTree'    :: (ByteString -> RadixTree DB -> ResourceT IO (Either RadixError RadixSearchResult))    -> ByteString    -> RadixTree DB    -> ResourceT IO (Maybe (ByteString, RadixTree DB)) #-}-lookupRadixTree search key tree = do+lookupRadixTree' search key tree = do    found <- search key tree    case found of       Left err -> throw err-      Right (_, RadixBranch {..}:|_, _, prefixOverflow, keyOverflow, cache') ->+      Right (_, RadixNode {..}:|_, _, prefixOverflow, keyOverflow, cache') ->          if not $ List.null prefixOverflow && List.null keyOverflow          then pure Nothing          else pure $ do@@ -539,6 +545,19 @@             pure (value, tree')  -- |+-- A convenient alias for `lookupNonMerkleizedRadixTree`.+lookupRadixTree+   :: RadixDatabase config 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 config m database@@ -549,7 +568,7 @@    :: ByteString    -> RadixTree DB    -> ResourceT IO (Maybe (ByteString, RadixTree DB)) #-}-lookupMerkleizedRadixTree = lookupRadixTree searchMerkleizedRadixTree+lookupMerkleizedRadixTree = lookupRadixTree' searchMerkleizedRadixTree  -- | -- Lookup a value in a non-Merkleized radix tree.@@ -562,20 +581,20 @@    :: ByteString    -> RadixTree DB    -> ResourceT IO (Maybe (ByteString, RadixTree DB)) #-}-lookupNonMerkleizedRadixTree = lookupRadixTree searchNonMerkleizedRadixTree+lookupNonMerkleizedRadixTree = lookupRadixTree' searchNonMerkleizedRadixTree  -- |--- Mask a branch in a Merkleized radix tree.+-- Mask a node in a Merkleized radix tree. merkleSpoof    :: RadixRoot -- ^ State root.-   -> Maybe (RadixRoot, RadixBranch, Bool) -- ^ Parent.+   -> Maybe (RadixRoot, RadixNode, Bool) -- ^ Parent.    -> RadixBuffer -- ^ Buffer.    -> RadixBuffer {-# INLINABLE merkleSpoof #-} merkleSpoof mask = \ case    Nothing -> id-   Just (root, branch, test) ->-      storeHot root $ test `setChild` Just mask $ branch+   Just (root, node, test) ->+      storeHot root $ test `setChild` Just mask $ node  -- | -- Merkleize a radix tree. This will flush the buffer to disk.@@ -596,31 +615,31 @@       if not $ Bloom.elem root _radixBloom       then pure (root, cache)       else do-         -- Load the root branch.+         -- Load the root node.          result <- loadHot root _radixBuffer cache _radixDatabase          case result of             Nothing -> throw $ StateRootDoesNotExist root-            Just (branch@RadixBranch {..}, cache') ->+            Just (node@RadixNode {..}, cache') ->                case (_radixLeft, _radixRight) of                   -- No children.                   (Nothing, Nothing) ->-                     storeCold branch cache' _radixDatabase+                     storeCold node cache' _radixDatabase                   -- One left child.                   (Just child, Nothing) -> do                      (root', cache'') <- loop child cache'-                     let branch' = False `setChild` Just root' $ branch-                     storeCold branch' cache'' _radixDatabase+                     let node' = False `setChild` Just root' $ node+                     storeCold node' cache'' _radixDatabase                   -- One right child.                   (Nothing, Just child) -> do                      (root', cache'') <- loop child cache'-                     let branch' = True `setChild` Just root' $ branch-                     storeCold branch' cache'' _radixDatabase+                     let node' = True `setChild` Just root' $ node+                     storeCold node' cache'' _radixDatabase                   -- Two children.                   (Just left, Just right) -> do                      (root', cache'') <- loop left cache'                      (root'', cache''') <- loop right cache''-                     let branch' = setChildren (Just root', Just root'') branch-                     storeCold branch' cache''' _radixDatabase+                     let node' = setChildren (Just root', Just root'') node+                     storeCold node' cache''' _radixDatabase  -- | -- Create a conduit from a Merkleized radix tree.@@ -659,7 +678,7 @@             case result of                Nothing -> pure ()                Just bytes -> do-                  let RadixBranch {..} = deserialise $ fromStrict bytes+                  let RadixNode {..} = deserialise $ fromStrict bytes                   let success = all id $ zipWith (==) mask $ toBits $ fromShort _radixCheckpoint                   when success $ yield bytes                   forM_ [_radixLeft, _radixRight] $ \ case@@ -689,7 +708,7 @@          Nothing -> pure $ Left $ keys want          Just bytes ->             case deserialiseOrFail $ fromStrict bytes of-               Right RadixBranch {..} -> do+               Right RadixNode {..} -> do                   let key = Byte.take 20 $ hash bytes                   let root = toShort key                   let wanted = member root want@@ -741,35 +760,116 @@                   loop3 buffer'' want' candidates  -- |+-- Get the contents of a radix tree.+contentsRadixTree'+   :: RadixDatabase config m database+   => Bool -- ^ Overwrite state root?+   -> (RadixTree database -> m (Maybe (RadixNode, RadixCache))) -- ^ Loading strategy.+   -> RadixTree database -- ^ Radix tree.+   -> m [(ByteString, ByteString)]+{-# SPECIALISE contentsRadixTree'+   :: Bool+   -> (RadixTree DB -> ResourceT IO (Maybe (RadixNode, RadixCache)))+   -> RadixTree DB+   -> ResourceT IO [(ByteString, ByteString)] #-}+contentsRadixTree' flag strategy = \ tree@RadixTree {..} -> do+   let tree' = tree `bool` setRoot _radixCheckpoint tree $ flag+   loop tree' [] [] where+   loop tree@RadixTree {..} prefix accum = do+      result <- strategy tree+      case fst <$> result of+         Nothing -> throw $ StateRootDoesNotExist _radixRoot+         Just RadixNode {..} -> do+            let prefix' = prefix ++ maybe [] toBits _radixPrefix+            let key = fromBits prefix'+            let accum' = maybe accum (\ value -> (key, value):accum) _radixLeaf+            let children = [(,False) <$> _radixLeft, (,True) <$> _radixRight]+            flip foldM accum' `flip` children $ \ accum'' -> \ case+               Nothing -> pure accum''+               Just (root, test) -> do+                  let tree' = setRoot root tree+                  let prefix'' = prefix' ++ [test]+                  loop tree' prefix'' accum''++-- |+-- A convenient alias for `contentsNonMerkleizedRadixTree`.+contentsRadixTree+   :: RadixDatabase config m database+   => RadixTree database -- ^ Radix tree.+   -> m [(ByteString, ByteString)]+{-# SPECIALISE contentsRadixTree+   :: RadixTree DB+   -> ResourceT IO [(ByteString, ByteString)] #-}+contentsRadixTree = contentsNonMerkleizedRadixTree++-- |+-- Get the contents of a Merkleized radix tree.+contentsMerkleizedRadixTree+   :: RadixDatabase config m database+   => RadixTree database -- ^ Radix tree.+   -> m [(ByteString, ByteString)]+{-# SPECIALISE contentsMerkleizedRadixTree+   :: RadixTree DB+   -> ResourceT IO [(ByteString, ByteString)] #-}+contentsMerkleizedRadixTree =+   contentsRadixTree' True $ \ RadixTree {..} ->+      loadCold _radixRoot _radixCache _radixDatabase++-- |+-- Get the contents of a non-Merkleized radix tree.+contentsNonMerkleizedRadixTree+   :: RadixDatabase config m database+   => RadixTree database -- ^ Radix tree.+   -> m [(ByteString, ByteString)]+{-# SPECIALISE contentsNonMerkleizedRadixTree+   :: RadixTree DB+   -> ResourceT IO [(ByteString, ByteString)] #-}+contentsNonMerkleizedRadixTree =+   contentsRadixTree' False $ \ RadixTree {..} ->+      loadHot _radixRoot _radixBuffer _radixCache _radixDatabase++-- | -- Print a radix tree.-printRadixTree+printRadixTree'    :: MonadIO m    => RadixDatabase config m database    => Bool -- ^ Overwrite state root?-   -> (RadixTree database -> m (Maybe (RadixBranch, RadixCache))) -- ^ Loading strategy.+   -> (RadixTree database -> m (Maybe (RadixNode, RadixCache))) -- ^ Loading strategy.    -> RadixTree database -- ^ Radix tree.    -> m ()-{-# SPECIALISE printRadixTree+{-# SPECIALISE printRadixTree'    :: Bool-   -> (RadixTree DB -> ResourceT IO (Maybe (RadixBranch, RadixCache)))+   -> (RadixTree DB -> ResourceT IO (Maybe (RadixNode, RadixCache)))    -> RadixTree DB    -> ResourceT IO () #-}-printRadixTree flag strategy = \ tree@RadixTree {..} -> do+printRadixTree' flag strategy = \ tree@RadixTree {..} -> do    let tree' = tree `bool` setRoot _radixCheckpoint tree $ flag    loop tree' 0 where    loop tree@RadixTree {..} i = do       result <- strategy tree       case fst <$> result of          Nothing -> throw $ StateRootDoesNotExist _radixRoot-         Just branch@RadixBranch {..} -> do+         Just node@RadixNode {..} -> do             let indent = (++) $ concat $ replicate i "｜"-            liftIO $ putStrLn $ indent $ show branch+            liftIO $ putStrLn $ indent $ show node             let j = i + 1             forM_ [_radixLeft, _radixRight] $ \ case                Nothing -> pure ()                Just root -> setRoot root tree `loop` j  -- |+-- A convenient alias for `printNonMerkleizedRadixTree`.+printRadixTree+   :: MonadIO m+   => RadixDatabase config m database+   => RadixTree database -- ^ Radix tree.+   -> m ()+{-# SPECIALISE printRadixTree+   :: RadixTree DB+   -> ResourceT IO () #-}+printRadixTree = printNonMerkleizedRadixTree++-- | -- Print a Merkleized radix tree. printMerkleizedRadixTree    :: MonadIO m@@ -780,7 +880,7 @@    :: RadixTree DB    -> ResourceT IO () #-} printMerkleizedRadixTree =-   printRadixTree True $ \ RadixTree {..} ->+   printRadixTree' True $ \ RadixTree {..} ->       loadCold _radixRoot _radixCache _radixDatabase  -- |@@ -794,5 +894,5 @@    :: RadixTree DB    -> ResourceT IO () #-} printNonMerkleizedRadixTree =-   printRadixTree False $ \ RadixTree {..} ->+   printRadixTree' False $ \ RadixTree {..} ->       loadHot _radixRoot _radixBuffer _radixCache _radixDatabase
src/Network/DFINITY/RadixTree/Lenses.hs view
@@ -35,25 +35,25 @@  import Network.DFINITY.RadixTree.Types -makeLenses ''RadixBranch+makeLenses ''RadixNode makeLenses ''RadixTree -getPrefix :: RadixBranch -> Maybe RadixPrefix+getPrefix :: RadixNode -> Maybe RadixPrefix getPrefix = view radixPrefix -getLeft :: RadixBranch -> Maybe RadixRoot+getLeft :: RadixNode -> Maybe RadixRoot getLeft = view radixLeft -getRight :: RadixBranch -> Maybe RadixRoot+getRight :: RadixNode -> Maybe RadixRoot getRight = view radixRight -getChild :: Bool -> RadixBranch -> Maybe RadixRoot+getChild :: Bool -> RadixNode -> Maybe RadixRoot getChild = bool getLeft getRight -getChildren :: RadixBranch -> (Maybe RadixRoot, Maybe RadixRoot)-getChildren branch = (getLeft branch, getRight branch)+getChildren :: RadixNode -> (Maybe RadixRoot, Maybe RadixRoot)+getChildren node = (getLeft node, getRight node) -getLeaf :: RadixBranch -> Maybe ByteString+getLeaf :: RadixNode -> Maybe ByteString getLeaf = view radixLeaf  getBloom :: RadixTree database -> RadixBloom@@ -71,22 +71,22 @@ getRoot :: RadixTree database -> RadixRoot getRoot = view radixRoot -setPrefix :: Maybe RadixPrefix -> RadixBranch -> RadixBranch+setPrefix :: Maybe RadixPrefix -> RadixNode -> RadixNode setPrefix = set radixPrefix -setLeft :: Maybe RadixRoot -> RadixBranch -> RadixBranch+setLeft :: Maybe RadixRoot -> RadixNode -> RadixNode setLeft = set radixLeft -setRight :: Maybe RadixRoot -> RadixBranch -> RadixBranch+setRight :: Maybe RadixRoot -> RadixNode -> RadixNode setRight = set radixRight -setChild :: Bool -> Maybe RadixRoot -> RadixBranch -> RadixBranch+setChild :: Bool -> Maybe RadixRoot -> RadixNode -> RadixNode setChild = bool setLeft setRight -setChildren :: (Maybe RadixRoot, Maybe RadixRoot) -> RadixBranch -> RadixBranch+setChildren :: (Maybe RadixRoot, Maybe RadixRoot) -> RadixNode -> RadixNode setChildren (left, right) = setLeft left . setRight right -setLeaf :: Maybe ByteString -> RadixBranch -> RadixBranch+setLeaf :: Maybe ByteString -> RadixNode -> RadixNode setLeaf = set radixLeaf  setBloom :: RadixBloom -> RadixTree database -> RadixTree database
src/Network/DFINITY/RadixTree/Memory.hs view
@@ -25,16 +25,16 @@    -> RadixBuffer    -> RadixCache    -> database-   -> m (Maybe (RadixBranch, RadixCache))+   -> m (Maybe (RadixNode, RadixCache)) {-# SPECIALISE loadHot    :: RadixRoot    -> RadixBuffer    -> RadixCache    -> DB-   -> ResourceT IO (Maybe (RadixBranch, RadixCache)) #-}+   -> ResourceT IO (Maybe (RadixNode, RadixCache)) #-} loadHot root buffer cache database =    case Map.lookup root buffer of-      Just branch -> pure $ Just (branch, cache)+      Just node -> pure $ Just (node, cache)       Nothing -> loadCold root cache database  loadCold@@ -42,49 +42,49 @@    => RadixRoot    -> RadixCache    -> database-   -> m (Maybe (RadixBranch, RadixCache))+   -> m (Maybe (RadixNode, RadixCache)) {-# SPECIALISE loadCold    :: RadixRoot    -> RadixCache    -> DB-   -> ResourceT IO (Maybe (RadixBranch, RadixCache)) #-}+   -> ResourceT IO (Maybe (RadixNode, RadixCache)) #-} loadCold root cache database =    case LRU.lookup root cache of-      Just (branch, cache') ->-         seq cache' $ seq branch $ pure $ Just (branch, cache')+      Just (node, cache') ->+         seq cache' $ seq node $ pure $ Just (node, cache')       Nothing -> do          let key = fromShort root          result <- load database key          case result of             Just bytes -> do-               let branch = deserialise $ fromStrict bytes-               let cache' = LRU.insert root branch cache-               seq cache' $ seq branch $ pure $ Just (branch, cache')+               let node = deserialise $ fromStrict bytes+               let cache' = LRU.insert root node cache+               seq cache' $ seq node $ pure $ Just (node, cache')             Nothing -> pure $ Nothing  storeHot    :: RadixRoot-   -> RadixBranch+   -> RadixNode    -> RadixBuffer    -> RadixBuffer storeHot = Map.insert  storeCold    :: RadixDatabase config m database-   => RadixBranch+   => RadixNode    -> RadixCache    -> database    -> m (RadixRoot, RadixCache) {-# SPECIALISE storeCold-   :: RadixBranch+   :: RadixNode    -> RadixCache    -> DB    -> ResourceT IO (RadixRoot, RadixCache) #-}-storeCold branch cache database = do+storeCold node cache database = do    store database key bytes    seq cache' $ pure (root, cache')    where-   bytes = toStrict $ serialise branch+   bytes = toStrict $ serialise node    key = Byte.take 20 $ hash bytes    root = toShort key-   cache' = LRU.insert root branch cache+   cache' = LRU.insert root node cache
src/Network/DFINITY/RadixTree/Types.hs view
@@ -8,11 +8,12 @@  module Network.DFINITY.RadixTree.Types    ( RadixBloom-   , RadixBranch(..)+   , RadixBranch    , RadixBuffer    , RadixCache    , RadixDatabase(..)    , RadixError(..)+   , RadixNode(..)    , RadixPrefix(..)    , RadixRoot    , RadixSearchResult@@ -25,6 +26,7 @@ import Control.DeepSeq (NFData(..)) import Control.Exception (Exception) import Control.Monad (void)+import Control.Monad.State.Strict as State (StateT, get, modify) import Control.Monad.Trans.Resource (MonadResource) import Crypto.Hash.SHA256 (hash) import Data.BloomFilter (Bloom)@@ -37,10 +39,10 @@ import Data.Default.Class (Default(..)) import Data.List.NonEmpty (NonEmpty) import Data.LruCache (LruCache)-import Data.Map.Strict (Map)+import Data.Map.Strict as Map (Map, insert, lookup) import Data.Maybe (isJust) import Data.Monoid ((<>))-import Database.LevelDB (DB, Options, defaultReadOptions, defaultWriteOptions, get, open, put)+import Database.LevelDB as LevelDB (DB, Options, defaultReadOptions, defaultWriteOptions, get, open, put) import Text.Printf (printf)  import Network.DFINITY.RadixTree.Bits@@ -48,27 +50,55 @@  type RadixBloom = Bloom RadixRoot -data RadixBranch-   = RadixBranch+type RadixBranch = [RadixNode]++type RadixBuffer = Map RadixRoot RadixNode++type RadixCache = LruCache RadixRoot RadixNode++class Monad m => RadixDatabase config m database | database -> config where+   create :: config -> m database+   load :: database -> ByteString -> m (Maybe ByteString)+   store :: database -> ByteString -> ByteString -> m ()++instance Monad m => RadixDatabase () (StateT (Map ByteString ByteString) m) () where+   create = pure+   load _ key = Map.lookup key <$> State.get+   store _ key = modify . insert key++instance MonadResource m => RadixDatabase (FilePath, Options) m DB where+   create = uncurry open+   load database = LevelDB.get database defaultReadOptions+   store database = put database defaultWriteOptions++data RadixError+   = InvalidArgument String+   | StateRootDoesNotExist RadixRoot+     deriving (Data, Eq, Show)++instance Exception RadixError++data RadixNode+   = RadixNode    { _radixPrefix :: Maybe RadixPrefix    , _radixLeft :: Maybe RadixRoot    , _radixRight :: Maybe RadixRoot    , _radixLeaf :: Maybe ByteString    } deriving (Data, Eq) -instance NFData RadixBranch where-   rnf RadixBranch {..} =+instance NFData RadixNode where+   rnf RadixNode {..} =       rnf _radixPrefix `seq`       rnf _radixLeft `seq`       rnf _radixRight `seq`       rnf _radixLeaf `seq`       () -instance Default RadixBranch where-   def = RadixBranch Nothing Nothing Nothing Nothing+instance Default RadixNode where+   def = RadixNode Nothing Nothing Nothing Nothing -instance Serialise RadixBranch where-   encode RadixBranch {..} =+instance Serialise RadixNode where+   encode RadixNode {..} =       encodeListLen len <>       encodeMaybe CBOR.encode _radixPrefix <>       encodeMaybe encodeSide left <>@@ -84,10 +114,10 @@       left <- decodeMaybe $ toShort <$> decodeSide       right <- decodeMaybe $ toShort <$> decodeSide       leaf <- decodeLeaf len-      pure $ RadixBranch prefix left right leaf+      pure $ RadixNode prefix left right leaf -instance Show RadixBranch where-   show branch@RadixBranch {..} =+instance Show RadixNode where+   show node@RadixNode {..} =       case color 7 . unpack <$> _radixLeaf of          Nothing -> printf "%s@[%s,%s,%s]" root prefix left right          Just leaf -> printf "%s@[%s,%s,%s,%s]" root prefix left right leaf@@ -95,32 +125,11 @@       color :: Int -> String -> String       color = printf "\ESC[9%dm%s\ESC[0m"       format = take 8 . unpack . Base16.encode-      root = color 4 $ format $ hash $ toStrict $ serialise branch+      root = color 4 $ format $ hash $ toStrict $ serialise node       prefix = color 7 $ maybe "null" show _radixPrefix       left = color 4 $ maybe "null" format $ fromShort <$> _radixLeft       right = color 4 $ maybe "null" format $ fromShort <$> _radixRight -type RadixBuffer = Map RadixRoot RadixBranch--type RadixCache = LruCache RadixRoot RadixBranch--class Monad m => RadixDatabase config m database | database -> config where-   create :: config -> m database-   load :: database -> ByteString -> m (Maybe ByteString)-   store :: database -> ByteString -> ByteString -> m ()--instance MonadResource m => RadixDatabase (FilePath, Options) m DB where-   create = uncurry open-   load database = get database defaultReadOptions-   store database = put database defaultWriteOptions--data RadixError-   = InvalidArgument String-   | StateRootDoesNotExist RadixRoot-     deriving (Data, Eq, Show)--instance Exception RadixError- data RadixPrefix    = RadixPrefix    { _radixBitLen :: Int@@ -157,7 +166,7 @@  type RadixRoot = ShortByteString -type RadixSearchResult = (NonEmpty RadixRoot, NonEmpty RadixBranch, NonEmpty [Bool], [Bool], [Bool], RadixCache)+type RadixSearchResult = (NonEmpty RadixRoot, NonEmpty RadixNode, NonEmpty [Bool], [Bool], [Bool], RadixCache)  data RadixTree database    = RadixTree
src/Network/DFINITY/RadixTree/Utilities.hs view
@@ -21,7 +21,7 @@    then Nothing    else Just $ fromBits bits -createRoot :: RadixBranch -> RadixRoot+createRoot :: RadixNode -> RadixRoot createRoot = toShort . Byte.take 20 . hashlazy . serialise  defaultRoot :: RadixRoot
test/Main.hs view
@@ -8,19 +8,20 @@  module Main where -import Control.Monad (foldM_, mzero)+import Control.Arrow (first)+import Control.Monad (foldM_, mzero, void) import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Trans.Resource (MonadResource, runResourceT)+import Control.Monad.State.Strict (StateT, runStateT) import Data.Aeson (FromJSON(..), Object, Value(..), eitherDecode) import Data.ByteString.Base16 (decode, encode) import Data.ByteString.Char8 (ByteString, unpack) import Data.ByteString.Lazy.Char8 as Lazy (readFile) import Data.ByteString.Short (fromShort) import Data.Default.Class (Default(..))-import Data.HashMap.Strict as Map (elems, lookup)+import Data.HashMap.Strict as HashMap (elems, lookup)+import Data.Map.Strict (Map, empty) import Data.Text as Text (Text, drop) import Data.Text.Encoding (encodeUtf8)-import Database.LevelDB (DB, Options(..)) import System.Console.CmdArgs (Data, cmdArgs)  import Network.DFINITY.RadixTree@@ -28,12 +29,11 @@ data Args    = Args    { json :: FilePath-   , path :: FilePath    , test :: String    } deriving Data  instance Default Args where-   def = Args "test/tests.json" "test/testdb" "*"+   def = Args "test/tests.json" "*"  data Op    = Insert ByteString ByteString@@ -54,11 +54,9 @@       Merkleize value -> "Merkleize" ++ pretty value       where pretty = mappend " 0x" . unpack . encode -parse-   :: Object-   -> Maybe Op+parse :: Object -> Maybe Op parse object = do-   op <- Map.lookup "op" object+   op <- HashMap.lookup "op" object    case op of       "set" -> Insert <$> get "key" object <*> get "value" object       "delete" -> Delete <$> get "key" object@@ -66,21 +64,14 @@       "stateRoot" -> Merkleize <$> get "value" object       _ -> Nothing -get-   :: Text-   -> Object-   -> Maybe ByteString+get :: Text -> Object -> Maybe ByteString get key object = do-   value <- Map.lookup key object+   value <- HashMap.lookup key object    case value of       String text -> Just $ fst $ decode $ encodeUtf8 $ Text.drop 2 text       _ -> Nothing -step-   :: MonadResource m-   => RadixTree DB-   -> Op-   -> m (RadixTree DB)+step :: RadixTree () -> Op -> StateT (Map ByteString ByteString) IO (RadixTree ()) step tree op = do    liftIO $ print op    case op of@@ -97,24 +88,20 @@          case result of             Just (value', tree') | value == value' -> pure tree'             Just (value', _) -> throw-               [ "Expecting value "-               , ", but received value "-               , " for key "-               ] [value, value', key]+               ["Expecting value ", ", but received value ", " for key "]+               [value, value', key]             Nothing -> throw-               [ "Expecting value "-               , ", but received no value for key "-               ] [value, key]+               ["Expecting value ", ", but received no value for key "]+               [value, key]       Merkleize value -> do-         (fromShort -> value', tree') <- merkleizeRadixTree tree+         (value', tree') <- first fromShort <$> merkleizeRadixTree tree          if value == value'          then pure tree'          else throw-            [ "Expecting state root "-            , ", but received state root "-            ] [value, value']-      where-      throw err = fail . concat . zipWith mappend err . map show+            ["Expecting state root ", ", but received state root "]+            [value, value']+   where+   throw err = fail . concat . zipWith mappend err . map show  main :: IO () main = do@@ -122,11 +109,10 @@    contents <- Lazy.readFile json    case eitherDecode contents of       Left err -> fail err-      Right vctors -> runResourceT $ do-         let options = def {createIfMissing = True}-         tree <- createRadixTree 262144 2048 Nothing (path, options)+      Right vctors -> void $ flip runStateT empty $ do+         tree <- createRadixTree 262144 2048 Nothing ()          if test == "*"          then foldM_ step tree `mapM_` elems vctors-         else case Map.lookup test vctors of-            Nothing -> fail $ "unknown test vector: " ++ test+         else case HashMap.lookup test vctors of+            Nothing -> fail $ "Unknown test vector " ++ show test             Just ops -> foldM_ step tree $ concat [ops]