websockets-snap 0.9.2.0 → 0.10.0.0

raw patch · 3 files changed

+40/−96 lines, 3 filesdep +io-streamsdep −enumeratordep ~snap-coredep ~snap-serverPVP ok

version bump matches the API change (PVP)

Dependencies added: io-streams

Dependencies removed: enumerator

Dependency ranges changed: snap-core, snap-server

API changes (from Hackage documentation)

Files

• CHANGELOG +5/−0
• src/Network/WebSockets/Snap.hs +31/−92
• websockets-snap.cabal +4/−4

@@ -1,3 +1,8 @@+- 0.10.0.0+    * Bump snap-core and snap-server to 1.0.0.0+    * Remove git submodules; use hackage for all dependencies+    * Use cabal.project file to build example server+ - 0.9.2.0     * Bump websockets to 0.9.5.0 to fix socket closing issues 

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- | Snap integration for the WebSockets library {-# LANGUAGE DeriveDataTypeable #-}@@ -9,26 +11,21 @@  -------------------------------------------------------------------------------- import           Control.Concurrent            (forkIO, myThreadId, threadDelay)-import           Control.Concurrent.MVar       (MVar, newEmptyMVar, putMVar,-                                                takeMVar) import           Control.Exception             (Exception (..),-                                                SomeException (..), finally,-                                                handle, throwIO, throwTo)+                                                SomeException (..),+                                                handle, throwTo) import           Control.Monad                 (forever)-import           Control.Monad.Trans           (lift) import           Data.ByteString               (ByteString)+import qualified Data.ByteString.Builder       as BSBuilder+import qualified Data.ByteString.Builder.Extra as BSBuilder import qualified Data.ByteString.Char8         as BC-import qualified Data.ByteString.Lazy          as BL-import qualified Data.Enumerator               as E-import qualified Data.Enumerator.List          as EL-import           Data.IORef                    (newIORef, readIORef, writeIORef) import           Data.Typeable                 (Typeable, cast) import qualified Network.WebSockets            as WS import qualified Network.WebSockets.Connection as WS import qualified Network.WebSockets.Stream     as WS import qualified Snap.Core                     as Snap-import qualified Snap.Internal.Http.Types      as Snap import qualified Snap.Types.Headers            as Headers+import qualified System.IO.Streams             as Streams   --------------------------------------------------------------------------------@@ -51,61 +48,6 @@   ---------------------------------------------------------------------------------copyIterateeToMVar-    :: ((Int -> Int) -> IO ())-    -> MVar Chunk-    -> E.Iteratee ByteString IO ()-copyIterateeToMVar tickle mvar = E.catchError go handler-  where-    go = do-        mbs <- EL.head-        case mbs of-            Just x  -> do-                lift (tickle (max 60))-                lift (putMVar mvar (Chunk x))-                go-            Nothing -> lift (putMVar mvar Eof)--    handler se@(SomeException e) = case cast e of-        -- Clean exit-        Just ServerAppDone -> return ()-        -- Actual error-        Nothing            -> lift $ putMVar mvar $ Error se------------------------------------------------------------------------------------copyMVarToStream :: MVar Chunk -> IO (IO (Maybe ByteString))-copyMVarToStream mvar = return go-  where-    go = do-        chunk <- takeMVar mvar-        case chunk of-            Chunk x                 -> return (Just x)-            Eof                     -> return Nothing-            Error (SomeException e) -> throwIO e------------------------------------------------------------------------------------copyStreamToIteratee-    :: E.Iteratee ByteString IO ()-    -> IO (Maybe BL.ByteString -> IO ())-copyStreamToIteratee iteratee0 = do-    ref <- newIORef =<< E.runIteratee iteratee0-    return (go ref)-  where-    go _   Nothing   = return ()-    go ref (Just bl) = do-        step <- readIORef ref-        case step of-            E.Continue f              -> do-                let chunks = BL.toChunks bl-                step' <- E.runIteratee $ f $ E.Chunks chunks-                writeIORef ref step'-            E.Yield () _              -> throwIO WS.ConnectionClosed-            E.Error (SomeException e) -> throwIO e----------------------------------------------------------------------------------- -- | The following function escapes from the current 'Snap.Snap' handler, and -- continues processing the 'WS.WebSockets' action. The action to be executed -- takes the 'WS.Request' as a parameter, because snap has already read this@@ -120,37 +62,34 @@ -------------------------------------------------------------------------------- -- | Variant of 'runWebSocketsSnap' which allows custom options runWebSocketsSnapWith-    :: Snap.MonadSnap m-    => WS.ConnectionOptions-    -> WS.ServerApp-    -> m ()+  :: Snap.MonadSnap m+  => WS.ConnectionOptions+  -> WS.ServerApp+  -> m () runWebSocketsSnapWith options app = do-    rq <- Snap.getRequest-    Snap.escapeHttp $ \tickle writeEnd -> do--        thisThread <- lift myThreadId-        mvar       <- lift newEmptyMVar-        parse      <- lift $ copyMVarToStream mvar-        write      <- lift $ copyStreamToIteratee writeEnd-        stream     <- lift $ WS.makeStream parse write+  rq <- Snap.getRequest+  Snap.escapeHttp $ \tickle readEnd writeEnd -> do -        let options' = options-                    { WS.connectionOnPong = do-                            tickle (max 60)-                            WS.connectionOnPong options-                    }+    thisThread <- myThreadId+    stream <- WS.makeStream (tickle (max 20) >> Streams.read readEnd)+              (\v -> do+                  Streams.write (fmap BSBuilder.lazyByteString v) writeEnd+                  Streams.write (Just BSBuilder.flush) writeEnd+              ) -            pc = WS.PendingConnection-                    { WS.pendingOptions  = options'-                    , WS.pendingRequest  = fromSnapRequest rq-                    , WS.pendingOnAccept = forkPingThread tickle-                    , WS.pendingStream   = stream-                    }+    let options' = options+                   { WS.connectionOnPong = do+                        tickle (max 30)+                        WS.connectionOnPong options+                   } -        _ <- lift $ forkIO $ finally (app pc) $ do-            WS.close stream-            throwTo thisThread ServerAppDone-        copyIterateeToMVar tickle mvar+        pc = WS.PendingConnection+               { WS.pendingOptions  = options'+               , WS.pendingRequest  = fromSnapRequest rq+               , WS.pendingOnAccept = forkPingThread tickle+               , WS.pendingStream   = stream+               }+    app pc >> throwTo thisThread ServerAppDone   --------------------------------------------------------------------------------

@@ -1,5 +1,5 @@ Name:          websockets-snap-Version:       0.9.2.0+Version:       0.10.0.0 Synopsis:      Snap integration for the websockets library Description:   Snap integration for the websockets library License:       BSD3@@ -23,10 +23,10 @@   Build-depends:     base          >= 4     && < 5,     bytestring    >= 0.9   && < 0.11,-    enumerator    >= 0.4   && < 0.5,+    io-streams    >= 1.3   && < 1.4,     mtl           >= 2.1   && < 2.3,-    snap-core     >= 0.8   && < 0.10,-    snap-server   >= 0.8   && < 0.10,+    snap-core     >= 1.0   && < 1.1,+    snap-server   >= 1.0   && < 1.1,     websockets    >= 0.9.5 && < 0.10  Source-repository head