diff --git a/hbs2-core/lib/HBS2/Storage.hs b/hbs2-core/lib/HBS2/Storage.hs index e2d5f00f..5465f777 100644 --- a/hbs2-core/lib/HBS2/Storage.hs +++ b/hbs2-core/lib/HBS2/Storage.hs @@ -31,6 +31,8 @@ class ( Monad m putBlock :: a -> Block block -> m (Maybe (Key block)) + enqueueBlock :: a -> Block block -> m (Maybe (Key block)) + getBlock :: a -> Key block -> m (Maybe (Block block)) getChunk :: a -> Key block -> Offset -> Size -> m (Maybe (Block block)) diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs index 4a5e9b35..4cc19a95 100644 --- a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs +++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs @@ -264,11 +264,12 @@ simpleGetChunkLazy s key off size = do atomically $ TBMQ.readTBMQueue resQ >>= maybe (pure Nothing) pure -simplePutBlockLazy :: SimpleStorage h +simplePutBlockLazy :: Bool -- | wait + -> SimpleStorage h -> 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 fn = simpleBlockFileName s hash @@ -290,9 +291,11 @@ simplePutBlockLazy s lbs = do simpleAddTask s action - ok <- atomically $ TBQ.readTBQueue waits - - pure $! if ok then Just hash else Nothing + if doWait then do + ok <- atomically $ TBQ.readTBQueue waits + pure $! if ok then Just hash else Nothing + else + pure $ Just hash simpleBlockExists :: SimpleStorage h @@ -309,7 +312,9 @@ instance (MonadIO m, (Hashed hash (Raw LBS.ByteString))) 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 diff --git a/hbs2/Main.hs b/hbs2/Main.hs index 6c5025e8..62d4d7ad 100644 --- a/hbs2/Main.hs +++ b/hbs2/Main.hs @@ -59,12 +59,12 @@ runStore opts ss = do handle <- maybe (pure stdin) (flip openFile ReadMode . unOptFile) fname 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 HashRef & 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