-
Notifications
You must be signed in to change notification settings - Fork 95
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #16 from kadena-io/edmundnoble/table-abstraction
Add a Table abstraction replacing the Cas abstraction
- Loading branch information
Showing
12 changed files
with
607 additions
and
730 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -8,17 +8,18 @@ | |
| {-# LANGUAGE ScopedTypeVariables #-} | ||
| {-# LANGUAGE TypeApplications #-} | ||
| {-# LANGUAGE TypeFamilies #-} | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
|
|
||
| -- | | ||
| -- Module: Data.DedupStore | ||
| -- Module: Chainweb.Storage.DedupStore | ||
| -- Copyright: Copyright © 2019 Kadena LLC. | ||
| -- License: MIT | ||
| -- Maintainer: Lars Kuhtz <[email protected]> | ||
| -- Stability: experimental | ||
| -- | ||
| -- A Deduplicated Key-Value Store | ||
| -- | ||
| module Data.DedupStore | ||
| module Chainweb.Storage.DedupStore | ||
| ( | ||
| -- * Deduplicated Key-Value Store | ||
| DedupStore(..) | ||
|
|
@@ -46,7 +47,6 @@ import qualified Data.ByteString as B | |
| import qualified Data.ByteString.Builder as BB | ||
| import qualified Data.ByteString.Lazy as BL | ||
| import qualified Data.ByteString.Unsafe as BU | ||
| import Data.CAS | ||
| import Data.Hashable | ||
| import Data.Int | ||
| import qualified Data.List as L | ||
|
|
@@ -64,7 +64,8 @@ import System.IO.Unsafe | |
|
|
||
| -- internal modules | ||
|
|
||
| import Data.CAS.RocksDB | ||
| import Chainweb.Storage.Table | ||
| import Chainweb.Storage.Table.RocksDB | ||
|
|
||
| -- -------------------------------------------------------------------------- -- | ||
| -- Utils | ||
|
|
@@ -111,7 +112,7 @@ instance Exception DedupStoreException | |
| -- | ||
| data DedupStore k v = DedupStore | ||
| { _dedupRoots :: !(RocksDbTable k DedupHash) | ||
| , _dedupChunks :: !(RocksDbCas Chunk) | ||
| , _dedupChunks :: !(Casify RocksDbTable Chunk) | ||
| , _dedupValueCodec :: !(Codec v) | ||
| } | ||
|
|
||
|
|
@@ -126,7 +127,7 @@ newDedupStore | |
| -> DedupStore k v | ||
| newDedupStore rdb vc kc n = DedupStore | ||
| { _dedupRoots = newTable rdb dedupHashCodec kc (n <> ["roots"]) | ||
| , _dedupChunks = newCas rdb dedupChunkCodec dedupHashCodec (n <> ["chunks"]) | ||
| , _dedupChunks = Casify $ newTable rdb dedupChunkCodec dedupHashCodec (n <> ["chunks"]) | ||
| , _dedupValueCodec = vc | ||
| } | ||
| where | ||
|
|
@@ -155,7 +156,7 @@ dedupInsert :: DedupStore k v -> k -> v -> IO () | |
| dedupInsert store k v = do | ||
| dedupKey <- dedupStore (_dedupChunks store) | ||
| $ BL.fromStrict $ _codecEncode (_dedupValueCodec store) v | ||
| tableInsert (_dedupRoots store) k dedupKey | ||
| tableInsert (_dedupRoots store) k dedupKey | ||
| {-# INLINE dedupInsert #-} | ||
|
|
||
| -- | @dedupLookup db k@ returns 'Just' the value at key @k@ in the | ||
|
|
@@ -185,7 +186,7 @@ instance IsCasValue Chunk where | |
| type CasKeyType Chunk = DedupHash | ||
| casKey (Chunk _ h _) = h | ||
|
|
||
| type DedupCas cas = (IsCas cas, CasValueType cas ~ Chunk) | ||
| type DedupCas cas = Cas cas Chunk | ||
|
|
||
| -- | Store a sequence of bytes in a deduplicated content addressed store. | ||
| -- Returns the hash of the bytes, that can be used to query the data from the | ||
|
|
@@ -217,15 +218,15 @@ dedupStore' store = go0 | |
| where | ||
| go0 :: HasCallStack => BL.ByteString -> IO (Int, Int, DedupHash) | ||
| go0 bytes = mapM (hashAndStore 0x0) (toChunks $ roll bytes) >>= \case | ||
| [] -> error "Data.DedupStore.dedupStore.go0: Data.ByteString.Lazy.toChunks must not return an empty list" | ||
| [] -> error "Chainweb.Storage.DedupStore.dedupStore.go0: Data.ByteString.Lazy.toChunks must not return an empty list" | ||
| [x] -> return x | ||
| l -> do | ||
| (h, m, r) <- go1 (third3 <$> l) | ||
| return (sum (fst3 <$> l) + h, sum (snd3 <$> l) + m, r) | ||
|
|
||
| go1 :: HasCallStack => [DedupHash] -> IO (Int, Int, DedupHash) | ||
| go1 hashes = mapM (hashAndStore 0x1) (rollHashes hashes) >>= \case | ||
| [] -> error "Data.DedupStore.dedupStore.go1: Data.ByteString.Lazy.toChunks must not return an empty list" | ||
| [] -> error "Chainweb.Storage.DedupStore.dedupStore.go1: Data.ByteString.Lazy.toChunks must not return an empty list" | ||
| [x] -> return x | ||
| l -> do | ||
| (h, m, r) <- go1 (third3 <$> l) | ||
|
|
@@ -245,10 +246,10 @@ dedupStore' store = go0 | |
| hashAndStore :: Word8 -> B.ByteString -> IO (Int, Int, DedupHash) | ||
| hashAndStore tag c = do | ||
| let h = DedupHash $ BA.convert $ C.hash @_ @DedupHashAlg (B.cons tag c) | ||
| (hit, miss) <- casMember store h >>= \x -> if x | ||
| (hit, miss) <- tableMember store h >>= \x -> if x | ||
| then return (1, 0) | ||
| else do | ||
| casInsert store (Chunk tag h c) | ||
| casInsert store (Chunk tag h c) | ||
| return (0, 1) | ||
| return (hit, miss, h) | ||
| {-# INLINE hashAndStore #-} | ||
|
|
@@ -275,15 +276,15 @@ dedupRestore | |
| -> DedupHash | ||
| -> IO (Maybe BL.ByteString) | ||
| dedupRestore store key = fmap BB.toLazyByteString <$> do | ||
| casLookup store key >>= \case | ||
| tableLookup store key >>= \case | ||
| Nothing -> return Nothing | ||
| Just (Chunk 0x0 _ b) -> return $ Just $ BB.byteString b | ||
| Just (Chunk 0x1 _ b) -> Just <$> splitHashes b | ||
| _ -> throwM $ DedupStoreCorruptedData "Unknown chunk tag" | ||
|
|
||
| where | ||
| go h = do | ||
| casLookup store h >>= \case | ||
| tableLookup store h >>= \case | ||
| Nothing -> throwM $ DedupStoreCorruptedData "Missing chunk from store" | ||
| Just (Chunk 0x0 _ b) -> return (BB.byteString b) | ||
| Just (Chunk 0x1 _ b) -> splitHashes b | ||
|
|
@@ -310,7 +311,7 @@ roll :: BL.ByteString -> BL.ByteString | |
| roll z = BL.fromChunks $ go seed 0 z za ze | ||
| where | ||
| z' = BL.unpack z | ||
| za = (BL.unpack $ BL.replicate window 0) <> z' | ||
| za = BL.unpack (BL.replicate window 0) <> z' | ||
| {-# SCC za #-} | ||
| ze = z' | ||
| {-# SCC ze #-} | ||
|
|
||
Oops, something went wrong.