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

fixed 6kx1sdj7ej

This commit is contained in:
Dmitry Zuikov 2023-04-05 05:03:22 +03:00
parent 485e1974a2
commit f035827731
4 changed files with 9 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
.fixme/log
View File

@ -1,10 +1,3 @@
(fixme-set "workflow" "test" "5dkZ3UqkiT") (fixme-set "workflow" "test" "6kx1sdj7ej")
(fixme-set "assigned" "voidlizard" "5dkZ3UqkiT") (fixme-set "assigned" "voidlizard" "6kx1sdj7ej")
(fixme-set "workflow" "test" "3Xv2bBY3ac")
(fixme-set "assigned" "fastpok" "3Xv2bBY3ac")
(fixme-set "workflow" "test" "9MT1XdzCy8")
(fixme-set "assigned" "voidlizard" "9MT1XdzCy8")
(fixme-set "workflow" "test" "6mTMkyQUYR")
(fixme-set "assigned" "voidlizard" "6mTMkyQUYR")
(fixme-set "workflow" "backlog" "GYiBo1ubTf")

6
hbs2-core/lib/HBS2/Net/Proto/RefLog.hs
View File

@ -37,10 +37,9 @@ data RefLogUpdate e =
makeLenses 'RefLogUpdate makeLenses 'RefLogUpdate
data RefLogUpdateI e m = newtype RefLogUpdateI e m =
RefLogUpdateI RefLogUpdateI
{ refLogUpdate :: (PubKey 'Sign e, RefLogUpdate e) -> m () { refLogBroadcast :: RefLogUpdate e -> m ()
, refLogBroadcast :: RefLogUpdate e -> m ()
} }
data RefLogUpdateEv e data RefLogUpdateEv e
@ -188,7 +187,6 @@ refLogUpdateProto adapter =
-- FIXME: refactor:use-type-application-for-deferred -- FIXME: refactor:use-type-application-for-deferred
deferred proto do deferred proto do
emit @e RefLogUpdateEvKey (RefLogUpdateEvData (pubk, e)) emit @e RefLogUpdateEvKey (RefLogUpdateEvData (pubk, e))
refLogUpdate adapter (pubk, e)
refLogBroadcast adapter e refLogBroadcast adapter e
pure () pure ()

7
hbs2-peer/app/PeerMain.hs
View File

@ -561,7 +561,7 @@ runPeer opts = Exception.handle myException $ do
let addNewRtt (p,rttNew) = withPeerM penv $ void $ runMaybeT do let addNewRtt (p,rttNew) = withPeerM penv $ void $ runMaybeT do
def <- newPeerInfo def <- newPeerInfo
tv <- lift $ fetch True def (PeerInfoKey p) (view peerRTTBuffer) tv <- lift $ fetch True def (PeerInfoKey p) (view peerRTTBuffer)
insertRTT rttNew tv insertRTT rttNew tv
let hshakeAdapter = PeerHandshakeAdapter addNewRtt let hshakeAdapter = PeerHandshakeAdapter addNewRtt
env <- ask env <- ask
@ -638,7 +638,7 @@ runPeer opts = Exception.handle myException $ do
debug "Same peer, different address" debug "Same peer, different address"
void $ runMaybeT do void $ runMaybeT do
pinfo0 <- MaybeT $ find (PeerInfoKey p0) id pinfo0 <- MaybeT $ find (PeerInfoKey p0) id
pinfo1 <- MaybeT $ find (PeerInfoKey p) id pinfo1 <- MaybeT $ find (PeerInfoKey p) id
@ -778,7 +778,8 @@ runPeer opts = Exception.handle myException $ do
warn "unable to parse RefLogUpdate message" warn "unable to parse RefLogUpdate message"
maybe1 msg' none $ \msg -> do maybe1 msg' none $ \msg -> do
RefLog.doRefLogUpdate (view refLogId msg, msg) let pubk = view refLogId msg
emit @e RefLogUpdateEvKey (RefLogUpdateEvData (pubk, msg))
RefLog.doRefLogBroadCast msg RefLog.doRefLogBroadCast msg
_ -> pure () _ -> pure ()

12
hbs2-peer/app/RefLog.hs
View File

@ -41,15 +41,6 @@ import Control.Concurrent.Async
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Lens.Micro.Platform import Lens.Micro.Platform
doRefLogUpdate :: forall e m . ( MonadIO m
, Pretty (AsBase58 (PubKey 'Sign e))
)
=> (PubKey 'Sign e, RefLogUpdate e) -> m ()
doRefLogUpdate (reflog, _) = do
trace $ "doRefLogUpdate" <+> pretty (AsBase58 reflog)
pure ()
doRefLogBroadCast :: forall e m . ( MonadIO m doRefLogBroadCast :: forall e m . ( MonadIO m
, MyPeer e , MyPeer e
, HasPeerLocator e m , HasPeerLocator e m
@ -100,8 +91,7 @@ mkAdapter :: forall e m . ( MonadIO m
mkAdapter = do mkAdapter = do
let bcast = lift . doRefLogBroadCast @e let bcast = lift . doRefLogBroadCast @e
let upd = lift . doRefLogUpdate @e pure $ RefLogUpdateI bcast
pure $ RefLogUpdateI upd bcast
data RefLogWorkerAdapter e = data RefLogWorkerAdapter e =