lwwref content download

hbs2-peer/app/PeerMain.hs

@@ -1004,6 +1004,10 @@ runPeer opts = Exception.handle (\e -> myException e
                                             err $ red "Exception" <+> "in thread" <+> pretty t <+> viaShow e
                                             liftIO $ throwTo myself GoAgainException
 
+
+              let lwwRefProtoA = lwwRefProto (LWWRefProtoAdapter { lwwFetchBlock = download })
+                   where download h = withPeerM env $ withDownload denv (addDownload Nothing h)
+
               flip runContT pure do
 
                 peerThread "local multicast" $ forever $ do
@@ -1054,7 +1058,7 @@ runPeer opts = Exception.handle (\e -> myException e
                     , makeResponse (refChanRequestProto False refChanAdapter)
                     , makeResponse (refChanNotifyProto False refChanAdapter)
                     -- TODO: change-all-to-authorized
-                    , makeResponse ((authorized . subscribed (SomeBrains brains)) lwwRefProto)
+                    , makeResponse ((authorized . subscribed (SomeBrains brains)) lwwRefProtoA)
                     ]
 
 

hbs2-peer/app/RPC2/LWWRef.hs

@@ -63,12 +63,14 @@ instance LWWRefContext m => HandleMethod m RpcLWWRefUpdate where
 
     let penv = rpcPeerEnv co
 
+    let nada = LWWRefProtoAdapter dontHandle
+
     void $ runMaybeT do
       (puk, _) <- unboxSignedBox0 box & toMPlus
 
       liftIO $ withPeerM penv do
         me <- ownPeer @L4Proto
         runResponseM me $ do
-          lwwRefProto (LWWRefProto1 (LWWProtoSet @L4Proto (LWWRefKey puk) box))
+          lwwRefProto nada (LWWRefProto1 (LWWProtoSet @L4Proto (LWWRefKey puk) box))
 
 

hbs2-peer/lib/HBS2/Peer/Proto/LWWRef/Internal.hs

@@ -28,6 +28,12 @@ import Data.Maybe
 
 {- HLINT ignore "Functor law" -}
 
+
+data LWWRefProtoAdapter e m =
+  LWWRefProtoAdapter
+  { lwwFetchBlock :: Hash HbSync -> m ()
+  }
+
 lwwRefProto :: forall e s m proto . ( MonadIO m
                                     , ForLWWRefProto e
                                     , Request e proto m
@@ -43,9 +49,10 @@ lwwRefProto :: forall e s m proto . ( MonadIO m
                                     , s ~ Encryption e
                                     , proto ~ LWWRefProto e
                                     )
-                  => LWWRefProto e -> m ()
+                  => LWWRefProtoAdapter e m
+                  -> LWWRefProto e -> m ()
 
-lwwRefProto pkt@(LWWRefProto1 req) = do
+lwwRefProto adapter pkt@(LWWRefProto1 req) = do
   debug $ yellow "lwwRefProto"
 
   case req of
@@ -79,9 +86,11 @@ lwwRefProto pkt@(LWWRefProto1 req) = do
         when new do
           lift $ gossip pkt
 
+        lift $ lwwFetchBlock adapter (fromHashRef (lwwValue lww))
+
         getRef sto key >>= \case
           Nothing -> do
-            h <- putBlock sto bs >>= toMPlus
+            h <- enqueueBlock sto bs >>= toMPlus
             updateRef sto key h
 
           Just rv -> do
@@ -98,6 +107,6 @@ lwwRefProto pkt@(LWWRefProto1 req) = do
 
     where
       forcedUpdateLwwRef sto key bs = do
-        h' <- putBlock sto bs
+        h' <- enqueueBlock sto bs
         forM_ h' $ updateRef sto key