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

wip, writing log

This commit is contained in:
Dmitry Zuikov 2023-07-18 17:09:54 +03:00
parent 204de9afc6
commit 611c94c0ae
1 changed files with 7 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
hbs2-peer/app/RefChan.hs
View File

@ -201,6 +201,7 @@ refChanWorker env brains = do
sto <- getStorage sto <- getStorage
forever do forever do
pause @'Seconds 1 pause @'Seconds 1
_ <- atomically $ peekTQueue (view refChanWorkerEnvWriteQ env) _ <- atomically $ peekTQueue (view refChanWorkerEnvWriteQ env)
htrans <- liftIO $ atomically $ flushTQueue (view refChanWorkerEnvWriteQ env) htrans <- liftIO $ atomically $ flushTQueue (view refChanWorkerEnvWriteQ env)
@ -210,14 +211,14 @@ refChanWorker env brains = do
upd <- MaybeT $ pure $ deserialiseOrFail @(RefChanUpdate e) blk & either (const Nothing) Just upd <- MaybeT $ pure $ deserialiseOrFail @(RefChanUpdate e) blk & either (const Nothing) Just
case upd of case upd of
Propose chan _ -> pure (RefChanLogKey chan, h) Propose chan _ -> pure (RefChanLogKey @(Encryption e) chan, h)
Accept chan _ -> pure (RefChanLogKey chan, h) Accept chan _ -> pure (RefChanLogKey @(Encryption e) chan, h)
let byChan = HashMap.fromListWith (<>) [ (x, [y]) | (x,y) <- catMaybes trans ] let byChan = HashMap.fromListWith (<>) [ (x, [y]) | (x,y) <- catMaybes trans ]
-- FIXME: process-in-parallel -- FIXME: process-in-parallel
forM_ (HashMap.toList byChan) $ \(c,new) -> do forM_ (HashMap.toList byChan) $ \(c,new) -> do
mbLog <- liftIO $ getRef sto (RefChanLogKey @(Encryption e) c) mbLog <- liftIO $ getRef sto c
hashes <- maybe1 mbLog (pure mempty) $ \hlog -> do hashes <- maybe1 mbLog (pure mempty) $ \hlog -> do
S.toList_ $ do S.toList_ $ do
@ -232,15 +233,10 @@ refChanWorker env brains = do
-- -- FIXME: remove-chunk-num-hardcode -- -- FIXME: remove-chunk-num-hardcode
let pt = toPTree (MaxSize 256) (MaxNum 256) hashesNew let pt = toPTree (MaxSize 256) (MaxNum 256) hashesNew
newRoot <- liftIO do nref <- makeMerkle 0 pt $ \(_,_,bss) -> void $ liftIO $ putBlock sto bss
nref <- makeMerkle 0 pt $ \(_,_,bss) -> do liftIO $ updateRef sto c nref
void $ putBlock sto bss
-- updateRef sto c nref debug $ "REFCHANLOG UPDATED:" <+> pretty c <+> pretty nref
pure ()
pure ()
refChanHeadPoll = do refChanHeadPoll = do