git.iko.soy/jsaddle
on master help sign in
Possible fix for "threadwait: invalid argument"
2e1bdcfHamish Mackenzie
jsaddle-warp/jsaddle-warp.cabal+1
compare with master
unifiedsplit
@@ -62,6 +62,7 @@ test-suite test-tool
62 jsaddle -any,
62 jsaddle -any,
63 jsaddle-warp -any,
63 jsaddle-warp -any,
64 lens -any,
64 lens -any,
65+ network -any,
65 ref-tf -any,
66 ref-tf -any,
66 primitive -any,
67 primitive -any,
67 process >=1.2.3.0 && <1.5,
68 process >=1.2.3.0 && <1.5,
jsaddle-warp/src/Language/Javascript/JSaddle/WebSockets.hs+18−2
@@ -19,7 +19,8 @@ module Language.Javascript.JSaddle.WebSockets (
19) where
19) where
20
20
21import Control.Monad (forever)
21import Control.Monad (forever)
22−import Control.Concurrent (forkIO)
22+import Control.Concurrent (forkIO, threadDelay)
23+import Control.Exception (handle, AsyncException, throwIO, fromException)
23
24
24import Data.Monoid ((<>))
25import Data.Monoid ((<>))
25import Data.Aeson (encode, decode)
26import Data.Aeson (encode, decode)
@@ -27,7 +28,7 @@ import Data.Aeson (encode, decode)
27import Network.Wai (Application)
28import Network.Wai (Application)
28import Network.WebSockets
29import Network.WebSockets
29 (ConnectionOptions(..), sendTextData, receiveDataMessage,
30 (ConnectionOptions(..), sendTextData, receiveDataMessage,
30− acceptRequest, ServerApp)
31+ acceptRequest, ServerApp, sendPing)
31import qualified Network.WebSockets as WS (DataMessage(..))
32import qualified Network.WebSockets as WS (DataMessage(..))
32import Network.Wai.Handler.WebSockets (websocketsOr)
33import Network.Wai.Handler.WebSockets (websocketsOr)
33
34
@@ -35,6 +36,7 @@ import Language.Javascript.JSaddle.Types (JSM(..))
35import qualified Network.Wai as W
36import qualified Network.Wai as W
36 (responseLBS, requestMethod, Application, pathInfo)
37 (responseLBS, requestMethod, Application, pathInfo)
37import Data.Text (Text)
38import Data.Text (Text)
39+import qualified Data.Text as T (pack)
38import qualified Network.HTTP.Types as H
40import qualified Network.HTTP.Types as H
39 (status403, status200, status405)
41 (status403, status200, status405)
40import Language.Javascript.JSaddle.Run (runJavaScript)
42import Language.Javascript.JSaddle.Run (runJavaScript)
@@ -55,6 +57,20 @@ jsaddleOr opts entryPoint = websocketsOr opts wsApp
55 Just r -> processResult r
57 Just r -> processResult r
56 _ -> error "jsaddle WebSocket unexpected binary data"
58 _ -> error "jsaddle WebSocket unexpected binary data"
57 start
59 start
60+ waitTillClosed conn
61+
62+ -- Based on Network.WebSocket.forkPingThread
63+ waitTillClosed conn = ignore `handle` go 1
64+ where
65+ go :: Int -> IO ()
66+ go i = do
67+ threadDelay (1 * 1000 * 1000)
68+ sendPing conn (T.pack $ show i)
69+ go (i + 1)
70+
71+ ignore e = case fromException e of
72+ Just async -> throwIO (async :: AsyncException)
73+ Nothing -> return ()
58
74
59jsaddleApp :: Application
75jsaddleApp :: Application
60jsaddleApp req = jsaddleAppPieces (W.pathInfo req) req
76jsaddleApp req = jsaddleAppPieces (W.pathInfo req) req