@@ -24,6 +24,7 @@ testTree = testGroup "basic" [testCase "simple" testSimpleCall
2424 ,testCase "client sync timeout" testSyncClientCallTimeout
2525 ,testCase "server-side exception" testSyncException
2626 ,testCase "multi-threaded client" testMultithreadedClient
27+ ,testCase "server state" testServerState
2728 ]
2829
2930
@@ -51,6 +52,10 @@ data ThrowServerSideExceptionReq = ThrowServerSideExceptionReq
5152 deriving (Generic, Show)
5253 deriving Serialise via WineryVariant ThrowServerSideExceptionReq
5354
55+data ChangeServerState = ChangeServerState
56+ deriving (Generic, Show)
57+ deriving Serialise via WineryVariant ChangeServerState
58+
5459--used to server -> client async request
5560data AsyncHelloReq = AsyncHelloReq String
5661 deriving (Generic, Show)
@@ -112,8 +117,8 @@ testAsyncServerCall = do
112117 cancel server
113118
114119
115−emptyServerState :: STM ()
116−emptyServerState = pure ()
120+emptyServerState :: ()
121+emptyServerState = ()
117122
118123--test that the client can make a non-blocking call
119124testAsyncClientCall :: Assertion
@@ -180,5 +185,24 @@ testMultithreadedClient = do
180185 --putStrLn "plus one"
181186 close conn
182187 cancel server
183−
188+
189+testServerState :: Assertion
190+testServerState = do
191+ readyVar <- newEmptyMVar
192+
193+ let serverHandlers = [RequestHandler (\sState ChangeServerState ->
194+ atomically $
195+ modifyTVar (connectionServerState sState) (+ 1))
196+ ]
197+ serverState <- newTVarIO @Int 1
198+ server <- async (serve serverHandlers serverState localHostAddr 0 (Just readyVar))
199+ (SockAddrInet port _) <- takeMVar readyVar
200+ conn <- connect [] localHostAddr port
201+ ret <- call conn ChangeServerState
202+ assertEqual "server ret" (Right ()) ret
203+ serverState' <- readTVarIO serverState
204+ assertEqual "server state" 2 serverState'
205+ close conn
206+ cancel server
207+
184208