git.iko.soy/curryer
on master help sign in
loosen server state type
804b0baAgentM
src/Network/RPC/Curryer/Server.hs+3−4
compare with master
unifiedsplit
@@ -27,7 +27,6 @@ import qualified Data.Binary as B
27import qualified Data.UUID as UUIDBase
27import qualified Data.UUID as UUIDBase
28import qualified Data.UUID.V4 as UUIDBase
28import qualified Data.UUID.V4 as UUIDBase
29import Control.Monad
29import Control.Monad
30−import Control.Concurrent.STM
31
30
32import qualified Network.RPC.Curryer.StreamlyAdditions as SA
31import qualified Network.RPC.Curryer.StreamlyAdditions as SA
33--import Control.Monad
32--import Control.Monad
@@ -104,7 +103,7 @@ data RequestHandler serverState where
104
103
105-- | Passed to
104-- | Passed to
106data ConnectionState a = ConnectionState {
105data ConnectionState a = ConnectionState {
107− connectionServerState :: STM a,
106+ connectionServerState :: a,
108 connectionSocket :: Locking Socket
107 connectionSocket :: Locking Socket
109 }
108 }
110
109
@@ -211,7 +210,7 @@ type NewMessageHandler req resp = req -> IO resp
211
210
212serve ::
211serve ::
213 MessageHandlers s->
212 MessageHandlers s->
214− STM s ->
213+ s ->
215 HostAddr ->
214 HostAddr ->
216 PortNumber ->
215 PortNumber ->
217 Maybe (MVar SockAddr) ->
216 Maybe (MVar SockAddr) ->
@@ -246,7 +245,7 @@ matchEnvelope envelope dispatchf =
246serverEnvelopeHandler ::
245serverEnvelopeHandler ::
247 Locking Socket
246 Locking Socket
248 -> MessageHandlers s
247 -> MessageHandlers s
249− -> STM s
248+ -> s
250 -> Envelope
249 -> Envelope
251 -> IO ()
250 -> IO ()
252serverEnvelopeHandler _ _ _ (Envelope _ TimeoutResponseMessage _ _) = pure ()
251serverEnvelopeHandler _ _ _ (Envelope _ TimeoutResponseMessage _ _) = pure ()
test/Curryer/Test/Basic.hs+27−3
@@ -24,6 +24,7 @@ testTree = testGroup "basic" [testCase "simple" testSimpleCall
24 ,testCase "client sync timeout" testSyncClientCallTimeout
24 ,testCase "client sync timeout" testSyncClientCallTimeout
25 ,testCase "server-side exception" testSyncException
25 ,testCase "server-side exception" testSyncException
26 ,testCase "multi-threaded client" testMultithreadedClient
26 ,testCase "multi-threaded client" testMultithreadedClient
27+ ,testCase "server state" testServerState
27 ]
28 ]
28
29
29
30
@@ -51,6 +52,10 @@ data ThrowServerSideExceptionReq = ThrowServerSideExceptionReq
51 deriving (Generic, Show)
52 deriving (Generic, Show)
52 deriving Serialise via WineryVariant ThrowServerSideExceptionReq
53 deriving Serialise via WineryVariant ThrowServerSideExceptionReq
53
54
55+data ChangeServerState = ChangeServerState
56+ deriving (Generic, Show)
57+ deriving Serialise via WineryVariant ChangeServerState
58+
54--used to server -> client async request
59--used to server -> client async request
55data AsyncHelloReq = AsyncHelloReq String
60data AsyncHelloReq = AsyncHelloReq String
56 deriving (Generic, Show)
61 deriving (Generic, Show)
@@ -112,8 +117,8 @@ testAsyncServerCall = do
112 cancel server
117 cancel server
113
118
114
119
115−emptyServerState :: STM ()
120+emptyServerState :: ()
116−emptyServerState = pure ()
121+emptyServerState = ()
117
122
118--test that the client can make a non-blocking call
123--test that the client can make a non-blocking call
119testAsyncClientCall :: Assertion
124testAsyncClientCall :: Assertion
@@ -180,5 +185,24 @@ testMultithreadedClient = do
180 --putStrLn "plus one"
185 --putStrLn "plus one"
181 close conn
186 close conn
182 cancel server
187 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+
184
208