handle TCP disconnections (WIP) (#29)

* handle TCP disconnections (WIP)

* agent: handle SMP server disconnections

* agent: notify client about lost subscriptions when SMP server disconnects

* comments for testing functions

* remove test apps

* chore: reorder functions in Transport

* add comment

Co-authored-by: Efim Poberezkin <efim.poberezkin@gmail.com>

src/Simplex/Messaging/Client.hs

@@ -10,6 +10,7 @@
 module Simplex.Messaging.Client
   ( SMPClient,
     getSMPClient,
+    closeSMPClient,
     createSMPQueue,
     subscribeSMPQueue,
     secureSMPQueue,
@@ -49,6 +50,7 @@ import System.Timeout
 
 data SMPClient = SMPClient
   { action :: Async (),
+    connected :: TVar Bool,
     smpServer :: SMPServer,
     clientCorrId :: TVar Natural,
     sentCommands :: TVar (Map CorrId Request),
@@ -78,16 +80,20 @@ data Request = Request
     responseVar :: TMVar (Either SMPClientError Cmd)
   }
 
-getSMPClient :: SMPServer -> SMPClientConfig -> TBQueue SMPServerTransmission -> IO SMPClient
+getSMPClient :: SMPServer -> SMPClientConfig -> TBQueue SMPServerTransmission -> IO () -> IO SMPClient
 getSMPClient
   smpServer@SMPServer {host, port}
   SMPClientConfig {qSize, defaultPort, tcpTimeout}
-  msgQ = do
+  msgQ
+  disconnected = do
     c <- atomically mkSMPClient
     started <- newEmptyTMVarIO
-    action <- async $ runTCPClient host (fromMaybe defaultPort port) (client c started)
+    action <-
+      async $
+        runTCPClient host (fromMaybe defaultPort port) (client c started)
+          `finally` atomically (putTMVar started False)
     tcpTimeout `timeout` atomically (takeTMVar started) >>= \case
-      Just _ -> return c {action}
+      Just True -> return c {action}
       _ -> throwIO err
     where
       err :: IOException
@@ -95,18 +101,31 @@ getSMPClient
 
       mkSMPClient :: STM SMPClient
       mkSMPClient = do
+        connected <- newTVar False
         clientCorrId <- newTVar 0
         sentCommands <- newTVar M.empty
         sndQ <- newTBQueue qSize
         rcvQ <- newTBQueue qSize
-        return SMPClient {action = undefined, smpServer, clientCorrId, sentCommands, sndQ, rcvQ, msgQ}
+        return
+          SMPClient
+            { action = undefined,
+              connected,
+              smpServer,
+              clientCorrId,
+              sentCommands,
+              sndQ,
+              rcvQ,
+              msgQ
+            }
 
-      client :: SMPClient -> TMVar () -> Handle -> IO ()
+      client :: SMPClient -> TMVar Bool -> Handle -> IO ()
       client c started h = do
         _ <- getLn h -- "Welcome to SMP"
-        atomically $ putTMVar started ()
-        -- TODO call continuation on disconnection after raceAny_ exits
+        atomically $ do
+          modifyTVar (connected c) (const True)
+          putTMVar started True
         raceAny_ [send c h, process c, receive c h]
+          `finally` disconnected
 
       send :: SMPClient -> Handle -> IO ()
       send SMPClient {sndQ} h = forever $ atomically (readTBQueue sndQ) >>= tPut h
@@ -134,6 +153,9 @@ getSMPClient
                   Right r -> Right r
                 else Left SMPQueueIdError
 
+closeSMPClient :: SMPClient -> IO ()
+closeSMPClient = uninterruptibleCancel . action
+
 data SMPClientError
   = SMPServerError ErrorType
   | SMPResponseError ErrorType