Apply fixes

src/Cardano/Shell/NodeIPC/Example.hs

@@ -24,6 +24,7 @@ module Cardano.Shell.NodeIPC.Example
 
 import           Cardano.Prelude
 
+import           Data.Aeson (ToJSON)
 import           System.IO (BufferMode (..), hSetBuffering)
 import           System.Posix.Process (exitImmediately, forkProcess)
 import           System.Process (createPipe)
@@ -49,51 +50,51 @@ getReadWriteHandles = do
 -- Testing
 --------------------------------------------------------------------------------
 
+nodePort :: Port
+nodePort = Port 8090
+
 -- | Example using file descriptor
 exampleWithFD :: IO (MsgOut, MsgOut)
 exampleWithFD = do
 
     (clientReadHandle, clientWriteHandle) <- getReadWriteHandles
-    (serverReadHandle, serverWriteHandle) <- getReadWriteHandles
 
-    let nodePort = Port 8090
-    asyncServer <- async $ startIPC serverReadHandle clientWriteHandle nodePort
-    link asyncServer
+    (_, responses) <-
+        ipcServer clientWriteHandle Ping
+        `concurrently`
+        receieveMessages clientReadHandle
 
-    -- Use these functions so you don't pass the wrong handle by mistake
-    let readClientMessage :: IO MsgOut
-        readClientMessage = readMessage clientReadHandle
-
-    let sendServer :: MsgIn -> IO ()
-        sendServer = sendMessage serverWriteHandle
-
-    -- -- Communication starts here
-    started <- readClientMessage
-    sendServer Ping
-    pong    <- readClientMessage -- Pong
-    return (started, pong)
+    return responses
 
 -- | Example of an IPC using process
 exampleWithProcess :: IO (MsgOut, MsgOut)
 exampleWithProcess = do
     (clientReadHandle, clientWriteHandle) <- getReadWriteHandles
 
     -- Create a child process that acts as an server
-    _ <- finally
-            (forkProcess $ do
-                (serverReadHandle, serverWriteHandle) <- getReadWriteHandles
-                -- Send message to server
-                sendMessage serverWriteHandle Ping
-                let nodePort = Port 8090
-                startIPC serverReadHandle clientWriteHandle nodePort
-                exitImmediately ExitSuccess
-            )
-            (return ())
 
+    _ <- forkProcess $ do
+            ipcServer clientWriteHandle Ping
+            exitImmediately ExitSuccess
+        `finally`
+        return ()
+
+    receieveMessages clientReadHandle
+
+-- | IPC server
+ipcServer :: (ToJSON msg) => WriteHandle -> msg -> IO ()
+ipcServer clientWriteHandle msgin = do
+    (serverReadHandle, serverWriteHandle) <- getReadWriteHandles
+    -- Send message to server
+    sendMessage serverWriteHandle msgin
+    startIPC serverReadHandle clientWriteHandle nodePort
+
+-- | Read message wigh given 'ReadHandle'
+receieveMessages :: ReadHandle -> IO (MsgOut, MsgOut)
+receieveMessages clientReadHandle = do
     let readClientMessage :: IO MsgOut
         readClientMessage = readMessage clientReadHandle
 
-    -- Recieve the messages
-    started <- readClientMessage -- Start
+    started <- readClientMessage
     pong    <- readClientMessage -- Pong
     return (started, pong)

src/Cardano/Shell/NodeIPC/Lib.hs

@@ -184,12 +184,11 @@ startNodeJsIPC port = do
 -- responds with 'ReplyPort' with 'Port',
 ipcListener :: forall m . (MonadIO m, MonadCatch m, MonadMask m) => ReadHandle -> WriteHandle -> Port -> m ()
 ipcListener readHandle@(ReadHandle rHndl) writeHandle@(WriteHandle wHndl) (Port port) =
-    finally
-        (do
-            checkHandles readHandle writeHandle
-            catches handleMsgIn [Handler handler, Handler handleMsgError]
-        )
-        shutdown
+    do
+        checkHandles readHandle writeHandle
+        catches handleMsgIn [Handler handler, Handler handleMsgError]
+    `finally`
+    shutdown
   where
     handleMsgIn :: m ()
     handleMsgIn = do

test/NodeIPCSpec.hs

@@ -185,20 +185,23 @@ testStartNodeIPC port msg = do
     (serverReadHandle, serverWriteHandle) <- getReadWriteHandles
 
     -- Start the server
-    void $ async $ startIPC serverReadHandle clientWriteHandle port
-
-    -- Use these functions so you don't pass the wrong handle by mistake
-    let readClientMessage :: IO MsgOut
-        readClientMessage = readMessage clientReadHandle
-
-    let sendServer :: msg -> IO ()
-        sendServer = sendMessage serverWriteHandle
-
-    -- Communication starts here
-    started <- readClientMessage
-    sendServer msg
-    response <- readClientMessage
-    return (started, response)
+    (_, responses) <-
+        startIPC serverReadHandle clientWriteHandle port
+        `concurrently`
+        do
+            -- Use these functions so you don't pass the wrong handle by mistake
+            let readClientMessage :: IO MsgOut
+                readClientMessage = readMessage clientReadHandle
+
+            let sendServer :: msg -> IO ()
+                sendServer = sendMessage serverWriteHandle
+
+            -- Communication starts here
+            started <- readClientMessage
+            sendServer msg
+            response <- readClientMessage
+            return (started, response)
+    return responses
 
 whenLeft :: Applicative m => Either a b -> (a -> m ()) -> m ()
 whenLeft (Left x) f = f x