Skip to content
Permalink
Browse files

Apply fixes

  • Loading branch information...
HirotoShioi committed Mar 15, 2019
1 parent 88df360 commit 2d486f1653fdf87137bbfbd978cc1d596101ae9d
Showing with 51 additions and 48 deletions.
  1. +29 −28 src/Cardano/Shell/NodeIPC/Example.hs
  2. +5 −6 src/Cardano/Shell/NodeIPC/Lib.hs
  3. +17 −14 test/NodeIPCSpec.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)
@@ -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
@@ -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

0 comments on commit 2d486f1

Please sign in to comment.
You can’t perform that action at this time.