websockets-snap 0.10.3.0 → 0.10.3.1

raw patch · 3 files changed

+24/−12 lines, 3 filesdep ~bytestringdep ~mtldep ~websocketsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: bytestring, mtl, websockets

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• src/Network/WebSockets/Snap.hs +19/−11
• websockets-snap.cabal +1/−1

@@ -1,5 +1,9 @@ # CHANGELOG +- 0.10.3.1 (2019-05-06)+    * Gracefully close ping threads when ServerApp finishes (by Lorenz+      Mösenlechner)+ - 0.10.3.0 (2018-05-13)     * Increase ping thread frequency to every 10s, extend Snap timeout by at       least 60s (by Dmitry Dzhus)

@@ -12,8 +12,10 @@ import           Control.Concurrent            (forkIO, myThreadId, threadDelay) import           Control.Exception             (Exception (..),                                                 SomeException (..), handle,-                                                throwTo)-import           Control.Monad                 (forever)+                                                throwTo, finally)+import           Data.IORef                    (IORef, newIORef, readIORef,+                                                writeIORef)+import           Control.Monad                 (unless) import           Data.ByteString               (ByteString) import qualified Data.ByteString.Builder       as BSBuilder import qualified Data.ByteString.Builder.Extra as BSBuilder@@ -26,7 +28,6 @@ import qualified Snap.Types.Headers            as Headers import qualified System.IO.Streams             as Streams - -------------------------------------------------------------------------------- data Chunk     = Chunk ByteString@@ -76,6 +77,8 @@                   Streams.write (Just BSBuilder.flush) writeEnd               ) +    done <- newIORef False+     let options' = options                    { WS.connectionOnPong = do                         tickle (max 45)@@ -85,23 +88,28 @@         pc = WS.PendingConnection                { WS.pendingOptions  = options'                , WS.pendingRequest  = fromSnapRequest rq-               , WS.pendingOnAccept = forkPingThread tickle+               , WS.pendingOnAccept = forkPingThread tickle done                , WS.pendingStream   = stream                }-    app pc >> throwTo thisThread ServerAppDone+    (app pc >> throwTo thisThread ServerAppDone) `finally` writeIORef done True   -------------------------------------------------------------------------------- -- | Start a ping thread in the background-forkPingThread :: ((Int -> Int) -> IO ()) -> WS.Connection -> IO ()-forkPingThread tickle conn = do+forkPingThread :: ((Int -> Int) -> IO ()) -> IORef Bool -> WS.Connection -> IO ()+forkPingThread tickle done conn = do     _ <- forkIO pingThread     return ()   where-    pingThread = handle ignore $ forever $ do-        WS.sendPing conn (BC.pack "ping")-        tickle (max 60)-        threadDelay $ 10 * 1000 * 1000+    pingThread = handle ignore $+        let loop = do+                d <- readIORef done+                unless d $ do+                    WS.sendPing conn (BC.pack "ping")+                    tickle (max 60)+                    threadDelay $ 10 * 1000 * 1000+                    loop in+        loop      ignore :: SomeException -> IO ()     ignore _   = return ()

@@ -1,5 +1,5 @@ Name:          websockets-snap-Version:       0.10.3.0+Version:       0.10.3.1 Synopsis:      Snap integration for the websockets library Description:   Snap integration for the websockets library License:       BSD3