wip

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

@@ -4,6 +4,7 @@ module HBS2.Net.Messaging.Unix
   ( module HBS2.Net.Messaging.Unix
   , module HBS2.Net.Messaging
   , module HBS2.Net.Proto.Types
+  , SocketClosedException
   ) where
 
 import HBS2.Prelude.Plated
@@ -220,12 +221,23 @@ runMessagingUnix env = do
             atomically $ writeTVar seen now
             next
 
+
+    clientLoop m = fix \next -> do
+      m
+      if not (MUDontRetry `elem` msgUnixOpts env) then do
+        debug "LOOP!"
+        next
+      else do
+        debug "LOOP EXIT"
+
     handleClient | MUDontRetry `elem` msgUnixOpts env  = \_ w -> handleAny throwStopped w
-                 | otherwise = handleAny
+                 | otherwise =  handleAny
 
     throwStopped _ = throwIO UnixMessagingStopped
 
-    runClient = liftIO $ forever $ handleClient logAndRetry $ flip runContT pure $ do
+    runClient = liftIO $ clientLoop $ handleClient logAndRetry $ flip runContT pure $ do
+
+      debug "HERE WE GO AGAIN!"
 
       let sa   = SockAddrUnix (msgUnixSockPath env)
       let p  = msgUnixSockPath env
@@ -335,6 +347,7 @@ runMessagingUnix env = do
 
       pause (msgUnixRetryTime env)
 
+
     logAndRetry :: SomeException -> IO ()
     logAndRetry e = do
       warn $ "MessagingUnix. runClient failed, probably server is gone. Retrying:" <+> pretty (msgUnixSelf env)

hbs2-fixer/app/Main.hs

@@ -168,7 +168,7 @@ withApp cfgPath action = do
     client <- lift $ race (pause @'Seconds 1) (newMessagingUnix False 1.0 soname)
                 >>= orThrowUser ("can't connect to" <+> pretty soname)
 
-    mess <-  ContT $ bracket (async $ runMessagingUnix client) $ \_ -> error "FUCK!" >> liftIO exitFailure
+    mess <-  ContT $ withAsync $ runMessagingUnix client
 
     link mess
 
@@ -185,10 +185,10 @@ withApp cfgPath action = do
 
     void $ ContT $ withAsync $ liftIO $ runReaderT (runServiceClientMulti endpoints) client
 
-    let o = [MUWatchdog 20]
+    let o = [MUWatchdog 20,MUDontRetry]
     clientN <- newMessagingUnixOpts o False 1.0 soname
 
-    notif <- ContT $ bracket (async $ runMessagingUnix clientN) (\_ -> error "FUCK2" >> liftIO exitFailure)
+    notif <- ContT $ withAsync (runMessagingUnix clientN)
 
     link notif