wip

hbs2-core/lib/HBS2/Net/Messaging/TCP.hs

@@ -296,7 +296,7 @@ runMessagingTCP env@MessagingTCP{..} = liftIO do
         let (L4Address _ (IPAddrPort (i,p))) = own
         let myCookie = view tcpCookie env
 
-        pause @'Seconds 30
+        pause @'Seconds 10
 
         forever $ void $ runMaybeT do
             -- client sockets

hbs2-core/lib/HBS2/Net/Messaging/Unix.hs

@@ -234,7 +234,7 @@ runMessagingUnix env = do
           void $ ContT $ bracket ( debug $ "Client thread started" <+> pretty that )
                                  ( \_ -> debug $ "Client thread finished" <+> pretty that  )
 
-          void $ ContT $ bracket writer (\x -> pause @'Seconds 0.1 >> cancel x)
+          void $ ContT $ bracket writer (\x -> pause @'Seconds 0.25 >> cancel x)
 
           fix \next -> do
 

hbs2-peer/app/PeerMain.hs

@@ -313,13 +313,10 @@ runCLI = do
     pPoke = do
       rpc <- pRpcCommon
       pure $ withMyRPC @PeerAPI rpc $ \caller -> do
-        e <- race ( pause @'Seconds 0.25) do
-          r <- callService @RpcPoke caller ()
-          case r of
-            Left e -> die (show e)
-            Right txt -> putStrLn txt >> exitSuccess
-
-        liftIO $ either (const $ exitFailure) (const $ exitSuccess) e
+        r <- callRpcWaitRetry @RpcPoke (TimeoutSec 0.5) 2 caller ()
+        case r of
+          Nothing -> exitFailure
+          Just s -> putStrLn s >> exitSuccess
 
     pAnnounce = do
       rpc <- pRpcCommon

hbs2-peer/lib/HBS2/Peer/RPC/Internal/Types.hs

@@ -55,6 +55,7 @@ instance Monad m => HasOwnPeer UNIX (ReaderT RPC2Context m) where
 
 instance (MonadUnliftIO m, HasProtocol UNIX (ServiceProto (api :: [Type]) UNIX))
   => HasDeferred (ServiceProto api UNIX) UNIX  m where
-  deferred m = void $ asyncLinked m
+  deferred m = void $ async m
+
 
 

hbs2-storage-simple/lib/HBS2/Storage/Simple.hs

@@ -220,6 +220,15 @@ simpleStorageWorker ss@SimpleStorage{..} = do
         atomically do
           modifyTVar lru (HashMap.filter notExpired)
 
+    ContT $ withAsync $ do
+      forever $ do
+        pause ( 10 :: Timeout 'Seconds ) -- FIXME: setting
+        purgeExpired _storageSizeCache
+        -- now <- getTimeCoarse
+        -- let notExpired t0 = not (expired timeout (now - t0))
+        -- atomically do
+        --   modifyTVar lru (HashMap.filter notExpired)
+
     liftIO do
       fix \next -> do
         s <- atomically $ do TBMQ.readTBMQueue ( ss ^. storageOpQ )
@@ -364,7 +373,7 @@ simpleBlockExists ss hash = runMaybeT $ do
     _ -> do
         exists <- liftIO $ doesFileExist fn
         unless exists mzero
-        s <- liftIO $ getFileSize fn
+        s <- liftIO $! getFileSize fn
         liftIO $ Cache.insert cache hash (Just s)
         pure s