metro-transport-websockets (empty) → 0.1.0.0

raw patch · 6 files changed

+143/−0 lines, 6 filesdep +basedep +bytestringdep +metrosetup-changed

Dependencies added: base, bytestring, metro, websockets

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• README.md +3/−0
• Setup.hs +2/−0
• metro-transport-websockets.cabal +42/−0
• src/Metro/TP/WebSockets.hs +63/−0

@@ -0,0 +1,3 @@+# Changelog for metro-transport-websockets++## Unreleased changes

@@ -0,0 +1,30 @@+Copyright Lupino (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Lupino nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,3 @@+# metro-transport-websockets++Websockets transport for metro

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,42 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 827994d7edfa7de9ddc554689c94455f9ac4747c7e0fa2e21a5647547d6e9b24++name:           metro-transport-websockets+version:        0.1.0.0+synopsis:       Websockets transport for metro+description:    Please see the README on GitHub at <https://github.com/Lupino/metro/tree/master/metro-transport-websockets#readme>+category:       Web+homepage:       https://github.com/Lupino/metro#readme+bug-reports:    https://github.com/Lupino/metro/issues+author:         Lupino+maintainer:     lmjubuntu@gmail.com+copyright:      MIT+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/Lupino/metro++library+  exposed-modules:+      Metro.TP.WebSockets+  other-modules:+      Paths_metro_transport_websockets+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , bytestring+    , metro+    , websockets+  default-language: Haskell2010

@@ -0,0 +1,63 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE LambdaCase                #-}+{-# LANGUAGE TypeFamilies              #-}+module Metro.TP.WebSockets+  ( WebSocket+  , serverConfig+  , clientConfig+  ) where++import           Data.ByteString           (ByteString, empty)+import qualified Data.ByteString.Char8     as BC+import qualified Data.ByteString.Lazy      as BL+import           Metro.Class               (Transport (..))+import           Network.WebSockets        as WS+import qualified Network.WebSockets.Stream as WS++mkStream :: Transport tp => tp -> IO WS.Stream+mkStream transport =+  WS.makeStream+    (do+        bs <- recvData transport 8192+        return $ if BC.null bs then Nothing else Just bs)+    (\case+        Nothing -> return ()+        Just bl -> sendData transport $ BL.toStrict bl)++wsRecvData :: WS.Connection -> Int -> IO ByteString+wsRecvData conn _ = do+  msg <- WS.receiveDataMessage conn+  case msg of+    WS.Binary bs -> pure $ BL.toStrict bs+    _            -> pure empty++wsSendData :: WS.Connection -> ByteString -> IO ()+wsSendData conn = WS.sendBinaryData conn . BL.fromStrict++data WebSocket tp = WS WS.Connection tp++instance Transport tp => Transport (WebSocket tp) where+  data TransportConfig (WebSocket tp) =+      WSServer (TransportConfig tp)+    | WSClient (TransportConfig tp) String String+  newTransport (WSServer config) = do+    transport <- newTransport config+    stream <- mkStream transport+    pendingConn <- WS.makePendingConnectionFromStream stream WS.defaultConnectionOptions+    flip WS transport <$> WS.acceptRequest pendingConn+  newTransport (WSClient config host port) = do+    transport <- newTransport config+    stream <- mkStream transport+    flip WS transport <$> WS.newClientConnection stream host port WS.defaultConnectionOptions []++  recvData (WS conn _) = wsRecvData conn+  sendData (WS conn _) = wsSendData conn++  closeTransport (WS _ tp) = closeTransport tp+++serverConfig :: Transport tp => TransportConfig tp -> TransportConfig (WebSocket tp)+serverConfig = WSServer++clientConfig :: Transport tp => TransportConfig tp -> String -> String -> TransportConfig (WebSocket tp)+clientConfig = WSClient