diff --git a/hbs2-core/lib/HBS2/Net/Messaging/Pipe.hs b/hbs2-core/lib/HBS2/Net/Messaging/Pipe.hs index f3af1d22..8ecaf7ee 100644 --- a/hbs2-core/lib/HBS2/Net/Messaging/Pipe.hs +++ b/hbs2-core/lib/HBS2/Net/Messaging/Pipe.hs @@ -75,7 +75,8 @@ instance Messaging MessagingPipe PIPE ByteString where receive bus _ = do msg <- liftIO $ atomically $ peekTQueue q >> STM.flushTQueue q - for msg $ \m -> pure (From (PeerPIPE (PipeAddr who)), m) + for msg $ \m -> do + pure (From (PeerPIPE (PipeAddr who)), m) where q = inQ bus @@ -85,7 +86,6 @@ runMessagingPipe :: MonadIO m => MessagingPipe -> m () runMessagingPipe bus = liftIO do fix \next -> do frame <- LBS.hGet who 4 <&> word32 . LBS.toStrict - debug $ "JOPAKITA!!" <+> pretty frame piece <- LBS.hGet who (fromIntegral frame) atomically (writeTQueue (inQ bus) piece) next diff --git a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs index 5def5a35..e080ca2d 100644 --- a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs +++ b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs @@ -13,6 +13,11 @@ import HBS2.Hash import HBS2.Merkle import HBS2.Data.Types.SignedBox +import HBS2.Net.Messaging +import HBS2.Net.Messaging.Pipe +import HBS2.Net.Proto.Service +import HBS2.Actors.Peer + import HBS2.KeyMan.Keys.Direct import HBS2.Git.Data.LWWBlock @@ -192,8 +197,6 @@ runDump pks = do -- p <- ContT $ withProcessWait cmd p <- lift $ startProcess cmd -- ContT $ withProcessWait cmd - pause @'Seconds 1 - let ssin = getStdin p let sout = getStdout p client <- newMessagingPipe (sout,ssin) -- ,sout) @@ -205,22 +208,18 @@ runDump pks = do void $ ContT $ withAsync $ runMessagingPipe client - debug "YAY!" - caller <- makeServiceCaller @BrowserPluginAPI @PIPE (localPeer client) - -- pause @'Seconds 2 + void $ ContT $ withAsync $ liftIO $ runReaderT (runServiceClient caller) client - forever do + wtf <- callService @RpcChannelQuery caller () + >>= orThrowUser "can't query rpc" - wtf <- callService @RpcChannelQuery caller () - >>= orThrowUser "can't query rpc" + r <- ContT $ maybe1 wtf (pure ()) - r <- ContT $ maybe1 wtf (pure ()) + let val = Aeson.decode @Value r - let val = Aeson.decode @Value r - - liftIO $ LBS.putStr (A.encodePretty val) + liftIO $ LBS.putStr (A.encodePretty val) data RpcChannelQuery @@ -244,12 +243,10 @@ instance (MonadUnliftIO m, HasOracleEnv m) => HandleMethod m RpcChannelQuery whe runMaybeT do - debug "WTF!!" - rv <- lift (callRpcWaitMay @RpcRefChanGet (TimeoutSec 1) rchanAPI chan) >>= toMPlus >>= toMPlus - liftIO $ print $ pretty rv + debug $ "AAAAAA" <+> pretty rv facts <- S.toList_ do walkMerkle @[HashRef] (fromHashRef rv) (getBlock sto) $ \case @@ -320,7 +317,7 @@ runPipe = do chan <- asks _refchanId debug "run pipe" - liftIO $ hSetBuffering stdin NoBuffering + -- liftIO $ hSetBuffering stdin NoBuffering -- liftIO $ LBS.getContents >>= LBS.hPutStr stderr -- forever (pause @'Seconds 10)