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

wip

This commit is contained in:
Dmitry Zuikov 2023-01-11 16:05:49 +03:00
parent 521f4c67c2
commit ccce9504a3
3 changed files with 15 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hbs2-core/lib/HBS2/Storage.hs
View File

@ -31,6 +31,8 @@ class ( Monad m
putBlock :: a -> Block block -> m (Maybe (Key block)) putBlock :: a -> Block block -> m (Maybe (Key block))
enqueueBlock :: a -> Block block -> m (Maybe (Key block))
getBlock :: a -> Key block -> m (Maybe (Block block)) getBlock :: a -> Key block -> m (Maybe (Block block))
getChunk :: a -> Key block -> Offset -> Size -> m (Maybe (Block block)) getChunk :: a -> Key block -> Offset -> Size -> m (Maybe (Block block))

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

@ -264,11 +264,12 @@ simpleGetChunkLazy s key off size = do
atomically $ TBMQ.readTBMQueue resQ >>= maybe (pure Nothing) pure atomically $ TBMQ.readTBMQueue resQ >>= maybe (pure Nothing) pure
simplePutBlockLazy :: SimpleStorage h simplePutBlockLazy :: Bool -- | wait
-> SimpleStorage h
-> LBS.ByteString -> LBS.ByteString
-> IO (Maybe (Key (Raw LBS.ByteString))) -> IO (Maybe (Key (Raw LBS.ByteString)))
simplePutBlockLazy s lbs = do simplePutBlockLazy doWait s lbs = do
let hash = hashObject lbs :: Key (Raw LBS.ByteString) let hash = hashObject lbs :: Key (Raw LBS.ByteString)
let fn = simpleBlockFileName s hash let fn = simpleBlockFileName s hash
@ -290,9 +291,11 @@ simplePutBlockLazy s lbs = do
simpleAddTask s action simpleAddTask s action
if doWait then do
ok <- atomically $ TBQ.readTBQueue waits ok <- atomically $ TBQ.readTBQueue waits
pure $! if ok then Just hash else Nothing pure $! if ok then Just hash else Nothing
else
pure $ Just hash
simpleBlockExists :: SimpleStorage h simpleBlockExists :: SimpleStorage h
@ -309,7 +312,9 @@ instance (MonadIO m, (Hashed hash (Raw LBS.ByteString)))
type instance StorageHash (SimpleStorage hash) (Raw LBS.ByteString) = hash type instance StorageHash (SimpleStorage hash) (Raw LBS.ByteString) = hash
putBlock s lbs = liftIO $ simplePutBlockLazy s lbs putBlock s lbs = liftIO $ simplePutBlockLazy True s lbs
enqueueBlock s lbs = liftIO $ simplePutBlockLazy False s lbs
getBlock s key = liftIO $ simpleGetBlockLazy s key getBlock s key = liftIO $ simpleGetBlockLazy s key

4
hbs2/Main.hs
View File

@ -59,12 +59,12 @@ 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! hashes <- readChunked handle (fromIntegral defBlockSize) -- FIXME: to settings!
& S.mapM (\blk -> putBlock ss (LBS.fromStrict blk) >> pure blk) & S.mapM (\blk -> enqueueBlock ss (LBS.fromStrict blk) >> pure blk)
& S.map hashObject & S.map hashObject
& S.map HashRef & S.map HashRef
& S.toList_ & S.toList_
let pt = toPTree (MaxSize 2048) (MaxNum 2048) hashes let pt = toPTree (MaxSize 2048) (MaxNum 2048) hashes -- FIXME: settings
root <- makeMerkle 0 pt $ \(h,_,bs) -> void $ putBlock ss bs root <- makeMerkle 0 pt $ \(h,_,bs) -> void $ putBlock ss bs