From 8617b91d426cf81ea50741ff6e45e54c29441731 Mon Sep 17 00:00:00 2001 From: Sergey Ivanov Date: Mon, 13 Mar 2023 20:57:04 +0400 Subject: [PATCH] Implemented broadcastLRef --- docs/devlog.md | 14 ++++ hbs2-core/lib/HBS2/Net/Proto/RefLinear.hs | 8 +- hbs2-peer/app/PeerMain.hs | 90 ++++++++++------------- 3 files changed, 57 insertions(+), 55 deletions(-) diff --git a/docs/devlog.md b/docs/devlog.md index 23f57c9b..9084ad0d 100644 --- a/docs/devlog.md +++ b/docs/devlog.md @@ -837,3 +837,17 @@ FIXME: Обработка ошибок в асинхронном приложе +## 2023-03-13 + +* [x] broadcastLRefI + +FIXME: RPC, cli для линейных ссылок + +* [ ] lref-new через rpc пира new +* [ ] lref-get через rpc пира get +* [ ] lref-update через rpc пира update + +* [ ] lref-list через rpc пира list + +* [ ] cli на запрос значений ссылки у всех нод +* [ ] cli на запрос всех ссылок ноды diff --git a/hbs2-core/lib/HBS2/Net/Proto/RefLinear.hs b/hbs2-core/lib/HBS2/Net/Proto/RefLinear.hs index b0e0814d..6fb1d87a 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/RefLinear.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/RefLinear.hs @@ -32,7 +32,7 @@ data LRefI e m = { getBlockI :: GetBlockI HbSync m , tryUpdateLinearRefI :: TryUpdateLinearRefI e HbSync m , getLRefValI :: GetLRefValI e HbSync m - , announceLRefValI :: AnnounceLRefValI e HbSync m + , broadcastLRefI :: BroadcastLRefI e HbSync m } type GetBlockI h m = Hash h -> m (Maybe ByteString) @@ -41,7 +41,7 @@ type TryUpdateLinearRefI e h m = Hash h -> Signed SignatureVerified (MutableRef type GetLRefValI e h m = Hash h -> m (Maybe (Signed SignaturePresent (MutableRef e 'LinearRef))) -type AnnounceLRefValI e h m = Hash h -> m () +type BroadcastLRefI e h m = LRefProto e -> m () refLinearProto :: forall e m . ( MonadIO m @@ -64,7 +64,9 @@ refLinearProto LRefI{..} = \case lift $ forM_ (verifyLinearMutableRefSigned (refOwner g) lref) \vlref -> do r <- tryUpdateLinearRefI h vlref - when r (announceLRefValI h) + when r $ void $ runMaybeT do + slref <- MaybeT (getLRefValI h) + lift $ broadcastLRefI (AnnLRef @e h slref) LRefGetVal h -> void $ runMaybeT do slref <- MaybeT (getLRefValI h) diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 3e5e194c..8a6fdc8e 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -361,35 +361,6 @@ forKnownPeers m = do pd' <- find (KnownPeerKey p) id maybe1 pd' (pure ()) (m p) -mkLRefAdapter :: forall e st block m . - ( m ~ PeerM e IO - , Signatures e - , Serialise (Signature e) - , Serialise (PubKey 'Sign e) - , Eq (PubKey 'Sign e) - ) - => m (LRefI e (CredentialsM e (ResponseM e m))) -mkLRefAdapter = do - st <- getStorage - - let - - getBlockI = liftIO . getBlock st - - tryUpdateLinearRefI h = liftIO . tryUpdateLinearRef st h - - getLRefValI h = (liftIO . runMaybeT) do - refvalraw <- MaybeT $ (readLinkRaw st h) `orLogError` "error reading ref val" - MaybeT $ pure ((either (const Nothing) Just - . deserialiseOrFail @(Signed SignaturePresent (MutableRef e 'LinearRef))) refvalraw) - `orLogError` "can not parse channel ref" - - announceLRefValI h = do - -- FIXME: implement announceLRefValI - pure () - - pure LRefI {..} - runPeer :: forall e . e ~ UDP => PeerOpts -> IO () runPeer opts = Exception.handle myException $ do @@ -491,11 +462,43 @@ runPeer opts = Exception.handle myException $ do penv <- newPeerEnv (AnyStorage s) (Fabriq mess) (getOwnPeer mess) + let + broadcastMsgAction msg = runPeerM penv do + env <- ask + broadcastMsgAction' env msg + + broadcastMsgAction' :: (MonadIO m) => PeerEnv e -> LRefProto e -> PeerM e m () + broadcastMsgAction' env msg = do + debug "send multicast msg" + request localMulticast msg + withPeerM env do + forKnownPeers $ \p _ -> do + debug $ "send single-cast msg" <+> pretty p + request @e p msg + + let + getLRefValAction :: (MonadIO m) + => AnyStorage -> Hash HbSync -> m (Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef))) + getLRefValAction st h = runMaybeT do + refvalraw <- MaybeT $ (liftIO $ readLinkRaw st h) `orLogError` "error reading ref val" + MaybeT $ pure ((either (const Nothing) Just + . deserialiseOrFail @(Signed SignaturePresent (MutableRef e 'LinearRef))) refvalraw) + `orLogError` "can not parse channel ref" + loop <- async do runPeerM penv $ do adapter <- mkAdapter - lrefAdapter <- mkLRefAdapter + + lrefAdapter <- do + st <- getStorage + let + getBlockI = liftIO . getBlock st + tryUpdateLinearRefI h = liftIO . tryUpdateLinearRef st h + broadcastLRefI = broadcastMsgAction + getLRefValI = getLRefValAction st + pure LRefI {..} + env <- ask pnonce <- peerNonce @e @@ -518,6 +521,8 @@ runPeer opts = Exception.handle myException $ do subscribe @e AnyKnownPeerEventKey $ \(KnownPeerEvent p d) -> do + -- subscribe @e LRefUpdateFromNodeKey $ \(KnownPeerEvent p d) -> do + let thatNonce = view peerOwnNonce d banned <- peerBanned p d @@ -631,29 +636,10 @@ runPeer opts = Exception.handle myException $ do ANNLREF h -> do debug $ "got annlref rpc" <+> pretty h - sto <- getStorage - + st <- getStorage void $ runMaybeT do - - refvalraw <- MaybeT $ (liftIO $ readLinkRaw sto h) - `orLogError` "error reading ref val" - slref@(LinearMutableRefSigned _ ref) <- MaybeT $ - pure ((either (const Nothing) Just - . deserialiseOrFail @(Signed SignaturePresent (MutableRef e 'LinearRef))) refvalraw) - `orLogError` "can not parse channel ref" - - let annlref :: LRefProto UDP - annlref = AnnLRef @e h slref - - lift do - - debug "send multicast annlref" - request localMulticast annlref - - withPeerM env do - forKnownPeers $ \p _ -> do - debug $ "send single-cast annlrefs" <+> pretty p - request @e p annlref + slref <- MaybeT $ getLRefValAction st h + lift $ broadcastMsgAction' env (AnnLRef @e h slref :: LRefProto UDP) CHECK nonce pa h -> do pip <- fromPeerAddr @e pa