├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── bower.json ├── example ├── index.html └── src │ └── Main.purs ├── package.json └── src ├── WebSocket.js └── WebSocket.purs /.gitignore: -------------------------------------------------------------------------------- 1 | /.* 2 | !/.gitignore 3 | !/.eslintrc.json 4 | !/.travis.yml 5 | /bower_components/ 6 | /node_modules/ 7 | /output/ 8 | package-lock.json 9 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: node_js 2 | sudo: false 3 | node_js: 4 | - node 5 | install: 6 | - npm install -g bower 7 | - npm install 8 | script: 9 | - bower install --production 10 | - npm run build 11 | - bower install 12 | - npm run example 13 | - pulp run 14 | 15 | after_success: 16 | - >- 17 | test $TRAVIS_TAG && 18 | echo $GITHUB_TOKEN | pulp login && 19 | echo y | pulp publish --no-push 20 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, 2016 Konstantin Zudov 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Konstantin Zudov nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Simple Bindings to Websocket API for Purescript 2 | 3 | [![Documentation](https://pursuit.purescript.org/packages/purescript-websocket-simple/badge)](http://pursuit.purescript.org/packages/purescript-websocket-simple) 4 | [![Latest release](https://img.shields.io/bower/v/purescript-websocket-simple.svg)](https://github.com/zudov/purescript-websocket-simple/releases) 5 | [![Build Status](https://travis-ci.org/zudov/purescript-websocket-simple.svg?branch=master)](https://travis-ci.org/zudov/purescript-websocket-simple) 6 | 7 | ## Installation 8 | 9 | ``` 10 | bower install purescript-websocket-simple 11 | ``` 12 | 13 | If you are intending to use the library in a Node.js setting rather than the browser, you will need an additional dependency from `npm`: 14 | 15 | ``` 16 | npm install ws 17 | ``` 18 | 19 | ## Example usage 20 | 21 | See `example/src/Main.purs`. 22 | 23 | ## Documentation 24 | 25 | [Docs are on Pursuit](http://pursuit.purescript.org/packages/purescript-websocket-simple) 26 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-websocket-simple", 3 | "description": "A low-level wrapper around WebSocket API", 4 | "license": "BSD-3-Clause", 5 | "authors": [ 6 | "Konstantin Zudov " 7 | ], 8 | "license": "BSD-3-Clause", 9 | "moduleType": [ 10 | "node" 11 | ], 12 | "ignore": [ 13 | "**/.*", 14 | "node_modules", 15 | "bower_components", 16 | "output" 17 | ], 18 | "repository": { 19 | "type": "git", 20 | "url": "git://github.com/zudov/purescript-websocket-simple.git" 21 | }, 22 | "keywords": [ 23 | "purescript" 24 | ], 25 | "dependencies": { 26 | "purescript-web-socket": "^1.0.0", 27 | "purescript-web-events": "^1.0.0", 28 | "purescript-effect": "^2.0.0", 29 | "purescript-exceptions": "^4.0.0", 30 | "purescript-generics-rep": "^6.0.0", 31 | "purescript-var": "v3.0.0" 32 | }, 33 | "devDependencies": { 34 | "purescript-debug": "^4.0.0", 35 | "purescript-console": "^4.0.0" 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /example/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- /example/src/Main.purs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Prelude 4 | 5 | import Effect (Effect) 6 | import Effect.Var (($=), get) 7 | import Effect.Console (log) 8 | import Debug.Trace (traceM, class DebugWarning) 9 | 10 | import WebSocket (Connection(..), Message(..), URL(..), runMessageEvent, runMessage, runURL, newWebSocket) 11 | 12 | main :: Effect Unit 13 | main = do 14 | Connection socket <- newWebSocket (URL "ws://echo.websocket.org") [] 15 | 16 | socket.onopen $= \event -> do 17 | traceM event 18 | log "onopen: Connection opened" 19 | 20 | log <<< runURL =<< get socket.url 21 | 22 | log "onopen: Sending 'hello'" 23 | socket.send (Message "hello") 24 | 25 | log "onopen: Sending 'goodbye'" 26 | socket.send (Message "goodbye") 27 | 28 | socket.onmessage $= \event -> do 29 | traceM event 30 | let received = runMessage (runMessageEvent event) 31 | 32 | log $ "onmessage: Received '" <> received <> "'" 33 | 34 | when (received == "goodbye") do 35 | log "onmessage: closing connection" 36 | socket.close 37 | 38 | socket.onclose $= \event -> do 39 | traceM event 40 | log "onclose: Connection closed" 41 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "scripts": { 4 | "build": "pulp build -- --censor-lib", 5 | "example": "pulp build -I example/src/ -- --censor-lib" 6 | }, 7 | "dependencies": { 8 | "ws": "^6.1.2" 9 | }, 10 | "devDependencies": { 11 | "purescript-psa": "^0.6.0", 12 | "purescript": "^0.12.0", 13 | "pulp": "^12.2.0" 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /src/WebSocket.js: -------------------------------------------------------------------------------- 1 | /* global exports */ 2 | "use strict"; 3 | 4 | // module WebSocket 5 | 6 | exports.specViolation = function(s) { 7 | throw new Error(s); 8 | } 9 | 10 | exports.newWebSocketImpl = function(url, protocols) { 11 | return function() { 12 | var platformSpecific = {}; 13 | if (typeof module !== "undefined" && module.require) { 14 | // We are on node.js 15 | platformSpecific.WebSocket = module.require('ws'); 16 | } else { 17 | // We are in the browser 18 | platformSpecific.WebSocket = WebSocket; 19 | } 20 | var socket = new platformSpecific.WebSocket(url, protocols); 21 | var getSocketProp = function (prop) { 22 | return function() { return socket[prop]; } 23 | } 24 | var setSocketProp = function (prop) { 25 | return function(v) { 26 | return function() { 27 | socket[prop] = v; 28 | return {}; 29 | } 30 | } 31 | } 32 | return { setBinaryType: setSocketProp("binaryType") 33 | , getBinaryType: getSocketProp("binaryType") 34 | , getBufferedAmount: getSocketProp("bufferedAmount") 35 | , setOnclose: setSocketProp("onclose") 36 | , getOnclose: getSocketProp("onclose") 37 | , setOnerror: setSocketProp("onerror") 38 | , getOnerror: getSocketProp("onerror") 39 | , setOnmessage: setSocketProp("onmessage") 40 | , getOnmessage: getSocketProp("onmessage") 41 | , setOnopen: setSocketProp("onopen") 42 | , getOnopen: getSocketProp("onopen") 43 | , setProtocol: setSocketProp("protocol") 44 | , getProtocol: getSocketProp("protocol") 45 | , getReadyState: getSocketProp("readyState") 46 | , getUrl: getSocketProp("url") 47 | , closeImpl: 48 | function(params) { 49 | return function() { 50 | if (params == null) { 51 | socket.close(); 52 | } else if (params.reason == null) { 53 | socket.close(params.code); 54 | } else { 55 | socket.close(params.code, params.reason); 56 | } 57 | return {} 58 | } 59 | } 60 | , sendImpl: 61 | function(message) { 62 | return function() { 63 | socket.send(message); 64 | return {}; 65 | } 66 | } 67 | , getSocket: function () { return socket } 68 | }; 69 | } 70 | } 71 | -------------------------------------------------------------------------------- /src/WebSocket.purs: -------------------------------------------------------------------------------- 1 | -- | This module defines a simple low-level interface to the websockets API. 2 | 3 | module WebSocket 4 | ( WebSocket() 5 | , newWebSocket 6 | , Connection(..) 7 | , URL(..) 8 | , runURL 9 | , Message(..) 10 | , runMessage 11 | , runMessageEvent 12 | , Code(..) 13 | , runCode 14 | , Reason(..) 15 | , runReason 16 | , ReadyState(..) 17 | , Protocol(..) 18 | , runProtocol 19 | , BufferedAmount() 20 | , runBufferedAmount 21 | , BinaryType(..) 22 | ) where 23 | 24 | import Effect (Effect) 25 | import Effect.Var (Var, GettableVar, SettableVar, makeVar, makeGettableVar, makeSettableVar) 26 | import Web.Event.EventTarget (eventListener, EventListener) 27 | import Web.Event.Internal.Types (Event) 28 | import Web.Socket.Event.CloseEvent (CloseEvent) 29 | import Web.Socket.Event.MessageEvent (data_, MessageEvent) 30 | import Data.Enum (class BoundedEnum, class Enum, defaultSucc, defaultPred, toEnum, Cardinality(..)) 31 | import Foreign (unsafeFromForeign) 32 | import Data.Function.Uncurried (runFn2, Fn2) 33 | import Data.Functor.Invariant (imap) 34 | import Data.Generic.Rep (class Generic) 35 | import Data.Generic.Rep.Show (genericShow) 36 | import Data.Generic.Rep.Eq (genericEq) 37 | import Data.Generic.Rep.Ord (genericCompare) 38 | import Data.Maybe (Maybe(..), fromMaybe) 39 | import Data.Nullable (toNullable, Nullable) 40 | import Prelude (class Ord, compare, class Eq, eq, class Bounded, class Show, Unit, (<$>), (>>>), (>>=), ($)) 41 | import Unsafe.Coerce (unsafeCoerce) 42 | 43 | foreign import specViolation :: forall a. String -> a 44 | 45 | -- | A reference to a WebSocket object. 46 | foreign import data WebSocket :: Type 47 | 48 | -- | Initiate a websocket connection. 49 | newWebSocket :: URL -> Array Protocol -> Effect Connection 50 | newWebSocket url protocols = enhanceConnection <$> runFn2 newWebSocketImpl url protocols 51 | 52 | foreign import newWebSocketImpl :: Fn2 URL 53 | (Array Protocol) 54 | (Effect ConnectionImpl) 55 | 56 | runMessageEvent :: MessageEvent -> Message 57 | runMessageEvent event = unsafeFromForeign $ data_ event 58 | 59 | type ConnectionImpl = 60 | { setBinaryType :: String -> Effect Unit 61 | , getBinaryType :: Effect String 62 | , getBufferedAmount :: Effect BufferedAmount 63 | , setOnclose :: EventListener -> Effect Unit 64 | , setOnerror :: EventListener -> Effect Unit 65 | , setOnmessage :: EventListener -> Effect Unit 66 | , setOnopen :: EventListener -> Effect Unit 67 | , setProtocol :: Protocol -> Effect Unit 68 | , getProtocol :: Effect Protocol 69 | , getReadyState :: Effect Int 70 | , getUrl :: Effect URL 71 | , closeImpl :: Nullable { code :: Code, reason :: Nullable Reason } -> Effect Unit 72 | , sendImpl :: Message -> Effect Unit 73 | , getSocket :: Effect WebSocket 74 | } 75 | 76 | coerceEvent :: forall a. Event -> a 77 | coerceEvent = unsafeCoerce 78 | 79 | enhanceConnection :: ConnectionImpl -> Connection 80 | enhanceConnection c = Connection $ 81 | { binaryType: imap toBinaryType fromBinaryType $ makeVar c.getBinaryType c.setBinaryType 82 | , bufferedAmount: makeGettableVar c.getBufferedAmount 83 | , onclose: makeSettableVar \f -> eventListener (coerceEvent >>> f) >>= c.setOnclose 84 | , onerror: makeSettableVar \f -> eventListener (coerceEvent >>> f) >>= c.setOnerror 85 | , onmessage: makeSettableVar \f -> eventListener (coerceEvent >>> f) >>= c.setOnmessage 86 | , onopen: makeSettableVar \f -> eventListener (coerceEvent >>> f) >>= c.setOnopen 87 | , protocol: makeVar c.getProtocol c.setProtocol 88 | , readyState: unsafeReadyState <$> makeGettableVar c.getReadyState 89 | , url: makeGettableVar c.getUrl 90 | , close: c.closeImpl (toNullable Nothing) 91 | , close': \code reason -> c.closeImpl (toNullable (Just { code, reason: toNullable reason })) 92 | , send: c.sendImpl 93 | , socket: makeGettableVar c.getSocket 94 | } 95 | where 96 | unsafeReadyState :: Int -> ReadyState 97 | unsafeReadyState x = 98 | fromMaybe (specViolation "readyState isn't in the range of valid constants") 99 | (toEnum x) 100 | 101 | 102 | -- | - `binaryType` -- The type of binary data being transmitted by the connection. 103 | -- | - `bufferedAmount` -- The number of bytes of data that have been queued 104 | -- | using calls to `send` but not yet transmitted to the 105 | -- | network. This value does not reset to zero when the 106 | -- | connection is closed; if you keep calling `send`, 107 | -- | this will continue to climb. 108 | -- | - `onclose` -- An event listener to be called when the `Connection`'s 109 | -- | `readyState` changes to `Closed`. 110 | -- | - `onerror` -- An event listener to be called when an error occurs. 111 | -- | - `onmessage` -- An event listener to be called when a message is received 112 | -- | from the server. 113 | -- | - `onopen` -- An event listener to be called when the `Connection`'s 114 | -- | readyState changes to `Open`; this indicates that the 115 | -- | connection is ready to send and receive data. 116 | -- | - `protocol` -- A string indicating the name of the sub-protocol the server selected. 117 | -- | - `readyState` -- The current state of the connection. 118 | -- | - `url` -- The URL as resolved by during construction. This is always an absolute URL. 119 | -- | - `close` -- Closes the connection or connection attempt, if any. 120 | -- | If the connection is already CLOSED, this method does nothing. 121 | -- | If `Code` isn't specified a default value of 1000 (indicating 122 | -- | a normal "transaction complete" closure) is assumed 123 | -- | - `send` -- Transmits data to the server. 124 | -- | - `socket` -- Reference to closured WebSocket object. 125 | newtype Connection = Connection 126 | { binaryType :: Var BinaryType 127 | , bufferedAmount :: GettableVar BufferedAmount 128 | , onclose :: SettableVar (CloseEvent -> Effect Unit) 129 | , onerror :: SettableVar (Event -> Effect Unit) 130 | , onmessage :: SettableVar (MessageEvent -> Effect Unit) 131 | , onopen :: SettableVar (Event -> Effect Unit) 132 | , protocol :: Var Protocol 133 | , readyState :: GettableVar ReadyState 134 | , url :: GettableVar URL 135 | , close :: Effect Unit 136 | , close' :: Code -> Maybe Reason -> Effect Unit 137 | , send :: Message -> Effect Unit 138 | , socket :: GettableVar WebSocket 139 | } 140 | 141 | -- | The type of binary data being transmitted by the connection. 142 | data BinaryType = Blob | ArrayBuffer 143 | 144 | toBinaryType :: String -> BinaryType 145 | toBinaryType "blob" = Blob 146 | toBinaryType "arraybuffer" = ArrayBuffer 147 | toBinaryType s = specViolation "binaryType should be either 'blob' or 'arraybuffer'" 148 | 149 | fromBinaryType :: BinaryType -> String 150 | fromBinaryType Blob = "blob" 151 | fromBinaryType ArrayBuffer = "arraybuffer" 152 | 153 | -- | The number of bytes of data that have been buffered (queued but not yet transmitted) 154 | newtype BufferedAmount = BufferedAmount Int 155 | 156 | runBufferedAmount :: BufferedAmount -> Int 157 | runBufferedAmount (BufferedAmount a) = a 158 | 159 | derive instance genericBufferedAmount :: Generic BufferedAmount _ 160 | instance eqBufferedAmount :: Eq BufferedAmount where 161 | eq (BufferedAmount a) (BufferedAmount b) = eq a b 162 | instance ordBufferedAmount :: Ord BufferedAmount where 163 | compare (BufferedAmount a) (BufferedAmount b) = compare a b 164 | 165 | -- | A string indicating the name of the sub-protocol. 166 | newtype Protocol = Protocol String 167 | 168 | runProtocol :: Protocol -> String 169 | runProtocol (Protocol a) = a 170 | 171 | derive instance genericProtocol :: Generic Protocol _ 172 | instance eqProtocol :: Eq Protocol where 173 | eq (Protocol a) (Protocol b) = eq a b 174 | instance ordProtocol :: Ord Protocol where 175 | compare (Protocol a) (Protocol b) = compare a b 176 | 177 | -- | State of the connection. 178 | data ReadyState = Connecting | Open | Closing | Closed 179 | 180 | derive instance genericReadyState :: Generic ReadyState _ 181 | 182 | instance eqReadyState :: Eq ReadyState where 183 | eq = genericEq 184 | 185 | instance ordReadyState :: Ord ReadyState where 186 | compare = genericCompare 187 | 188 | instance showReadyState :: Show ReadyState where 189 | show = genericShow 190 | 191 | instance boundedReadyState :: Bounded ReadyState where 192 | bottom = Connecting 193 | top = Closed 194 | 195 | instance boundedEnumReadyState :: BoundedEnum ReadyState where 196 | cardinality = Cardinality 4 197 | toEnum = toEnumReadyState 198 | fromEnum = fromEnumReadyState 199 | 200 | instance enumReadyState :: Enum ReadyState where 201 | succ = defaultSucc toEnumReadyState fromEnumReadyState 202 | pred = defaultPred toEnumReadyState fromEnumReadyState 203 | 204 | toEnumReadyState :: Int -> Maybe ReadyState 205 | toEnumReadyState 0 = Just Connecting 206 | toEnumReadyState 1 = Just Open 207 | toEnumReadyState 2 = Just Closing 208 | toEnumReadyState 3 = Just Closed 209 | toEnumReadyState _ = Nothing 210 | 211 | fromEnumReadyState :: ReadyState -> Int 212 | fromEnumReadyState Connecting = 0 213 | fromEnumReadyState Open = 1 214 | fromEnumReadyState Closing = 2 215 | fromEnumReadyState Closed = 3 216 | 217 | -- | Should be either equal to 1000 (indicating normal closure) or in the range 218 | -- | of 3000-4999. 219 | newtype Code 220 | = Code Int 221 | 222 | runCode :: Code -> Int 223 | runCode (Code a) = a 224 | 225 | derive instance genericCode :: Generic Code _ 226 | instance eqCode :: Eq Code where 227 | eq (Code a) (Code b) = eq a b 228 | instance ordCode :: Ord Code where 229 | compare (Code a) (Code b) = compare a b 230 | 231 | -- | A human-readable string explaining why the connection is closing. This 232 | -- | string must be no longer than 123 bytes of UTF-8 text (not characters). 233 | newtype Reason = Reason String 234 | 235 | runReason :: Reason -> String 236 | runReason (Reason a) = a 237 | 238 | derive instance genericReason :: Generic Reason _ 239 | 240 | -- | A synonym for URL strings. 241 | newtype URL = URL String 242 | 243 | runURL :: URL -> String 244 | runURL (URL a) = a 245 | 246 | derive instance genericURL :: Generic URL _ 247 | 248 | -- | A synonym for message strings. 249 | newtype Message = Message String 250 | derive instance genericMessage :: Generic Message _ 251 | 252 | runMessage :: Message -> String 253 | runMessage (Message a) = a 254 | --------------------------------------------------------------------------------