voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

compiles

This commit is contained in:
Dmitry Zuikov 2023-01-17 09:36:53 +03:00
parent ff2438009d
commit 48d9306ec1
2 changed files with 20 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs
View File

@ -1,8 +1,12 @@
{-# Language UndecidableInstances #-}
module HBS2.Storage.Simple.Extra where module HBS2.Storage.Simple.Extra where
import HBS2.Merkle import HBS2.Merkle
import HBS2.Hash
import HBS2.Prelude import HBS2.Prelude
import HBS2.Storage.Simple import HBS2.Storage.Simple
import HBS2.Data.Types.Refs
import HBS2.Defaults
import Control.Monad import Control.Monad
import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy (ByteString)
@ -11,8 +15,8 @@ import Data.Function
import Streaming.Prelude qualified as S import Streaming.Prelude qualified as S
import System.IO import System.IO
class SimpleStorageExtra a where class IsKey h => SimpleStorageExtra h a where
putAsMerkle :: SimpleStorage h -> a -> MerkleHash putAsMerkle :: SimpleStorage h -> a -> IO MerkleHash
readChunked :: MonadIO m => Handle -> Int -> S.Stream (S.Of ByteString) m () readChunked :: MonadIO m => Handle -> Int -> S.Stream (S.Of ByteString) m ()
readChunked handle size = fuu readChunked handle size = fuu
@ -24,6 +28,17 @@ readChunked handle size = fuu
S.yield chunk S.yield chunk
next next
-- instance SimpleStorageExtra Handle where instance (IsKey h, Key h ~ Hash h, Hashed h ByteString) => SimpleStorageExtra h Handle where
-- putAsMerkle ss handle = undefined putAsMerkle ss handle = do
hashes <- readChunked handle (fromIntegral defBlockSize) -- FIXME: to settings!
& S.mapM (\blk -> enqueueBlock ss blk >> pure blk)
& S.map (HashRef . hashObject)
& S.toList_
let pt = toPTree (MaxSize 8192) (MaxNum 8192) hashes -- FIXME: settings
root <- makeMerkle 0 pt $ \(_,_,bs) -> void $ putBlock ss bs
pure (MerkleHash root)

9
hbs2/Main.hs
View File

@ -110,14 +110,7 @@ runStore opts ss = do
handle <- maybe (pure stdin) (flip openFile ReadMode . unOptFile) fname handle <- maybe (pure stdin) (flip openFile ReadMode . unOptFile) fname
hashes <- readChunked handle (fromIntegral defBlockSize) -- FIXME: to settings! root <- putAsMerkle ss handle
& S.mapM (\blk -> enqueueBlock ss blk >> pure blk)
& S.map (HashRef . hashObject)
& S.toList_
let pt = toPTree (MaxSize 8192) (MaxNum 8192) hashes -- FIXME: settings
root <- makeMerkle 0 pt $ \(h,_,bs) -> void $ putBlock ss bs
print $ "merkle-root: " <+> pretty root print $ "merkle-root: " <+> pretty root