c6ea967 · curryer · git.iko.soy

git.iko.soy/curryer

intercept server-side exceptions and forward them to the client

server continues to rethrow the exception on the server- if this is undesired, the server's message handler should catch the exception

commitc6ea9675a4c27947573d232e1ea0c6c397a1e342 authorAgentM <agentm@themactionfaction.com> dateSun 18 Oct 2020, 22:18 (6 years ago) parent96d0dd6

3 files changed+46−13

compare with master

unifiedsplit

src/Network/RPC/Curryer/Client.hs+5−1 src/Network/RPC/Curryer/Server.hs+17−11 test/Curryer/Test/Basic.hs+24−1

src/Network/RPC/Curryer/Client.hs+5−1

@@ -70,7 +70,11 @@ clientAsync sock syncmap decoder asyncHandler = do

7070 AsyncRequest _ asyncMsg ->

7171 asyncHandler asyncMsg

7272 ResponseExpectedRequest{} -> error "dumped response expected request"

73− ExceptionResponse _ -> error "TODO Exception"

73+ ExceptionResponse requestId excString -> do

74+ varval <- findRequest requestId

75+ case varval of

76+ Nothing -> error "dumped unrequested exception response"

77+ Just (mVar,_) -> putMVar mVar (Left (ExceptionError excString))

7478 TimedOutResponse requestId -> do

7579 varval <- findRequest requestId

7680 case varval of

src/Network/RPC/Curryer/Server.hs+17−11

@@ -56,15 +56,14 @@ data Message a = Response UUID a

5656 | AsyncRequest UUID a

5757 | ResponseExpectedRequest UUID (Maybe Timeout) a

5858 | TimedOutResponse UUID

59− -- | Services

60− | ExceptionResponse String

59+ | ExceptionResponse UUID String

6160 deriving (Generic, Show)

6261 deriving Serialise via WineryVariant (Message a)

6362

6463-- | The response type

6564data HandlerResponse a = NoResponse

6665 | HandlerResponse a

67− | HandlerException a

66+ | HandlerException String

6867 deriving Generic

6968 deriving Serialise via WineryVariant (HandlerResponse a)

7069

@@ -89,6 +88,7 @@ instance Serialise UUID where

8988

9089data ConnectionError = CodecError String -- show of WineryException from exception initiator which cannot otherwise be transmitted over a line due to dependencies on TypeReps

9190 | TimeoutError

91+ | ExceptionError String

9292 deriving (Generic, Show, Eq)

9393 deriving Serialise via WineryVariant ConnectionError

9494

@@ -130,7 +130,6 @@ serve connhandler userMsgHandler hostaddr port mSockLock = do

130130 Left exc -> error (show exc)

131131 Right dec -> dec

132132 handleSock sock = do

133− -- allow the server to send an async welcome message to the new client, if necessary

134133 mResp <- connhandler

135134 case mResp of

136135 Nothing -> pure ()

@@ -157,13 +156,20 @@ serverMessageHandler sock requestMessageHandler msg = do

157156 case msg of

158157 Response{} -> putStrLn "client sent response"

159158 ResponseExpectedRequest requestID mTimeout val -> do

160− resp <- runTimeout mTimeout (requestMessageHandler val)

161− case resp of

162− Just (HandlerResponse responseVal) -> sendMessage (Response requestID responseVal) sock

163− Just NoResponse -> error "attempt to return non-response to expected response message"

164− Just (HandlerException _) -> error "TODO HandlerException"

165− Nothing ->

166− sendMessage (TimedOutResponse @(Message resp) requestID) sock

159+ let normalResponder = do

160+ resp <- runTimeout mTimeout (requestMessageHandler val)

161+ case resp of

162+ Just (HandlerResponse responseVal) -> sendMessage (Response requestID responseVal) sock

163+ Just NoResponse -> error "attempt to return non-response to expected response message"

164+ Just (HandlerException exc) -> sendMessage (ExceptionResponse @(Message resp) requestID exc) sock

165+ Nothing ->

166+ sendMessage (TimedOutResponse @(Message resp) requestID) sock

167+ excHandler :: SomeException -> IO ()

168+ excHandler e = do

169+ --send exception to client

170+ sendMessage (ExceptionResponse @(Message resp) requestID (show e)) sock

171+ throwIO e

172+ catch normalResponder excHandler

167173 AsyncRequest _ val -> do

168174 void $ requestMessageHandler val

169175 --no response necessary

test/Curryer/Test/Basic.hs+24−1

@@ -9,6 +9,7 @@ import Network.Socket (SockAddr(..))

99import Control.Concurrent.Async

1010import Control.Monad

1111import Control.Concurrent

12+import Data.List

1213

1314import Network.RPC.Curryer.Server

1415import Network.RPC.Curryer.Client

@@ -17,7 +18,8 @@ testTree :: TestTree

1718testTree = testGroup "basic" [testCase "simple" testSimpleCall,

1819 testCase "client async" testAsyncServerCall,

1920 testCase "server async" testAsyncClientCall,

20− testCase "client sync timeout" testSyncClientCallTimeout

21+ testCase "client sync timeout" testSyncClientCallTimeout,

22+ testCase "server-side exception" testSyncException

2123 ]

2224

2325--client-to-server request

@@ -25,6 +27,7 @@ data TestRequest = AddTwoNumbersReq Int Int

2527 | TestAsyncReq String

2628 | TestCallMeBackReq String

2729 | DelayMicrosecondsReq Int

30+ | ThrowServerSideExceptionReq

2831 deriving (Generic, Show)

2932 deriving Serialise via WineryVariant TestRequest

3033

@@ -52,6 +55,7 @@ testServerMessageHandler mAsyncMVar msg = do

5255 DelayMicrosecondsReq ms -> do

5356 threadDelay ms

5457 pure (HandlerResponse DelayMicrosecondsResp)

58+ ThrowServerSideExceptionReq -> error "test server exception"

5559

5660-- test a simple client-to-server round-trip function execution

5761testSimpleCall :: Assertion

@@ -133,3 +137,22 @@ testSyncClientCallTimeout = do

133137 close conn

134138 cancel server

135139

140+testSyncException :: Assertion

141+testSyncException = do

142+ readyVar <- newEmptyMVar

143+

144+ server <- async (serve (pure Nothing) (testServerMessageHandler Nothing) localHostAddr 0 (Just readyVar))

145+ (SockAddrInet port _) <- takeMVar readyVar

146+ let clientHandler :: AsyncMessageHandler TestResponse

147+ clientHandler _ = error "async handler called"

148+ mkConn :: IO (Connection TestResponse)

149+ mkConn = connect clientHandler localHostAddr port

150+ conn <- mkConn

151+ ret <- call conn ThrowServerSideExceptionReq

152+ case ret of

153+ Left (ExceptionError actualExc) ->

154+ assertBool "server-side exception" ("test server exception" `isPrefixOf` actualExc)

155+ Right _ -> assertFailure "missed exception"

156+ close conn

157+ cancel server

158+