@@ -1,4 +1,4 @@
1−{-# LANGUAGE DerivingVia, DeriveGeneric, TypeApplications #-}
1+{-# LANGUAGE DerivingVia, DeriveGeneric, TypeApplications, ExistentialQuantification #-}
22module Curryer.Test.Basic where
33import Test.Tasty
44import Test.Tasty.HUnit
@@ -9,63 +9,72 @@ import Network.Socket (SockAddr(..))
99import Control.Concurrent.Async
1010import Control.Monad
1111import Control.Concurrent
12−import Data.List
1312
1413import Network.RPC.Curryer.Server
1514import Network.RPC.Curryer.Client
1615
17−import Debug.Trace
18−
1916-- TODO: add test for nested calls
2017
2118testTree :: TestTree
2219testTree = testGroup "basic" [testCase "simple" testSimpleCall
23− {-testCase "client async" testAsyncServerCall,
24− testCase "server async" testAsyncClientCall,
25− testCase "client sync timeout" testSyncClientCallTimeout,
26− testCase "server-side exception" testSyncException,
27− testCase "multi-threaded client" testMultithreadedClient-}
20+ --,testCase "client async" testAsyncServerCall
21+ ,testCase "server async" testAsyncClientCall
22+ --,testCase "client sync timeout" testSyncClientCallTimeout
23+ --,testCase "server-side exception" testSyncException
24+ ,testCase "multi-threaded client" testMultithreadedClient
2825 ]
2926
30−--client-to-server request
31−data TestRequest = AddTwoNumbersReq Int Int
32− | TestAsyncReq String
33− | TestCallMeBackReq String
34− | RoundtripStringReq String
35− | DelayMicrosecondsReq Int
36− | ThrowServerSideExceptionReq
27+
28+data AddTwoNumbersReq = AddTwoNumbersReq Int Int
3729 deriving (Generic, Show)
38− deriving Serialise via WineryVariant TestRequest
30+ deriving Serialise via WineryVariant AddTwoNumbersReq
3931
40−--server responds to client
41−data TestResponse = AddTwoNumbersResp Int
42− | AsyncHello String
43− | DelayMicrosecondsResp
44− | RoundtripStringResp String
32+data TestCallMeBackReq = TestCallMeBackReq String
4533 deriving (Generic, Show, Eq)
46− deriving Serialise via WineryVariant TestResponse
34+ deriving Serialise via WineryVariant TestCallMeBackReq
35+
36+data TestAsyncReq = TestAsyncReq String
37+ deriving (Generic, Show)
38+ deriving Serialise via WineryVariant TestAsyncReq
39+
40+data DelayMicrosecondsReq = DelayMicrosecondsReq Int
41+ deriving (Generic, Show)
42+ deriving Serialise via WineryVariant DelayMicrosecondsReq
43+
44+data RoundtripStringReq = RoundtripStringReq String
45+ deriving (Generic, Show)
46+ deriving Serialise via WineryVariant RoundtripStringReq
47+
48+data ThrowServerSideExceptionReq = ThrowServerSideExceptionReq
49+ deriving (Generic, Show)
50+ deriving Serialise via WineryVariant ThrowServerSideExceptionReq
51+
52+--used to server -> client async request
53+data AsyncHelloReq = AsyncHelloReq
54+ deriving (Generic, Show)
55+ deriving Serialise via WineryVariant AsyncHelloReq
4756
4857testServerMessageHandlers :: Maybe (MVar String) -> MessageHandlers
4958testServerMessageHandlers mAsyncMVar =
50− MessageHandlers [\(AddTwoNumbersReq x y) ->
51− pure (AddTwoNumbersResp (x + y))]
52−{- --print msg
53− case msg of
54− --round-trip request to add two Ints
55− AddTwoNumbersReq x y -> pure (AddTwoNumbersResp (x+y))
56− --respond to a request for an async callback
57− TestCallMeBackReq s -> do
58− case mAsyncMVar of
59− Nothing -> pure ()
60− Just mvar -> putMVar mvar s
61− pure NoResponse
62− TestAsyncReq _ -> pure NoResponse
63− RoundtripStringReq s -> pure (RoundtripStringResp s)
64− DelayMicrosecondsReq ms -> do
59+ [ RequestHandler $ \(AddTwoNumbersReq x y) -> pure (x + y)
60+ , RequestHandler $ \(TestCallMeBackReq s) ->
61+ case mAsyncMVar of
62+ Nothing -> pure ()
63+ Just mvar -> putMVar mvar s
64+ , AsyncRequestHandler $ \(TestAsyncReq v) ->
65+ maybe (pure ()) (\mvar -> putMVar mvar v) mAsyncMVar
66+ -- an async hello to the server generates an async hello to the client
67+ --, AsyncRequestHandler $ \(AsyncReq s) -> currently lacking server state to message client
68+
69+ , RequestHandler $ \(RoundtripStringReq s) -> pure s
70+ , RequestHandler $ \(DelayMicrosecondsReq ms) -> do
6571 threadDelay ms
66− pure (HandlerResponse DelayMicrosecondsResp)
67− ThrowServerSideExceptionReq -> error "test server exception"
68−-}
72+ pure ()
73+ , RequestHandler $ \ThrowServerSideExceptionReq -> do
74+ _ <- error "test server exception"
75+ pure ()
76+ ]
77+
6978-- test a simple client-to-server round-trip function execution
7079testSimpleCall :: Assertion
7180testSimpleCall = do
@@ -74,42 +83,32 @@ testSimpleCall = do
7483 server <- async (serve (testServerMessageHandlers Nothing) localHostAddr 0 (Just readyVar))
7584 --wait for server to be ready
7685 (SockAddrInet port _) <- takeMVar readyVar
77− let clientHandler :: AsyncMessageHandler TestResponse
78− clientHandler _ = error "async handler called"
79− mkConn :: IO Connection
80− mkConn = connect localHostAddr port
81− conn <- mkConn
82− let c :: IO (Either ConnectionError TestResponse)
83− c = call conn (AddTwoNumbersReq 1 1)
86+ conn <- connect [] localHostAddr port
8487 replicateM_ 5 $ do --make five AddTwo calls to shake out parallelism bugs
85− x <- c
86− assertEqual "server request+response" (Right (AddTwoNumbersResp 2)) x
88+ x <- call conn (AddTwoNumbersReq 1 1)
89+ assertEqual "server request+response" (Right (2 :: Int)) x
8790 close conn
8891 cancel server
8992
90−{-
93+
9194--test that the client can proces a server-initiated asynchronous callback from the server
95+{-
9296testAsyncServerCall :: Assertion
9397testAsyncServerCall = do
9498 portReadyVar <- newEmptyMVar
9599 receivedAsyncMessageVar <- newEmptyMVar
96−
97− let testServerNewConnHandler :: NewConnectionHandler TestResponse
98− testServerNewConnHandler =
99− pure (Just (AsyncHello "welcome"))
100−
101− server <- async (serve testServerNewConnHandler (testServerMessageHandler Nothing) localHostAddr 0 (Just portReadyVar))
100+ let clientAsyncHandlers =
101+ [ClientAsyncRequestHandler (\AsyncHelloReq ->
102+ putMVar receivedAsyncMessageVar "")]
103+ server <- async (serve clientAsyncHandlers (testServerMessageHandlers receivedAsyncMessageVar) localHostAddr 0 (Just portReadyVar))
102104 (SockAddrInet port _) <- takeMVar portReadyVar
103− let clientHandler :: AsyncMessageHandler TestResponse
104− clientHandler msg = do
105− case msg of
106− AsyncHello str -> putMVar receivedAsyncMessageVar str
107− x -> error ("unexpected message " <> show x)
108− conn <- connect @TestResponse clientHandler localHostAddr port
105+ conn <- connect @TestResponse clientHandler localHostAddr port
106+ callAsync conn TestAsyncReq
109107 asyncMessage <- takeMVar receivedAsyncMessageVar
110108 assertEqual "async message" "welcome" asyncMessage
111109 close conn
112110 cancel server
111+-}
113112
114113--test that the client can make a non-blocking call
115114testAsyncClientCall :: Assertion
@@ -117,10 +116,10 @@ testAsyncClientCall = do
117116 portReadyVar <- newEmptyMVar
118117 receivedAsyncMessageVar <- newEmptyMVar
119118
120− server <- async (serve (pure Nothing) (testServerMessageHandler (Just receivedAsyncMessageVar)) localHostAddr 0 (Just portReadyVar))
119+ server <- async (serve (testServerMessageHandlers (Just receivedAsyncMessageVar)) localHostAddr 0 (Just portReadyVar))
121120 (SockAddrInet port _) <- takeMVar portReadyVar
122−
123− conn <- connect @TestResponse (\_ -> pure ()) localHostAddr port
121+
122+ conn <- connect [] localHostAddr port
124123 --send an async message, wait for an async response to confirm receipt
125124 Right () <- asyncCall conn (TestCallMeBackReq "hi server")
126125 asyncMessage <- takeMVar receivedAsyncMessageVar
@@ -132,21 +131,16 @@ testSyncClientCallTimeout :: Assertion
132131testSyncClientCallTimeout = do
133132 readyVar <- newEmptyMVar
134133
135− server <- async (serve (pure Nothing) (testServerMessageHandler Nothing) localHostAddr 0 (Just readyVar))
134+ server <- async (serve (testServerMessageHandlers Nothing) localHostAddr 0 (Just readyVar))
136135 --wait for server to be ready
137136 (SockAddrInet port _) <- takeMVar readyVar
138− let clientHandler :: AsyncMessageHandler TestResponse
139− clientHandler _ = error "async handler called"
140− mkConn :: IO (Connection TestResponse)
141− mkConn = connect clientHandler localHostAddr port
142− conn <- mkConn
143− let c :: IO (Either ConnectionError TestResponse)
144− c = callTimeout (Just 500) conn (DelayMicrosecondsReq 1000)
145− x <- c
137+ conn <- connect [] localHostAddr port
138+ x <- callTimeout @_ @Int (Just 500) conn (DelayMicrosecondsReq 1000)
146139 assertEqual "client sync timeout" (Left TimeoutError) x
147140 close conn
148141 cancel server
149−
142+
143+{-
150144testSyncException :: Assertion
151145testSyncException = do
152146 readyVar <- newEmptyMVar
@@ -165,25 +159,23 @@ testSyncException = do
165159 Right _ -> assertFailure "missed exception"
166160 close conn
167161 cancel server
168−
162+-}
169163--throw large messages (> PIPE_BUF) at the server from multiple client connections to exercise the socket lock
170164testMultithreadedClient :: Assertion
171165testMultithreadedClient = do
172166 readyVar <- newEmptyMVar
173167
174− server <- async (serve (pure Nothing) (testServerMessageHandler Nothing) localHostAddr 0 (Just readyVar))
168+ server <- async (serve (testServerMessageHandlers Nothing) localHostAddr 0 (Just readyVar))
175169 (SockAddrInet port _) <- takeMVar readyVar
176− let clientHandler :: AsyncMessageHandler TestResponse
177− clientHandler _ = error "async handler called"
178− mkConn :: IO (Connection TestResponse)
179− mkConn = connect clientHandler localHostAddr port
180− conn <- mkConn
170+ {-let clientHandler :: AsyncMessageHandler TestResponse
171+ clientHandler _ = error "async handler called"-}
172+ conn <- connect [] localHostAddr port
181173 let bigString = replicate (1024 * 1000) 'x'
182174 replicateM_ 10 $ do
183175 ret <- call conn (RoundtripStringReq bigString)
184− assertEqual "big string multithread" (Right (RoundtripStringResp bigString)) ret
176+ assertEqual "big string multithread" (Right bigString) ret
185177 putStrLn "plus one"
186178 close conn
187179 cancel server
188180
189−-}
181+