servant-websockets 1.0.0 → 1.1.0
raw patch · 6 files changed
+72/−12 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Servant.API.WebSocket: data WebSocketPending
+ Servant.API.WebSocket: instance Servant.Server.Internal.HasServer Servant.API.WebSocket.WebSocketPending ctx
Files
- CHANGELOG.md +5/−0
- README.md +4/−3
- examples/Echo.hs +2/−4
- servant-websockets.cabal +1/−1
- src/Servant/API/WebSocket.hs +55/−4
- src/Servant/API/WebSocketConduit.hs +5/−0
CHANGELOG.md view
@@ -1,3 +1,8 @@+# Version 1.1.0++ * Compatibility with servant-0.12.+ * Added instance for WebSocketPending.+ # Version 1.0.0 * Initial release of `servant-websockets`.
README.md view
@@ -3,11 +3,12 @@ This small library provides two servant endpoints for implementing websockets and is based on `websockets` and `wai-websockets`. -This library provides two `servant` endpoints: `WebSocket` and-`WebSocketConduit`. The former is a low-level interface for directly+This library provides three `servant` endpoints: `WebSocket`, `WebSocketPending` and+`WebSocketConduit`. `WebSocket` is is a low-level interface for directly interacting with a `Connection` (see the [websockets](https://hackage.haskell.org/package/websockets) library-for more information). The latter provides a+for more information). `WebSocketPending` allows using the `rejectRequest`+with various return codes for greater control. `WebSocketConduit` provides a [conduit](https://hackage.haskell.org/package/conduit) based endpoint for JSON serializable input and output.
examples/Echo.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-} module Main where @@ -7,13 +7,11 @@ import Data.Aeson (Value) import Data.Conduit (Conduit)-import Data.Monoid ((<>)) import Network.Wai (Application) import Network.Wai.Handler.Warp (run) import Servant (Proxy (..), Server, serve) import qualified Data.Conduit.List as CL- type API = WebSocketConduit Value Value
servant-websockets.cabal view
@@ -1,5 +1,5 @@ name: servant-websockets-version: 1.0.0+version: 1.1.0 homepage: https://github.com/moesenle/servant-websockets#readme synopsis: Small library providing WebSocket endpoints for servant. description: Small library providing WebSocket endpoints for servant.
src/Servant/API/WebSocket.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-}@@ -9,7 +10,7 @@ import Control.Monad.Trans.Resource (runResourceT) import Data.Proxy (Proxy (..)) import Network.Wai.Handler.WebSockets (websocketsOr)-import Network.WebSockets (Connection, acceptRequest, defaultConnectionOptions)+import Network.WebSockets (Connection, PendingConnection, acceptRequest, defaultConnectionOptions) import Servant.Server (HasServer (..), ServantErr (..), ServerT, runHandler) import Servant.Server.Internal.Router (leafRouter) import Servant.Server.Internal.RoutingApplication (RouteResult (..), runDelayed)@@ -26,15 +27,20 @@ -- > server = streamData -- > where -- > streamData :: MonadIO m => Connection -> m ()--- > streamData c = liftIO . forM_ [1..] $ \i -> do--- > forkPingThread c 10--- > sendTextData c (pack $ show (i :: Int)) >> threadDelay 1000000+-- > streamData c = do+-- > liftIO $ forkPingThread c 10+-- > liftIO . forM_ [1..] $ \i -> do+-- > sendTextData c (pack $ show (i :: Int)) >> threadDelay 1000000 data WebSocket instance HasServer WebSocket ctx where type ServerT WebSocket m = Connection -> m () +#if MIN_VERSION_servant_server(0,12,0)+ hoistServerWithContext _ _ nat svr = nat . svr+#endif+ route Proxy _ app = leafRouter $ \env request respond -> runResourceT $ runDelayed app env request >>= liftIO . go request respond where@@ -44,6 +50,51 @@ go _ respond (FailFatal e) = respond $ FailFatal e runApp a = acceptRequest >=> \c -> void (runHandler $ a c)++ backupApp respond _ _ = respond $ Fail ServantErr { errHTTPCode = 426+ , errReasonPhrase = "Upgrade Required"+ , errBody = mempty+ , errHeaders = mempty+ }+++-- | Endpoint for defining a route to provide a web socket. The+-- handler function gets a 'PendingConnection'. It can either+-- 'rejectRequest' or 'acceptRequest'. This function is provided+-- for greater flexibility to reject connections.+--+-- Example:+--+-- > type WebSocketApi = "stream" :> WebSocketPending+-- >+-- > server :: Server WebSocketApi+-- > server = streamData+-- > where+-- > streamData :: MonadIO m => PendingConnection -> m ()+-- > streamData pc = do+-- > c <- acceptRequest pc+-- > liftIO $ forkPingThread c 10+-- > liftIO . forM_ [1..] $ \i ->+-- > sendTextData c (pack $ show (i :: Int)) >> threadDelay 1000000+data WebSocketPending++instance HasServer WebSocketPending ctx where++ type ServerT WebSocketPending m = PendingConnection -> m ()++#if MIN_VERSION_servant_server(0,12,0)+ hoistServerWithContext _ _ nat svr = nat . svr+#endif++ route Proxy _ app = leafRouter $ \env request respond -> runResourceT $+ runDelayed app env request >>= liftIO . go request respond+ where+ go request respond (Route app') =+ websocketsOr defaultConnectionOptions (runApp app') (backupApp respond) request (respond . Route)+ go _ respond (Fail e) = respond $ Fail e+ go _ respond (FailFatal e) = respond $ FailFatal e++ runApp a c = void (runHandler $ a c) backupApp respond _ _ = respond $ Fail ServantErr { errHTTPCode = 426 , errReasonPhrase = "Upgrade Required"
src/Servant/API/WebSocketConduit.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}@@ -56,6 +57,10 @@ instance (FromJSON i, ToJSON o) => HasServer (WebSocketConduit i o) ctx where type ServerT (WebSocketConduit i o) m = Conduit i (ResourceT IO) o++#if MIN_VERSION_servant_server(0,12,0)+ hoistServerWithContext _ _ _ svr = svr+#endif route Proxy _ app = leafRouter $ \env request respond -> runResourceT $ runDelayed app env request >>= liftIO . go request respond