diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs index 8a2dda82..4a5e9b35 100644 --- a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs +++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs @@ -79,7 +79,7 @@ storageBlocks = to f simpleStorageInit :: (MonadIO m, Data opts) => opts -> m (SimpleStorage h) simpleStorageInit opts = liftIO $ do let prefix = uniLastDef "." opts :: StoragePrefix - let qSize = uniLastDef 100 opts :: StorageQueueSize + let qSize = uniLastDef 500 opts :: StorageQueueSize pdir <- canonicalizePath (fromPrefix prefix) @@ -119,7 +119,8 @@ simpleStorageStop ss = do atomically $ TV.writeTVar ( ss ^. storageStopWriting ) True fix \next -> do mt <- atomically $ TBMQ.isEmptyTBMQueue ( ss ^. storageOpQ ) - if mt then + if mt then do + atomically $ TBMQ.closeTBMQueue ( ss ^. storageOpQ ) pure () else pause ( 0.01 :: Timeout 'Seconds ) >> next @@ -127,12 +128,11 @@ simpleStorageStop ss = do simpleStorageWorker :: SimpleStorage h -> IO () simpleStorageWorker ss = do - ops <- async $ forever $ do - + ops <- async $ fix \next -> do s <- atomically $ do TBMQ.readTBMQueue ( ss ^. storageOpQ ) case s of Nothing -> pure () - Just a -> a + Just a -> a >> next killer <- async $ forever $ do pause ( 30 :: Timeout 'Seconds ) -- FIXME: setting diff --git a/hbs2/Main.hs b/hbs2/Main.hs index 5a6f32ac..6c5025e8 100644 --- a/hbs2/Main.hs +++ b/hbs2/Main.hs @@ -27,7 +27,9 @@ import HBS2.Defaults newtype HashRef = HashRef (Hash HbSync) deriving newtype (Eq,Ord,IsString,Pretty) - deriving stock (Data) + deriving stock (Data,Generic) + +instance Serialise HashRef newtype OptInputFile = OptInputFile { unOptFile :: FilePath } deriving newtype (Eq,Ord,IsString) @@ -64,10 +66,9 @@ runStore opts ss = do let pt = toPTree (MaxSize 2048) (MaxNum 2048) hashes - -- mapM_ (print . pretty) hashes - - pure () + root <- makeMerkle 0 pt $ \(h,_,bs) -> void $ putBlock ss bs + print $ "merkle-root: " <+> pretty root withStore :: Data opts => opts -> ( SimpleStorage HbSync -> IO () ) -> IO () withStore opts f = do @@ -76,13 +77,13 @@ withStore opts f = do let pref = uniLastDef xdg opts :: StoragePrefix s <- simpleStorageInit (Just pref) - storage <- async $ simpleStorageWorker s + w <- replicateM 4 $ async $ simpleStorageWorker s f s simpleStorageStop s - _ <- waitAnyCatch [storage] + _ <- waitAnyCatch w pure ()