├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── NOTICE ├── PROTOCOL.md ├── README.md ├── elm.json ├── example ├── .gitignore ├── README.md ├── bin │ ├── build │ ├── buildsimple │ ├── echoserver │ ├── m │ └── update ├── elm.json ├── site │ ├── echoserver.js │ ├── elm.js.dummy │ ├── index.html │ └── js │ │ ├── PortFunnel.js │ │ └── PortFunnel │ │ └── WebSocket.js └── src │ ├── Main.elm │ ├── PortFunnels.elm │ └── simple.elm ├── src └── PortFunnel │ ├── WebSocket.elm │ └── WebSocket │ └── InternalMessage.elm └── tests └── Tests.elm /.gitignore: -------------------------------------------------------------------------------- 1 | elm-stuff 2 | docs.json 3 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for billstclair/elm-websocket-client 2 | 3 | ## 4.0.0, 10/12/2018 4 | 5 | Add `ReconnectedResponse` and return it when the connection is re-established after being lost. 6 | 7 | Add `reconnectedResponses` (and `filterResponses` and `isReconnectedResponse`) to aid in filtering a `ListResponse`, which may contain a `ReconnectedResponse`. 8 | 9 | ## 3.0.2, 10/11/2018 10 | 11 | * Make the JavaScript code work with WebPack (issue #3). 12 | 13 | * Fix documentation issues, #1 & #2. 14 | 15 | ## 3.0.1, 10/1/2018 16 | 17 | * Update example to use `PortFunnels.elm` for all the baroque dispatching. 18 | 19 | ## 3.0.0, 9/22/2018 20 | 21 | * Join the [billstclair/elm-port-funnel](https://package.elm-lang.org/packages/billstclair/elm-port-funnel/latest) ecosystem. 22 | 23 | * `setAutoReopen` and `willAutoReopen` to control automatic reconnection on unexpected connection loss. 24 | 25 | ## 2.0.2, 9/4/2018 26 | 27 | * Remove README paragraph about no automatic reconnect. It was there in 2.0.0. 28 | 29 | * Implement `keepAlive`. Can't imagine anyone using it, instead of just ignoring `MessageReceivedResponse`, but it was in the original `WebSocket` module, so I'm keeping it. 30 | 31 | ## 2.0.1, 9/4/2018 32 | 33 | * Fix some doc strings. 34 | 35 | ## 2.0.0, 9/4/2018 36 | 37 | * Reconnect with exponential backoff after unexpected connection loss. 38 | * Add a simple Node.js WebSocket echo server for testing. 39 | * Queue sends while connection is being established or reconnection is in process. 40 | * Reorganize socket state representation. 41 | * Incompatible API changes: 42 | 1. Added `PortVersion` type with a single value: `PortVersion2` 43 | I'll bump this when I make incompatible changes to the port JavaScript code, to remind you to update your site with the new `WebSocketClient.js`. 44 | 2. Added `PortVersion` arg to `open`, `openWithKey`, and `send`. 45 | 3. Added missing "o" to `UnsupprtedDataClosure` 46 | 4. Added TimeOutOnReconnect to `ClosedCode` 47 | 48 | ## 1.0.1, 9/2/2018 49 | 50 | * Fix default port names in non-standard port example in example/README.md 51 | * Fix link to live page in top-level README.md 52 | 53 | ## 1.0.0, 9/2/2018 54 | 55 | First published. 56 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2018 Bill St. Clair 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining 6 | a copy of this software and associated documentation files (the 7 | "Software"), to deal in the Software without restriction, including 8 | without limitation the rights to use, copy, modify, merge, publish, 9 | distribute, sublicense, and/or sell copies of the Software, and to 10 | permit persons to whom the Software is furnished to do so, subject to 11 | the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be 14 | included in all copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 20 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 21 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 22 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 23 | -------------------------------------------------------------------------------- /NOTICE: -------------------------------------------------------------------------------- 1 | This software is a modified version of the elm-lang/websocket package, 2 | which was part of Elm 0.18, but did not ship with Elm 0.19. That 3 | package was distributed with a BSD-3-Clause license, which requires 4 | that I say the following: 5 | 6 | Copyright (c) 2016, Evan Czaplicki 7 | 8 | All rights reserved. 9 | 10 | * Redistributions of source code must retain the above copyright 11 | notice, this list of conditions and the following disclaimer. 12 | 13 | * Redistributions in binary form must reproduce the above 14 | copyright notice, this list of conditions and the following 15 | disclaimer in the documentation and/or other materials provided 16 | with the distribution. 17 | 18 | * Neither the name of Evan Czaplicki nor the names of other 19 | contributors may be used to endorse or promote products derived 20 | from this software without specific prior written permission. 21 | -------------------------------------------------------------------------------- /PROTOCOL.md: -------------------------------------------------------------------------------- 1 | # Communication Protocols 2 | 3 | WebSocketClient uses two protocols. One to talk between Elm and the port code, and one to talk between the package and the user code. In the old, native and effects manager implementation, the former was completely invisible to the user. Now the user code is an in-between, passing the `Value` that comes from the input port on to the library for interpretation, and returning each `Cmd` that is created by the library to the run-time from the user `update` function. 4 | 5 | I did most of this before watching Murphy Randall's [ports talk](https://www.youtube.com/watch?v=P3pL85n9_5s), but I'm calling my function name parameter "tag" because of that. 6 | 7 | ## Between User Code and the WebSocketClient Package 8 | 9 | I'm leaving out the function bodies here. 10 | 11 | ### Sending Commands through the Output Port 12 | 13 | The output port is in a `Config` instance inside the `State`. 14 | 15 | -- The url itself will be used as key 16 | open : String -> State msg -> (State msg, Cmd msg) 17 | open url state = ... 18 | 19 | openWithKey : String -> String -> State msg -> (State msg, Cmd msg) 20 | openWithKey key url state = ... 21 | 22 | send : String -> String -> State msg -> (State msg, Cmd msg) 23 | send key message state = ... 24 | 25 | close : String -> State msg -> (State msg, Cmd msg) 26 | close key state = ... 27 | 28 | bytesQueued : String -> State msg -> (State msg, Cmd msg) 29 | bytesQueued key state = ... 30 | 31 | delay : Int -> String -> State msg -> (State msg, Cmd msg) 32 | sleep millis delayid = ... 33 | 34 | 35 | ### Processing Values Received from the Input Port Subscription 36 | 37 | type Message 38 | = Connected { key : String, description : String } 39 | | MessageReceived { key : String, message : String } 40 | | Closed { key : String 41 | , bufferedAmount : Int 42 | , code : String 43 | , reason : String 44 | , wasClean : Bool } 45 | | BytesQueued { key : String, bufferedAmount : Int } 46 | | Delayed String 47 | | Error { key : Maybe String 48 | , code : String 49 | , description : String 50 | , name : Maybe String 51 | } 52 | 53 | -- Call this on receiving a value through the subscription port 54 | -- Update the stored `State` from the received updated state. 55 | update : Value -> State msg -> (State msg, Message) 56 | 57 | ## Between Elm and the Port Code 58 | 59 | There are two ports, `inPort`, which is subscribed to get messages from port code to Elm, and `outPort`, which is used to send commands from Elm to the port code. From the Elm side, everything is JSON encoded as a `Value`, so it's available just as documented below to JavaScript. I'll write simple JSON encoders and decoders for these, but users will never care about them. They'll just pass the `Value` to `WebSocketClient.update`. 60 | 61 | The general form of the port messages is: 62 | 63 | { tag: 64 | , args : { name: , ... } 65 | } 66 | 67 | ### Commands Sent TO the Port Code 68 | 69 | Open a socket. Each socket has a unique key. Initially, this will just be the URL, but having the user allocate unique names allows multiple sockets to be open to the same URL. 70 | 71 | { tag: "open" 72 | , args : { key : 73 | , url : 74 | } 75 | } 76 | 77 | Send a message out through a socket. 78 | 79 | { tag: "send" 80 | , args : { key : 81 | , message : 82 | } 83 | } 84 | 85 | Close a socket. 86 | 87 | { tag: "close" 88 | , args : { key : 89 | , reason : 90 | } 91 | } 92 | 93 | Request bytes queued: 94 | 95 | { tag: "bytesQueued" 96 | , args : { key : } 97 | } 98 | 99 | Request sleep for 10 x 2^backoff milliseconds (`setTimeout` in JS): 100 | 101 | { tag: "delay" 102 | , args : { millis : 103 | , continuation : 104 | } 105 | } 106 | 107 | ### Responses FROM the Port Code 108 | 109 | If opening a socket succeeds: 110 | 111 | { tag: "connected" 112 | , args : { key : 113 | , description : 114 | } 115 | } 116 | 117 | On receiving a message: 118 | 119 | { tag: "messageReceived" 120 | , args : { key : 121 | , message : 122 | } 123 | 124 | Reporting on results of a close: 125 | 126 | { tag: "closed" 127 | , args : { key : 128 | , bufferedAmount : 129 | , code : 130 | , reason : 131 | , wasClean : 132 | } 133 | } 134 | 135 | Reporting bytes queued: 136 | 137 | { tag: "bytesQueued" 138 | , args : { key : 139 | , bufferedAmount : 140 | } 141 | } 142 | 143 | Sleep done: 144 | 145 | { tag: "delayed" 146 | , args : { id : } 147 | } 148 | 149 | 150 | If an errror happens: 151 | 152 | { tag: "error" 153 | , args : { key : # optional 154 | , code : 155 | , description : 156 | , name : # err.name, may be null 157 | } 158 | } 159 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # WebSockets for Elm 0.19 2 | 3 | [billstclair/elm-websocket-client](https://package.elm-lang.org/packages/billstclair/elm-websocket-client/latest) is a conversion of the Elm 0.18 WebSocket client to Elm 0.19, using ports instead of native code and an effects module. 4 | 5 | Elm 0.19 shipped with no WebSocket client. It used to be in [elm-lang/websocket](https://package.elm-lang.org/packages/elm-lang/websocket/latest). I have heard that its interface is being redesigned, and it will reappear sometime in the future. This package provides an alternative to use until then. 6 | 7 | The package as shipped will work with a pure Elm WebSocket simulator, which transforms messages you send with a function you provide and sends the result back immediately. See the [example](https://github.com/billstclair/elm-websocket-client/tree/master/example) README for instructions on setting up ports to make it use JavaScript code to do real WebSocket communication. 8 | 9 | The example is live at [billstclair.github.io/elm-websocket-client](https://billstclair.github.io/elm-websocket-client/). 10 | 11 | ## Keys and URLs 12 | 13 | The old `WebSocket` package identified sockets by their URLs. You can do that with `WebSocketClient` if you want, by using the `open` function. But you can also assign a unique key to each connection, which enables multiple connections to a single URL, by using `openWithKey`. The `key` arg to the other action functions will be the URL if you used `open` or the `key` if you used `openWithKey`. 14 | 15 | ## Using the Package 16 | 17 | The Elm 0.18 `WebSocket` module, in the `elm-lang/websocket` package, was an `effect module`. This allowed it to update its state in the background, so your code didn't have to have anything to do with that. A regular `port module` isn't that lucky. The state for the `WebSocketClient` module needs to be stored in your application's `Model`, and you have to update it when you call its functions, or process a `Value` you receive from its subscription port. 18 | 19 | See `Main.elm` and `PortFunnels.elm` in the the [example/src](https://github.com/billstclair/elm-websocket-client/tree/master/example/src) directory for details. `PortFunnels.elm` exposes a `State` type and an `initialState` constant. 20 | 21 | You will usually copy `PortFunnels.elm` into your application's source directory, and, if you use other `PortFunnel` modules, modify it to support all of them. It is a `port module`, and it defines the two ports that are used by `example/site/index.html`, `cmdPort` and `subPort`. 22 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "billstclair/elm-websocket-client", 4 | "summary": "WebSockets for Elm 0.19, using ports.", 5 | "license": "MIT", 6 | "version": "4.1.0", 7 | "exposed-modules": [ 8 | "PortFunnel.WebSocket" 9 | ], 10 | "elm-version": "0.19.0 <= v < 0.20.0", 11 | "dependencies": { 12 | "NoRedInk/elm-json-decode-pipeline": "1.0.0 <= v < 2.0.0", 13 | "billstclair/elm-port-funnel": "1.1.0 <= v < 2.0.0", 14 | "elm/core": "1.0.0 <= v < 2.0.0", 15 | "elm/json": "1.0.0 <= v < 2.0.0", 16 | "elm-community/list-extra": "8.0.0 <= v < 9.0.0" 17 | }, 18 | "test-dependencies": { 19 | "elm-explorations/test": "1.0.0 <= v < 2.0.0" 20 | } 21 | } -------------------------------------------------------------------------------- /example/.gitignore: -------------------------------------------------------------------------------- 1 | elm.js 2 | -------------------------------------------------------------------------------- /example/README.md: -------------------------------------------------------------------------------- 1 | # WebSocket Client Example 2 | 3 | This directory provides an example of using `billstclair/elm-websocket-client` with or without ports. 4 | 5 | To run the example without ports: 6 | 7 | ```bash 8 | git clone git@github.com:billstclair/elm-websocket-client.git 9 | cd elm-websocket-client/example 10 | elm reactor 11 | ``` 12 | 13 | Then aim your browser at http://localhost:8000/src/Main.elm 14 | 15 | The `Connect` button will send a command out through an unconnected port, so nothing will happen. Click `Close` to undo. 16 | 17 | The `Simulated` button will do a simulated connect, after which `Send` and `Close` will function normally. 18 | 19 | To run the example with ports: 20 | 21 | ```bash 22 | git clone git@github.com:billstclair/elm-websocket-client.git 23 | cd elm-websocket-client/example 24 | bin/build 25 | ``` 26 | 27 | Then aim your browser at file:///.../elm-websocket-client/example/site/index.html 28 | 29 | Where "..." is a path to the package directory, e.g. on my Mac it is: file:///Users/billstclair/elm/elm-websocket-client/example/site/index.html. 30 | 31 | Or, if you have a browser that doesn't support `file://` URLs: 32 | 33 | ```bash 34 | cd .../elm-websocket-client/example 35 | elm reactor 36 | ``` 37 | 38 | And aim your web browser at http://localhost:8000/site/index.html 39 | 40 | To hook up the ports to your own application, you need to define the two standard [billstclair/elm-port-funnel](https://package.elm-lang.org/packages/billstclair/elm-port-funnel/latest) ports in an included `port module` (as in `src/Main.elm`): 41 | 42 | ```elm 43 | port cmdPort : Json.Encode.Value -> Cmd msg 44 | 45 | port subPort : (Json.Encode.Value -> msg) -> Sub msg 46 | ``` 47 | 48 | Then copy the `example/site/js` directory into your site directory: 49 | 50 | ```bash 51 | cd .../my-site 52 | mkdir js 53 | cp .../elm-websocket-client/example/site/js/* js/ 54 | ``` 55 | 56 | Compile your top-level application file into your site directory: 57 | 58 | ```bash 59 | cd .../my-project 60 | elm make src/Main.elm --output .../my-site/elm.js 61 | ``` 62 | 63 | Then you need to set up your `index.html` much as I did in the `site` directory, customizing it for your applciation's needs. 64 | 65 | 66 | ## More Scripts 67 | 68 | Install the NPM `ws` package, if it isn't already installed, and start the WebSocket echo server in `site/echoserver.js` on the port given as the optional parameter (default: 8888). If you send this server a positive integer, it will shut down for that many seconds. Useful for testing the code that automatically reconnects after a dropped connection: 69 | 70 | ```bash 71 | bin/echoserver [port] 72 | ``` 73 | 74 | Compile src/Main.elm to `site/elm.js`, sync the `site` directory with the directory on my Mac where I store the `billstclair.github.io` repository, commit, and push. Not useful for anybody but me: 75 | 76 | ```bash 77 | bin/update 78 | ``` 79 | 80 | Compile `src/simple.elm` to `site/index.js`. This is a very simple client that allows you to send JSON over the wire to the JavaScript port code. Mostly useful for initial debugging of that code: 81 | 82 | ```bash 83 | bin/buildsimple 84 | ``` 85 | -------------------------------------------------------------------------------- /example/bin/build: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | elm make src/Main.elm --output site/elm.js 4 | -------------------------------------------------------------------------------- /example/bin/buildsimple: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | elm make src/simple.elm --output site/elm.js 4 | -------------------------------------------------------------------------------- /example/bin/echoserver: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # 4 | # Start a simple echo server on the port given in the arg, default 8888. 5 | # 6 | # Requires the "ws" package: 7 | # 8 | # npm install -g ws 9 | # 10 | # Will install it if it's not there. 11 | 12 | npm view ws version >/dev/null 2>1 || npm install -g ws 13 | 14 | node site/echoserver.js $* 15 | -------------------------------------------------------------------------------- /example/bin/m: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | elm make src/$1.elm --output /dev/null 4 | -------------------------------------------------------------------------------- /example/bin/update: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Build the example, copy it to my billstclair.github.io project, 4 | # commit, and push to GitHub. 5 | # This won't be very useful to anybody but me. 6 | 7 | elm make src/Main.elm --output site/elm.js 8 | rsync -av site/ ~/elm/billstclair.github.io/elm-websocket-client/ 9 | cd ~/elm/billstclair.github.io/elm-websocket-client 10 | git add . 11 | git commit -am "Update elm-websocket-client example." 12 | git push 13 | 14 | -------------------------------------------------------------------------------- /example/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src", 5 | "../src" 6 | ], 7 | "elm-version": "0.19.0", 8 | "dependencies": { 9 | "direct": { 10 | "Janiczek/cmd-extra": "1.0.0", 11 | "NoRedInk/elm-json-decode-pipeline": "1.0.0", 12 | "billstclair/elm-port-funnel": "1.1.0", 13 | "elm/browser": "1.0.0", 14 | "elm/core": "1.0.0", 15 | "elm/html": "1.0.0", 16 | "elm/json": "1.0.0", 17 | "elm-community/list-extra": "8.0.0" 18 | }, 19 | "indirect": { 20 | "elm/time": "1.0.0", 21 | "elm/url": "1.0.0", 22 | "elm/virtual-dom": "1.0.0" 23 | } 24 | }, 25 | "test-dependencies": { 26 | "direct": {}, 27 | "indirect": {} 28 | } 29 | } -------------------------------------------------------------------------------- /example/site/echoserver.js: -------------------------------------------------------------------------------- 1 | // echoserver.js 2 | // 3 | // A simple Node.js WebSocket echo server. 4 | // Echoes everything you send it. 5 | // 6 | // If you send it a positive integer, it will shut down for 7 | // that many seconds, and then restart. 8 | // 9 | // Start it with: 10 | // 11 | // node echoserver.js [port] 12 | // 13 | // Where `port` is an optional port to listen on, default 8888. 14 | // 15 | // Required for this to work: 16 | // 17 | // npm install -g ws 18 | // 19 | 20 | var port = 8888; 21 | if (process.argv[2]) { 22 | port = process.argv[2]; 23 | } 24 | 25 | var WSServer = require('ws').Server; 26 | var wss; 27 | function startListening() { 28 | wss = new WSServer({port: port}); 29 | wss.on('connection', listen); 30 | console.log ("ws://localhost:" + port); 31 | } 32 | 33 | startListening(); 34 | 35 | function listen(ws) { 36 | console.log("connection"); 37 | ws.send('connected'); 38 | ws.on('error', function() { 39 | console.log('got error, closing'); 40 | wss.close(); 41 | startListening(); 42 | }); 43 | ws.on('message', function(message) { 44 | if (!isPositiveIntegerString(message)) { 45 | console.log('sending: "' + message + '"'); 46 | ws.send(message); 47 | } else { 48 | var timeout = message; 49 | message = "Pausing for " + message + " seconds."; 50 | console.log(message); 51 | ws.send(message); 52 | wss.close(); 53 | setTimeout(startListening, 1000 * timeout); 54 | } 55 | }); 56 | } 57 | 58 | function isPositiveIntegerString(str) { 59 | var n = Math.floor(Number(str)); 60 | if (isNaN(n)) return false; 61 | return ((String(n) === str) && (n > 0)); 62 | } 63 | 64 | -------------------------------------------------------------------------------- /example/site/elm.js.dummy: -------------------------------------------------------------------------------- 1 | ////////////////////////////////////////////////////////////////////// 2 | // 3 | // elm.js.dummy 4 | // Dummy Elm JS file. 5 | // Copyright (c) 2018 Bill St. Clair 6 | // Some rights reserved. 7 | // Distributed under the MIT License 8 | // See LICENSE 9 | // 10 | ////////////////////////////////////////////////////////////////////// 11 | // 12 | // Normally, elm.js contains your compiled Elm application. 13 | // This is a dummy version of that file, with just enough to 14 | // enable testing of the startup code in index.html & the funnels directory. 15 | // 16 | // Copy this file to elm.js, then aim a browser at index.html. 17 | // 18 | ////////////////////////////////////////////////////////////////////// 19 | 20 | var ports = {}; 21 | ports.cmdPort = {}; 22 | ports.cmdPort.subscribe = function() {}; 23 | ports.subPort = {}; 24 | ports.subPort.send = function(value) { 25 | console.log('subPort.send(', value , ')'); 26 | }; 27 | 28 | var app = {} 29 | app.ports = ports; 30 | 31 | var Elm = {}; 32 | Elm.Main = {}; 33 | Elm.Main.init = function() { 34 | return app; 35 | }; 36 | -------------------------------------------------------------------------------- /example/site/index.html: -------------------------------------------------------------------------------- 1 | 11 | 12 | 13 | 14 | WebSocketClient Example 15 | 18 | 19 | 20 | 21 | 22 | 23 |
24 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /example/site/js/PortFunnel.js: -------------------------------------------------------------------------------- 1 | ////////////////////////////////////////////////////////////////////// 2 | // 3 | // PortFunnel.js 4 | // JavaScript runtime code for billstclair/elm-port-funnel 5 | // Copyright (c) 2018-2019 Bill St. Clair 6 | // Some rights reserved. 7 | // Distributed under the MIT License 8 | // See LICENSE 9 | // 10 | ////////////////////////////////////////////////////////////////////// 11 | // 12 | // PortFunnel is the single global variable defined by this file. 13 | // It is an object with a `subscribe` property, a function, called as: 14 | // 15 | // PortFunnel.subscribe 16 | // (app, {portnames: ['cmdPort', 'subPort'] 17 | // }); 18 | // 19 | // The `portnames` property is optional. If included, its value should 20 | // be a two-element array containing the name of the `Cmd` and `Sub` 21 | // ports in `app`. They default as specified above. 22 | // 23 | // The `modules` property is a list of strings, each of which should 24 | // correspond to the 'moduleName' set by one of your PortFunnel-aware 25 | // JavaScript files. 26 | // 27 | // When each `module` JavaScript file is loaded. It should set 28 | // `PortFunnel.modules['moduleName']`, as illustrated in 29 | // `PortFunnel/WebSocket.js`,so that it can be hooked in to the 30 | // funnelling mechanism below. 31 | // 32 | ////////////////////////////////////////////////////////////////////// 33 | 34 | (function(scope) { 35 | 36 | PortFunnel = {}; 37 | scope.PortFunnel = PortFunnel; 38 | 39 | PortFunnel.subscribe = subscribe; // called by HTML file 40 | PortFunnel.modules = {}; // modules[funnelName].cmd set by module JS. 41 | PortFunnel.sub = null; // set below 42 | 43 | function subscribe(app, args) { 44 | if (!args) args = {}; 45 | portNames = args.portNames; 46 | if (!portNames) { 47 | portNames = ['cmdPort', 'subPort']; 48 | } 49 | 50 | var ports = app.ports; 51 | var sub = ports[portNames[1]]; 52 | PortFunnel.sub = sub; 53 | 54 | var cmd = ports[portNames[0]]; 55 | cmd.subscribe(function(command) { 56 | var returnValue = commandDispatch(command); 57 | if (returnValue) { 58 | sub.send(returnValue); 59 | } 60 | }); 61 | } 62 | 63 | // command is of the form: 64 | // { module: 'moduleName', 65 | // tag: 'command name for module', 66 | // args: {name: value, ...} 67 | // } 68 | function commandDispatch(command) { 69 | if (typeof(command) == 'object') { 70 | var moduleName = command.module; 71 | var module = PortFunnel.modules[moduleName]; 72 | if (module) { 73 | var cmd = module.cmd; 74 | if (cmd && !queue[moduleName]) { 75 | var tag = command.tag; 76 | var args = command.args; 77 | return cmd(tag, args); 78 | } else { 79 | var list = queue[moduleName]; 80 | if (!list) list = []; 81 | list.push(command); 82 | queue[moduleName] = list; 83 | if (!queueDrainOutstanding) { 84 | scheduleQueueDrain(); 85 | } 86 | } 87 | } 88 | } 89 | } 90 | 91 | // queue[moduleName] = an array of commands passed to commandDispatch 92 | // before the JavaScript module was installed. 93 | var queue = {}; 94 | var queueDrainOutstanding = false; 95 | 96 | function scheduleQueueDrain() { 97 | queueDrainOutStanding = true; 98 | setTimeout(drainQueue, 10); // is 0.01 second too short? 99 | } 100 | 101 | function drainQueue() { 102 | needReschedule = false; 103 | for (var moduleName in queue) { 104 | var module = PortFunnel.modules[moduleName]; 105 | if (!module) { 106 | // Can't happen, but handle it anyway 107 | delete queue[moduleName]; 108 | } else { 109 | if (!module.cmd) { 110 | needReschedule = true; 111 | } else { 112 | var list = queue[moduleName]; 113 | delete queue[moduleName]; 114 | for (var i in list) { 115 | var command = list[i]; 116 | var returnValue = commandDispatch(command); 117 | if (returnValue) { 118 | PortFunnel.sub.send(returnValue); 119 | } 120 | } 121 | } 122 | if (needReschedule) { 123 | scheduleQueueDrain(); 124 | } else { 125 | queueDrainOutstanding = false; 126 | } 127 | } 128 | } 129 | } 130 | 131 | }(this)) 132 | -------------------------------------------------------------------------------- /example/site/js/PortFunnel/WebSocket.js: -------------------------------------------------------------------------------- 1 | ////////////////////////////////////////////////////////////////////// 2 | // 3 | // WebSocket.js 4 | // JavaScript runtime code for Elm PortFunnel.WebSocket module. 5 | // Copyright (c) 2018 Bill St. Clair 6 | // Portions Copyright (c) 2016 Evan Czaplicki 7 | // Some rights reserved. 8 | // Distributed under the MIT License 9 | // See LICENSE 10 | // 11 | ////////////////////////////////////////////////////////////////////// 12 | 13 | // 14 | // This file cooperates with PortFunnel.js to share a single port 15 | // pair with other compliant modules. 16 | // 17 | // For technical details, see: 18 | // 19 | // https://github.com/billstclair/elm-port-funnel/blob/master/DEVELOPERS-GUIDE.md 20 | // 21 | 22 | (function(scope) { 23 | var moduleName = 'WebSocket'; 24 | 25 | var sub; 26 | 27 | function init() { 28 | var PortFunnel = scope.PortFunnel; 29 | if (!PortFunnel || !PortFunnel.sub || !PortFunnel.modules) { 30 | // Loop until PortFunnel.js has initialized itself. 31 | setTimeout(init, 10); 32 | return; 33 | } 34 | 35 | sub = PortFunnel.sub; 36 | PortFunnel.modules[moduleName] = { cmd: dispatcher } 37 | 38 | // Let the Elm code know we've started 39 | sub.send({ module: moduleName, 40 | tag: "startup", 41 | args : null 42 | }); 43 | } 44 | init(); 45 | 46 | var tagTable = 47 | { open: doOpen, 48 | send: doSend, 49 | getBytesQueued: doGetBytesQueued, 50 | close: doClose, 51 | delay: doDelay, 52 | willopen: sendBack, 53 | willsend: sendBack, 54 | willclose: sendBack 55 | } 56 | 57 | function dispatcher(tag, args) { 58 | let f = tagTable[tag]; 59 | if (f) { 60 | return f(args, tag); // most functions ignore the tag 61 | } else { 62 | return unimplemented(tag, args); 63 | } 64 | } 65 | 66 | // This is for the willxxx commands, which need to have the State 67 | // to do their thing, so can't be directly executed here. 68 | // they'll come back as xxx, after the Elm code validates them. 69 | function sendBack(args, tag) { 70 | return objectReturn(tag, args); 71 | } 72 | 73 | function objectReturn(tag, args) { 74 | return { module: moduleName, tag: tag, args: args }; 75 | } 76 | 77 | function keyedErrorReturn(key, code, description, name, message) { 78 | var returnMessage = { key: key, code: code, description: description }; 79 | if (name) { 80 | returnMessage.name = name; 81 | } 82 | if (message) { 83 | returnMessage.message = message; 84 | } 85 | return objectReturn("error", returnMessage); 86 | } 87 | 88 | function errorReturn(code, description) { 89 | return objectReturn("error", { code: code, description: description }); 90 | } 91 | 92 | function unimplemented(func, args) { 93 | return errorReturn ("unimplemented", 94 | "Not implemented: "+ func + 95 | "(" + JSON.stringify(args) + ")"); 96 | } 97 | 98 | var sockets = {}; 99 | 100 | function doOpen(args) { 101 | var key = args.key; 102 | var url = args.url; 103 | if (!key) key = url; 104 | if (sockets[key]) { 105 | return errorReturn("keyused", "Key already has a socket open: " + key); 106 | } 107 | try { 108 | var socket = new WebSocket(url); 109 | sockets[key] = socket; 110 | } 111 | catch(err) { 112 | // The old code returned BadSecurity if err.name was 'SecurityError' 113 | // or BadArgs otherwise. 114 | return errorReturn('openfailed', 115 | "Can't create socket for URL: " + url, 116 | err.name 117 | ) 118 | } 119 | socket.addEventListener("open", function(event) { 120 | //console.log("Socket connected for URL: " + url); 121 | sub.send(objectReturn("connected", 122 | { key: key, 123 | description: "Socket connected for URL: " + url 124 | })); 125 | }); 126 | socket.addEventListener("message", function(event) { 127 | var message = event.data; 128 | //console.log("Received for '" + key + "': " + message); 129 | sub.send(objectReturn("messageReceived", 130 | { key: key, message: message })); 131 | }); 132 | socket.addEventListener("close", function(event) { 133 | //console.log("'" + key + "' closed"); 134 | delete sockets[key]; // for open errors 135 | sub.send(objectReturn("closed", 136 | { key: key, 137 | bytesQueued: socket.bufferedAmount, 138 | code: event.code, 139 | reason: "" + event.reason, 140 | wasClean: event.wasClean ? true : false 141 | })); 142 | }); 143 | return null; 144 | } 145 | 146 | function socketNotOpenReturn(key, name, message) { 147 | return keyedErrorReturn(key, 'notopen', 'Socket not open', name, message); 148 | } 149 | 150 | function doSend(args) { 151 | var key = args.key; 152 | var message = args.message; 153 | var socket = sockets[key]; 154 | if (!socket) { 155 | return socketNotOpenReturn(key, "send", message); 156 | } 157 | try { 158 | socket.send(message); 159 | } catch(err) { 160 | // The old code ignored err.name 161 | return keyedErrorReturn(key, 'badsend', 'Send error', err.name) 162 | } 163 | return null; 164 | } 165 | 166 | function doClose(args) { 167 | var key = args.key; 168 | var reason = args.reason; // not used 169 | var socket = sockets[key]; 170 | if (!socket) { 171 | return socketNotOpenReturn(key, "close"); 172 | } 173 | try { 174 | // Should this happen in the event listener? 175 | delete sockets[key]; 176 | socket.close(); 177 | } catch(err) { 178 | // The old code returned BadReason if err.name was 'SyntaxError' 179 | // or BadCode otherwise 180 | return keyedErrorReturn(key, 'badclose', 'Close error', err.name) 181 | } 182 | } 183 | 184 | function doGetBytesQueued(args) { 185 | var key = args.key; 186 | var socket = sockets[key]; 187 | if (!socket) { 188 | return socketNotOpenReturn(key, "getBytesQueued"); 189 | } 190 | return objectReturn("bytesQueued", 191 | { key: key, 192 | bytesQueued: "" + socket.bufferedAmount 193 | }); 194 | } 195 | 196 | function doDelay(args) { 197 | var millis = args.millis; 198 | console.log("Sleeping for", millis, " milliseconds for id: ", args.id); 199 | function callback() { 200 | sub.send(objectReturn("delayed", { id: args.id })); 201 | } 202 | setTimeout(callback, millis); 203 | } 204 | 205 | })(this); 206 | -------------------------------------------------------------------------------- /example/src/Main.elm: -------------------------------------------------------------------------------- 1 | port module Main exposing (main) 2 | 3 | {-| WebSocketClient Example 4 | -} 5 | 6 | import Browser 7 | import Cmd.Extra exposing (addCmd, addCmds, withCmd, withCmds, withNoCmd) 8 | import Dict exposing (Dict) 9 | import Html exposing (Html, a, button, div, h1, input, p, span, text) 10 | import Html.Attributes exposing (checked, disabled, href, size, style, type_, value) 11 | import Html.Events exposing (onClick, onInput) 12 | import Json.Encode exposing (Value) 13 | import PortFunnel.WebSocket as WebSocket exposing (Response(..)) 14 | import PortFunnels exposing (FunnelDict, Handler(..), State) 15 | 16 | 17 | 18 | {- This section contains boilerplate that you'll always need. 19 | 20 | First, copy PortFunnels.elm into your project, and modify it 21 | to support all the funnel modules you use. 22 | 23 | Then update the `handlers` list with an entry for each funnel. 24 | 25 | Those handler functions are the meat of your interaction with each 26 | funnel module. 27 | -} 28 | 29 | 30 | handlers : List (Handler Model Msg) 31 | handlers = 32 | [ WebSocketHandler socketHandler 33 | ] 34 | 35 | 36 | subscriptions : Model -> Sub Msg 37 | subscriptions = 38 | PortFunnels.subscriptions Process 39 | 40 | 41 | funnelDict : FunnelDict Model Msg 42 | funnelDict = 43 | PortFunnels.makeFunnelDict handlers getCmdPort 44 | 45 | 46 | {-| Get a possibly simulated output port. 47 | -} 48 | getCmdPort : String -> Model -> (Value -> Cmd Msg) 49 | getCmdPort moduleName model = 50 | PortFunnels.getCmdPort Process moduleName model.useSimulator 51 | 52 | 53 | {-| The real output port. 54 | -} 55 | cmdPort : Value -> Cmd Msg 56 | cmdPort = 57 | PortFunnels.getCmdPort Process "" False 58 | 59 | 60 | 61 | -- MODEL 62 | 63 | 64 | defaultUrl : String 65 | defaultUrl = 66 | "wss://echo.websocket.org" 67 | 68 | 69 | type alias Model = 70 | { send : String 71 | , log : List String 72 | , url : String 73 | , useSimulator : Bool 74 | , wasLoaded : Bool 75 | , state : State 76 | , key : String 77 | , error : Maybe String 78 | } 79 | 80 | 81 | main = 82 | Browser.element 83 | { init = init 84 | , update = update 85 | , view = view 86 | , subscriptions = subscriptions 87 | } 88 | 89 | 90 | init : () -> ( Model, Cmd Msg ) 91 | init _ = 92 | { send = "Hello World!" 93 | , log = [] 94 | , url = defaultUrl 95 | , useSimulator = True 96 | , wasLoaded = False 97 | , state = PortFunnels.initialState 98 | , key = "socket" 99 | , error = Nothing 100 | } 101 | |> withNoCmd 102 | 103 | 104 | 105 | -- UPDATE 106 | 107 | 108 | type Msg 109 | = UpdateSend String 110 | | UpdateUrl String 111 | | ToggleUseSimulator 112 | | ToggleAutoReopen 113 | | Connect 114 | | Close 115 | | Send 116 | | Process Value 117 | 118 | 119 | update : Msg -> Model -> ( Model, Cmd Msg ) 120 | update msg model = 121 | case msg of 122 | UpdateSend newsend -> 123 | { model | send = newsend } |> withNoCmd 124 | 125 | UpdateUrl url -> 126 | { model | url = url } |> withNoCmd 127 | 128 | ToggleUseSimulator -> 129 | { model | useSimulator = not model.useSimulator } |> withNoCmd 130 | 131 | ToggleAutoReopen -> 132 | let 133 | state = 134 | model.state 135 | 136 | socketState = 137 | state.websocket 138 | 139 | autoReopen = 140 | WebSocket.willAutoReopen model.key socketState 141 | in 142 | { model 143 | | state = 144 | { state 145 | | websocket = 146 | WebSocket.setAutoReopen 147 | model.key 148 | (not autoReopen) 149 | socketState 150 | } 151 | } 152 | |> withNoCmd 153 | 154 | Connect -> 155 | { model 156 | | log = 157 | (if model.useSimulator then 158 | "Connecting to simulator" 159 | 160 | else 161 | "Connecting to " ++ model.url 162 | ) 163 | :: model.log 164 | } 165 | |> withCmd 166 | (WebSocket.makeOpenWithKey model.key model.url 167 | |> send model 168 | ) 169 | 170 | Send -> 171 | { model 172 | | log = 173 | ("Sending \"" ++ model.send ++ "\"") :: model.log 174 | } 175 | |> withCmd 176 | (WebSocket.makeSend model.key model.send 177 | |> send model 178 | ) 179 | 180 | Close -> 181 | { model 182 | | log = "Closing" :: model.log 183 | } 184 | |> withCmd 185 | (WebSocket.makeClose model.key 186 | |> send model 187 | ) 188 | 189 | Process value -> 190 | case 191 | PortFunnels.processValue funnelDict value model.state model 192 | of 193 | Err error -> 194 | { model | error = Just error } |> withNoCmd 195 | 196 | Ok res -> 197 | res 198 | 199 | 200 | send : Model -> WebSocket.Message -> Cmd Msg 201 | send model message = 202 | WebSocket.send (getCmdPort WebSocket.moduleName model) message 203 | 204 | 205 | doIsLoaded : Model -> Model 206 | doIsLoaded model = 207 | if not model.wasLoaded && WebSocket.isLoaded model.state.websocket then 208 | { model 209 | | useSimulator = False 210 | , wasLoaded = True 211 | } 212 | 213 | else 214 | model 215 | 216 | 217 | socketHandler : Response -> State -> Model -> ( Model, Cmd Msg ) 218 | socketHandler response state mdl = 219 | let 220 | model = 221 | doIsLoaded 222 | { mdl 223 | | state = state 224 | , error = Nothing 225 | } 226 | in 227 | case response of 228 | WebSocket.MessageReceivedResponse { message } -> 229 | { model | log = ("Received \"" ++ message ++ "\"") :: model.log } 230 | |> withNoCmd 231 | 232 | WebSocket.ConnectedResponse r -> 233 | { model | log = ("Connected: " ++ r.description) :: model.log } 234 | |> withNoCmd 235 | 236 | WebSocket.ClosedResponse { code, wasClean, expected } -> 237 | { model 238 | | log = 239 | ("Closed, " ++ closedString code wasClean expected) 240 | :: model.log 241 | } 242 | |> withNoCmd 243 | 244 | WebSocket.ErrorResponse error -> 245 | { model | log = WebSocket.errorToString error :: model.log } 246 | |> withNoCmd 247 | 248 | _ -> 249 | case WebSocket.reconnectedResponses response of 250 | [] -> 251 | model |> withNoCmd 252 | 253 | [ ReconnectedResponse r ] -> 254 | { model | log = ("Reconnected: " ++ r.description) :: model.log } 255 | |> withNoCmd 256 | 257 | list -> 258 | { model | log = Debug.toString list :: model.log } 259 | |> withNoCmd 260 | 261 | 262 | closedString : WebSocket.ClosedCode -> Bool -> Bool -> String 263 | closedString code wasClean expected = 264 | "code: " 265 | ++ WebSocket.closedCodeToString code 266 | ++ ", " 267 | ++ (if wasClean then 268 | "clean" 269 | 270 | else 271 | "not clean" 272 | ) 273 | ++ ", " 274 | ++ (if expected then 275 | "expected" 276 | 277 | else 278 | "NOT expected" 279 | ) 280 | 281 | 282 | 283 | -- VIEW 284 | 285 | 286 | b : String -> Html Msg 287 | b string = 288 | Html.b [] [ text string ] 289 | 290 | 291 | br : Html msg 292 | br = 293 | Html.br [] [] 294 | 295 | 296 | docp : String -> Html Msg 297 | docp string = 298 | p [] [ text string ] 299 | 300 | 301 | view : Model -> Html Msg 302 | view model = 303 | let 304 | isConnected = 305 | WebSocket.isConnected model.key model.state.websocket 306 | in 307 | div 308 | [ style "width" "40em" 309 | , style "margin" "auto" 310 | , style "margin-top" "1em" 311 | , style "padding" "1em" 312 | , style "border" "solid" 313 | ] 314 | [ h1 [] [ text "PortFunnel.WebSocket Example" ] 315 | , p [] 316 | [ input 317 | [ value model.send 318 | , onInput UpdateSend 319 | , size 50 320 | ] 321 | [] 322 | , text " " 323 | , button 324 | [ onClick Send 325 | , disabled (not isConnected) 326 | ] 327 | [ text "Send" ] 328 | ] 329 | , p [] 330 | [ b "url: " 331 | , input 332 | [ value model.url 333 | , onInput UpdateUrl 334 | , size 30 335 | , disabled isConnected 336 | ] 337 | [] 338 | , text " " 339 | , if isConnected then 340 | button [ onClick Close ] 341 | [ text "Close" ] 342 | 343 | else 344 | button [ onClick Connect ] 345 | [ text "Connect" ] 346 | , br 347 | , b "use simulator: " 348 | , input 349 | [ type_ "checkbox" 350 | , onClick ToggleUseSimulator 351 | , checked model.useSimulator 352 | , disabled isConnected 353 | ] 354 | [] 355 | , br 356 | , b "auto reopen: " 357 | , input 358 | [ type_ "checkbox" 359 | , onClick ToggleAutoReopen 360 | , checked <| 361 | WebSocket.willAutoReopen 362 | model.key 363 | model.state.websocket 364 | ] 365 | [] 366 | ] 367 | , p [] <| 368 | List.concat 369 | [ [ b "Log:" 370 | , br 371 | ] 372 | , List.intersperse br (List.map text model.log) 373 | ] 374 | , div [] 375 | [ b "Instructions:" 376 | , docp <| 377 | "Fill in the 'url' and click 'Connect' to connect to a real server." 378 | ++ " This will only work if you've connected the port JavaScript code." 379 | , docp "Fill in the text and click 'Send' to send a message." 380 | , docp "Click 'Close' to close the connection." 381 | , docp <| 382 | "If the 'use simulator' checkbox is checked at startup," 383 | ++ " then you're either runing from 'elm reactor' or" 384 | ++ " the JavaScript code got an error starting." 385 | , docp <| 386 | "Uncheck the 'auto reopen' checkbox to report when the" 387 | ++ " connection is lost unexpectedly, rather than the deault" 388 | ++ " of attempting to reconnect." 389 | ] 390 | , p [] 391 | [ b "Package: " 392 | , a [ href "https://package.elm-lang.org/packages/billstclair/elm-websocket-client/latest" ] 393 | [ text "billstclair/elm-websocket-client" ] 394 | , br 395 | , b "GitHub: " 396 | , a [ href "https://github.com/billstclair/elm-websocket-client" ] 397 | [ text "github.com/billstclair/elm-websocket-client" ] 398 | ] 399 | ] 400 | -------------------------------------------------------------------------------- /example/src/PortFunnels.elm: -------------------------------------------------------------------------------- 1 | ---------------------------------------------------------------------- 2 | -- 3 | -- PortFunnels.elm 4 | -- Most of the support needed for a PortFunnel application 5 | -- Copyright (c) 2018 Bill St. Clair 6 | -- Some rights reserved. 7 | -- Distributed under the MIT License 8 | -- See LICENSE.txt 9 | -- 10 | ---------------------------------------------------------------------- 11 | 12 | 13 | port module PortFunnels exposing 14 | ( FunnelDict 15 | , Handler(..) 16 | , State 17 | , getCmdPort 18 | , initialState 19 | , makeFunnelDict 20 | , processValue 21 | , subscriptions 22 | ) 23 | 24 | {-| A copy of the PortFunnels.elm example module, modified for `PortFunnel.WebSocket`. 25 | 26 | You will usually copy this file into your application's source directory, and, if you use other `PortFunnel` modules, modify it to support all of them. 27 | 28 | Note that this is a `port module`, and it defines the two ports that are used by `site/index.html`, `cmdPort` and `subPort`. 29 | 30 | -} 31 | 32 | import Dict exposing (Dict) 33 | import Html exposing (Html, a, button, div, h1, input, p, span, text) 34 | import Json.Encode as JE exposing (Value) 35 | import PortFunnel 36 | exposing 37 | ( FunnelSpec 38 | , GenericMessage 39 | , ModuleDesc 40 | , StateAccessors 41 | ) 42 | import PortFunnel.WebSocket as WebSocket 43 | 44 | 45 | {-| Add a property to this type for each funnel module you use. 46 | -} 47 | type alias State = 48 | { websocket : WebSocket.State 49 | } 50 | 51 | 52 | {-| Create the initial state record. 53 | 54 | Some modules have parameters to their `initialState` functions. 55 | 56 | In that case, you may have make those parameters be parameters to `initialState`. 57 | 58 | -} 59 | initialState : State 60 | initialState = 61 | { websocket = WebSocket.initialState 62 | } 63 | 64 | 65 | {-| Make a `StateAccessors` instance for each funnel module. 66 | -} 67 | websocketAccessors : StateAccessors State WebSocket.State 68 | websocketAccessors = 69 | StateAccessors .websocket (\substate state -> { state | websocket = substate }) 70 | 71 | 72 | {-| A `Funnel` tags a module-specific `FunnelSpec`. 73 | 74 | Add a tag here for each funnel module you use. 75 | 76 | -} 77 | type Funnel model msg 78 | = WebSocketFunnel (FunnelSpec State WebSocket.State WebSocket.Message WebSocket.Response model msg) 79 | 80 | 81 | {-| A `Handler` tags a function to handle responses from one funnel module. 82 | 83 | Add a tag in this type for each funnel module you use. 84 | 85 | -} 86 | type Handler model msg 87 | = WebSocketHandler (WebSocket.Response -> State -> model -> ( model, Cmd msg )) 88 | 89 | 90 | {-| This packages up everything necessary to dispatch for each module. 91 | 92 | Add a clause for each funnel module you use. 93 | 94 | -} 95 | handlerToFunnel : Handler model msg -> ( String, Funnel model msg ) 96 | handlerToFunnel handler = 97 | case handler of 98 | WebSocketHandler websocketHandler -> 99 | ( WebSocket.moduleName 100 | , FunnelSpec websocketAccessors WebSocket.moduleDesc WebSocket.commander websocketHandler 101 | |> WebSocketFunnel 102 | ) 103 | 104 | 105 | {-| Add a tuple to this list for each funnel module you use. 106 | -} 107 | simulatedPortDict : Dict String ((Value -> msg) -> Value -> Cmd msg) 108 | simulatedPortDict = 109 | Dict.fromList 110 | [ ( WebSocket.moduleName, WebSocket.makeSimulatedCmdPort ) 111 | ] 112 | 113 | 114 | {-| This is called from `AppFunnel.processValue`. 115 | 116 | It unboxes the `Funnel` arg, and calls `PortFunnel.appProcess`. 117 | 118 | -} 119 | appTrampoline : (String -> model -> (Value -> Cmd msg)) -> GenericMessage -> Funnel model msg -> State -> model -> Result String ( model, Cmd msg ) 120 | appTrampoline portGetter genericMessage funnel state model = 121 | -- Dispatch on the `Funnel` tag. 122 | -- This example has only one possibility. 123 | case funnel of 124 | WebSocketFunnel appFunnel -> 125 | PortFunnel.appProcess (portGetter WebSocket.moduleName model) 126 | genericMessage 127 | appFunnel 128 | state 129 | model 130 | 131 | 132 | {-| Here are the two ports used to communicate with all the backend JavaScript. 133 | 134 | You can name them something besides `cmdPort` and `subPort`, 135 | but then you have to change the call to `PortFunnel.subscribe()` 136 | in `site/index.html`. 137 | 138 | If you run the application in `elm reactor`, these will go nowhere. 139 | 140 | -} 141 | port cmdPort : Value -> Cmd msg 142 | 143 | 144 | port subPort : (Value -> msg) -> Sub msg 145 | 146 | 147 | {-| Create a subscription for the `subPort`, given a Msg wrapper. 148 | -} 149 | subscriptions : (Value -> msg) -> model -> Sub msg 150 | subscriptions process model = 151 | subPort process 152 | 153 | 154 | {-| Turn the `moduleName` inside a `GenericMessage` into the output port. 155 | 156 | getCmdPort tagger moduleName useSimulator 157 | 158 | `tagger` is the same `Msg` that processes input from the subscription port. 159 | 160 | `moduleName` will be ignored if `useSimulator` is `False`. 161 | 162 | -} 163 | getCmdPort : (Value -> msg) -> String -> Bool -> (Value -> Cmd msg) 164 | getCmdPort tagger moduleName useSimulator = 165 | if not useSimulator then 166 | cmdPort 167 | 168 | else 169 | case Dict.get moduleName simulatedPortDict of 170 | Just makeSimulatedCmdPort -> 171 | makeSimulatedCmdPort tagger 172 | 173 | Nothing -> 174 | cmdPort 175 | 176 | 177 | {-| A `Dict` that maps a module name to a concretized `FunnelSpec`. 178 | 179 | Create one with `makeFunnelDict`. Pass it to `processValue`. 180 | 181 | -} 182 | type alias FunnelDict model msg = 183 | ( Dict String (Funnel model msg), String -> model -> (Value -> Cmd msg) ) 184 | 185 | 186 | {-| Make a `Dict` mapping `moduleName` to tagged concrete `FunnelSpec`. 187 | -} 188 | makeFunnelDict : List (Handler model msg) -> (String -> model -> (Value -> Cmd msg)) -> FunnelDict model msg 189 | makeFunnelDict handlers portGetter = 190 | ( List.map handlerToFunnel handlers |> Dict.fromList 191 | , portGetter 192 | ) 193 | 194 | 195 | {-| Process a value coming in through the `subPort`. 196 | 197 | The `FunnelDict` is the result of calling `makeFunnelDict`. 198 | 199 | -} 200 | processValue : FunnelDict model msg -> Value -> State -> model -> Result String ( model, Cmd msg ) 201 | processValue ( funnelDict, portGetter ) value state model = 202 | PortFunnel.processValue funnelDict (appTrampoline portGetter) value state model 203 | -------------------------------------------------------------------------------- /example/src/simple.elm: -------------------------------------------------------------------------------- 1 | port module Main exposing (main) 2 | 3 | {-| Very simple test app for the port code. 4 | 5 | `elm make src/simple.elm --output site/index.js` 6 | 7 | -} 8 | 9 | import Browser 10 | import Cmd.Extra exposing (withCmd, withNoCmd) 11 | import Html exposing (Html, a, button, div, h1, input, p, text) 12 | import Html.Attributes exposing (href, size, value) 13 | import Html.Events exposing (onClick, onInput) 14 | import Json.Decode as JD 15 | import Json.Encode as JE exposing (Value) 16 | 17 | 18 | main = 19 | Browser.element 20 | { init = init 21 | , update = update 22 | , view = view 23 | , subscriptions = subscriptions 24 | } 25 | 26 | 27 | port cmdPort : Value -> Cmd msg 28 | 29 | 30 | port subPort : (Value -> msg) -> Sub msg 31 | 32 | 33 | port parse : String -> Cmd msg 34 | 35 | 36 | port parseReturn : (Value -> msg) -> Sub msg 37 | 38 | 39 | subscriptions : Model -> Sub Msg 40 | subscriptions model = 41 | Sub.batch 42 | [ subPort Receive 43 | , parseReturn Process 44 | ] 45 | 46 | 47 | 48 | -- MODEL 49 | 50 | 51 | type alias Model = 52 | { send : String 53 | , log : List String 54 | } 55 | 56 | 57 | openJson : String 58 | openJson = 59 | String.trim 60 | """ 61 | {"module": "WebSocket", "tag": "open", "args": {"key": "foo", "url": "wss://echo.websocket.org"}} 62 | """ 63 | 64 | 65 | sendJson : String 66 | sendJson = 67 | String.trim 68 | """ 69 | {"module": "WebSocket", "tag": "send", "args": {"key": "foo", "message": "Hello, World!"}} 70 | """ 71 | 72 | 73 | closeJson : String 74 | closeJson = 75 | String.trim 76 | """ 77 | {"module": "WebSocket", "tag": "close", "args": {"key": "foo", "reason": "Just because."}} 78 | """ 79 | 80 | 81 | bytesQueuedJson : String 82 | bytesQueuedJson = 83 | String.trim 84 | """ 85 | {"module": "WebSocket", "tag": "getBytesQueued", "args": {"key": "foo"}} 86 | """ 87 | 88 | 89 | delayJson : String 90 | delayJson = 91 | String.trim 92 | """ 93 | {"module": "WebSocket", "tag": "delay", "args": {"millis": "500", "id": "23"}} 94 | """ 95 | 96 | 97 | exampleJsons : List String 98 | exampleJsons = 99 | [ sendJson, bytesQueuedJson, closeJson, delayJson, openJson ] 100 | 101 | 102 | init : () -> ( Model, Cmd Msg ) 103 | init flags = 104 | { send = openJson 105 | , log = [] 106 | } 107 | |> withNoCmd 108 | 109 | 110 | 111 | -- UPDATE 112 | 113 | 114 | type Msg 115 | = UpdateSend String 116 | | Send 117 | | Process Value 118 | | Receive Value 119 | 120 | 121 | update : Msg -> Model -> ( Model, Cmd Msg ) 122 | update msg model = 123 | case msg of 124 | UpdateSend send -> 125 | { model | send = send } |> withNoCmd 126 | 127 | Send -> 128 | model |> withCmd (parse model.send) 129 | 130 | Process value -> 131 | { model 132 | | log = ("send: " ++ JE.encode 0 value) :: model.log 133 | } 134 | |> withCmd (cmdPort value) 135 | 136 | Receive value -> 137 | let 138 | log = 139 | ("recv: " ++ JE.encode 0 value) :: model.log 140 | in 141 | { model | log = log } |> withNoCmd 142 | 143 | 144 | 145 | -- VIEW 146 | 147 | 148 | b : String -> Html msg 149 | b string = 150 | Html.b [] [ text string ] 151 | 152 | 153 | br : Html msg 154 | br = 155 | Html.br [] [] 156 | 157 | 158 | sendSample : String -> Html Msg 159 | sendSample sample = 160 | a [ onClick <| UpdateSend sample ] 161 | [ text sample ] 162 | 163 | 164 | view : Model -> Html Msg 165 | view model = 166 | div [] 167 | [ h1 [] [ text "WebSocketClient Test Console" ] 168 | , p [] 169 | [ input 170 | [ value model.send 171 | , onInput UpdateSend 172 | , size 100 173 | ] 174 | [] 175 | , text " " 176 | , button [ onClick Send ] [ text "Send" ] 177 | ] 178 | , p [] <| 179 | List.concat 180 | [ [ b "Sample messages (click to copy):" 181 | , br 182 | ] 183 | , List.intersperse br <| List.map sendSample exampleJsons 184 | ] 185 | , p [] <| 186 | List.concat 187 | [ [ b "Log:", br ] 188 | , List.intersperse br (List.map text model.log) 189 | ] 190 | ] 191 | -------------------------------------------------------------------------------- /src/PortFunnel/WebSocket.elm: -------------------------------------------------------------------------------- 1 | ---------------------------------------------------------------------- 2 | -- 3 | -- WebSocket.elm 4 | -- An Elm 0.19 package providing the old Websocket package functionality 5 | -- using ports instead of a kernel module and effects manager. 6 | -- Copyright (c) 2018 Bill St. Clair 7 | -- Some rights reserved. 8 | -- Distributed under the MIT License 9 | -- See LICENSE 10 | -- 11 | ---------------------------------------------------------------------- 12 | -- 13 | -- TODO 14 | -- 15 | -- If `send` happens while in IdlePhase, open, send, close. Or not. 16 | -- 17 | 18 | 19 | module PortFunnel.WebSocket exposing 20 | ( State, Message, Response(..), Error(..), ClosedCode(..), JSVersion 21 | , moduleName, moduleDesc, commander 22 | , initialState 23 | , makeOpen, makeSend, makeClose 24 | , makeOpenWithKey, makeKeepAlive, makeKeepAliveWithKey 25 | , send 26 | , toString, toJsonString, errorToString, closedCodeToString 27 | , makeSimulatedCmdPort 28 | , isLoaded, isConnected, getKeyUrl, willAutoReopen, setAutoReopen 29 | , filterResponses, isReconnectedResponse, reconnectedResponses 30 | , encode, decode 31 | ) 32 | 33 | {-| Web sockets make it cheaper to talk to your servers. 34 | 35 | Connecting to a server takes some time, so with web sockets, you make that 36 | connection once and then keep using. The major benefits of this are: 37 | 38 | 1. It faster to send messages. No need to do a bunch of work for every single 39 | message. 40 | 41 | 2. The server can push messages to you. With normal HTTP you would have to 42 | keep _asking_ for changes, but a web socket, the server can talk to you 43 | whenever it wants. This means there is less unnecessary network traffic. 44 | 45 | 46 | # Web Sockets 47 | 48 | 49 | ## Types 50 | 51 | @docs State, Message, Response, Error, ClosedCode, JSVersion 52 | 53 | 54 | ## Components of a `PortFunnel.FunnelSpec` 55 | 56 | @docs moduleName, moduleDesc, commander 57 | 58 | 59 | ## Initial `State` 60 | 61 | @docs initialState 62 | 63 | 64 | ## Creating a `Message` 65 | 66 | @docs makeOpen, makeSend, makeClose 67 | @docs makeOpenWithKey, makeKeepAlive, makeKeepAliveWithKey 68 | 69 | 70 | ## Sending a `Message` out the `Cmd` Port 71 | 72 | @docs send 73 | 74 | 75 | # Conversion to Strings 76 | 77 | @docs toString, toJsonString, errorToString, closedCodeToString 78 | 79 | 80 | # Simulator 81 | 82 | @docs makeSimulatedCmdPort 83 | 84 | 85 | ## Non-standard functions 86 | 87 | @docs isLoaded, isConnected, getKeyUrl, willAutoReopen, setAutoReopen 88 | @docs filterResponses, isReconnectedResponse, reconnectedResponses 89 | 90 | 91 | ## Internal, exposed only for tests 92 | 93 | @docs encode, decode 94 | 95 | -} 96 | 97 | import Dict exposing (Dict) 98 | import Json.Decode as JD exposing (Decoder) 99 | import Json.Decode.Pipeline exposing (hardcoded, optional, required) 100 | import Json.Encode as JE exposing (Value) 101 | import List.Extra as LE 102 | import PortFunnel exposing (GenericMessage, ModuleDesc) 103 | import PortFunnel.WebSocket.InternalMessage 104 | exposing 105 | ( InternalMessage(..) 106 | , PIClosedRecord 107 | , PIErrorRecord 108 | ) 109 | import Set exposing (Set) 110 | import Task exposing (Task) 111 | 112 | 113 | type SocketPhase 114 | = IdlePhase 115 | | ConnectingPhase 116 | | ConnectedPhase 117 | | ClosingPhase 118 | 119 | 120 | type alias SocketState = 121 | { phase : SocketPhase 122 | , url : String 123 | , backoff : Int 124 | , continuationId : Maybe String 125 | , keepAlive : Bool 126 | } 127 | 128 | 129 | type ContinuationKind 130 | = RetryConnection 131 | | DrainOutputQueue 132 | 133 | 134 | type alias Continuation = 135 | { key : String 136 | , kind : ContinuationKind 137 | } 138 | 139 | 140 | type alias StateRecord = 141 | { isLoaded : Bool 142 | , socketStates : Dict String SocketState 143 | , continuationCounter : Int 144 | , continuations : Dict String Continuation 145 | , queues : Dict String (List String) 146 | , noAutoReopenKeys : Set String 147 | } 148 | 149 | 150 | {-| Internal state of the WebSocketClient module. 151 | 152 | Get the initial, empty state with `initialState`. 153 | 154 | -} 155 | type State 156 | = State StateRecord 157 | 158 | 159 | {-| The initial, empty state. 160 | -} 161 | initialState : State 162 | initialState = 163 | State 164 | { isLoaded = False 165 | , socketStates = Dict.empty 166 | , continuationCounter = 0 167 | , continuations = Dict.empty 168 | , queues = Dict.empty 169 | , noAutoReopenKeys = Set.empty 170 | } 171 | 172 | 173 | {-| Returns true if a `Startup` message has been processed. 174 | 175 | This is sent by the port code after it has initialized. 176 | 177 | -} 178 | isLoaded : State -> Bool 179 | isLoaded (State state) = 180 | state.isLoaded 181 | 182 | 183 | {-| Returns true if a connection is open for the given key. 184 | 185 | isConnected key state 186 | 187 | -} 188 | isConnected : String -> State -> Bool 189 | isConnected key (State state) = 190 | Dict.get key state.socketStates /= Nothing 191 | 192 | 193 | {-| Return `True` if the connection for the given key will be automatically reopened if it closes unexpectedly. 194 | 195 | This is the default. You may change it with setAutoReopen. 196 | 197 | willAutoReopen key state 198 | 199 | -} 200 | willAutoReopen : String -> State -> Bool 201 | willAutoReopen key (State state) = 202 | not <| Set.member key state.noAutoReopenKeys 203 | 204 | 205 | {-| Set whether the connection for the given key will be automatically reopened if it closes unexpectedly. 206 | 207 | This defaults to `True`. If you would rather get a `ClosedResponse` when it happens and handle it yourself, set it to `False` before sending a `makeOpen` message. 208 | 209 | You may change it back to `False` later. Changing it to `True` later will not interrupt any ongoing reconnection process. 210 | 211 | setAutoReopen key autoReopen 212 | 213 | The key is either the key you plan to use for a `makeOpenWithKey` or `makeKeepAliveWithKey` message or the url for a `makeOpen` or `makeKeepAlive` message. 214 | 215 | -} 216 | setAutoReopen : String -> Bool -> State -> State 217 | setAutoReopen key autoReopen (State state) = 218 | let 219 | keys = 220 | if autoReopen then 221 | Set.remove key state.noAutoReopenKeys 222 | 223 | else 224 | Set.insert key state.noAutoReopenKeys 225 | in 226 | State { state | noAutoReopenKeys = keys } 227 | 228 | 229 | {-| A response that your code must process to update your model. 230 | 231 | `NoResponse` means there's nothing to do. 232 | 233 | `CmdResponse` encapsulates a `Message` that needs to be sent out through your `Cmd` port. This is done internally. Your application code may ignore these responses. 234 | 235 | `ListResponse` contains a number of responses. It is generated only when you send messages while the connection is down, causing them to be queued up. It may contain one or more `ReconnectedResponse` instances, so if you care about that, you should call `reconnectedResponses` to extract them. 236 | 237 | `ConnectedResponse` tells you that an earlier call to `send` or `keepAlive` has successfully connected. You can usually ignore this. 238 | 239 | `ReconnectedResponse` is sent when the connection to the server has been re-established after being lost. If you need to re-establish logical connections after losing the physical connection, you'll need to pay attention to this. Otherwise, you can safely ignore it. 240 | 241 | `MessageReceivedResponse` is a message from one of the connected sockets. 242 | 243 | `ClosedResponse` tells you that an earlier call to `close` has completed. Its `code`, `reason`, and `wasClean` fields are as passed by the JavaScript `WebSocket` interface. Its `expected` field will be `True`, if the response is to a `close` call on your part. It will be `False` if the close was unexpected, and reconnection attempts failed for 20 seconds (using exponential backoff between attempts). 244 | 245 | `ErrorResponse` means that something went wrong. Details in the encapsulated `Error`. 246 | 247 | -} 248 | type Response 249 | = NoResponse 250 | | CmdResponse Message 251 | | ListResponse (List Response) 252 | | ConnectedResponse { key : String, description : String } 253 | | ReconnectedResponse { key : String, description : String } 254 | | MessageReceivedResponse { key : String, message : String } 255 | | ClosedResponse 256 | { key : String 257 | , code : ClosedCode 258 | , reason : String 259 | , wasClean : Bool 260 | , expected : Bool 261 | } 262 | | BytesQueuedResponse { key : String, bufferedAmount : Int } 263 | | ErrorResponse Error 264 | 265 | 266 | {-| Opaque message type. 267 | 268 | You can create the instances you need to send with `openMessage`, `sendMessage`, `closeMessage`, and `bytesQueuedMessage`. 269 | 270 | -} 271 | type alias Message = 272 | InternalMessage 273 | 274 | 275 | {-| The name of this module: "WebSocket". 276 | -} 277 | moduleName : String 278 | moduleName = 279 | "WebSocket" 280 | 281 | 282 | {-| Our module descriptor. 283 | -} 284 | moduleDesc : ModuleDesc Message State Response 285 | moduleDesc = 286 | PortFunnel.makeModuleDesc moduleName encode decode process 287 | 288 | 289 | {-| Encode a `Message` into a `GenericMessage`. 290 | 291 | Only exposed so the tests can use it. 292 | 293 | User code will use it implicitly through `moduleDesc`. 294 | 295 | -} 296 | encode : Message -> GenericMessage 297 | encode mess = 298 | let 299 | gm tag args = 300 | GenericMessage moduleName tag args 301 | in 302 | case mess of 303 | Startup -> 304 | gm "startup" JE.null 305 | 306 | POOpen { key, url } -> 307 | JE.object 308 | [ ( "key", JE.string key ) 309 | , ( "url", JE.string url ) 310 | ] 311 | |> gm "open" 312 | 313 | POSend { key, message } -> 314 | JE.object 315 | [ ( "key", JE.string key ) 316 | , ( "message", JE.string message ) 317 | ] 318 | |> gm "send" 319 | 320 | POClose { key, reason } -> 321 | JE.object 322 | [ ( "key", JE.string key ) 323 | , ( "reason", JE.string reason ) 324 | ] 325 | |> gm "close" 326 | 327 | POBytesQueued { key } -> 328 | JE.object [ ( "key", JE.string key ) ] 329 | |> gm "getBytesQueued" 330 | 331 | PODelay { millis, id } -> 332 | JE.object 333 | [ ( "millis", JE.int millis ) 334 | , ( "id", JE.string id ) 335 | ] 336 | |> gm "delay" 337 | 338 | PWillOpen { key, url, keepAlive } -> 339 | JE.object 340 | [ ( "key", JE.string key ) 341 | , ( "url", JE.string url ) 342 | , ( "keepAlive", JE.bool keepAlive ) 343 | ] 344 | |> gm "willopen" 345 | 346 | PWillSend { key, message } -> 347 | JE.object 348 | [ ( "key", JE.string key ) 349 | , ( "message", JE.string message ) 350 | ] 351 | |> gm "willsend" 352 | 353 | PWillClose { key, reason } -> 354 | JE.object 355 | [ ( "key", JE.string key ) 356 | , ( "reason", JE.string reason ) 357 | ] 358 | |> gm "willclose" 359 | 360 | PIConnected { key, description } -> 361 | JE.object 362 | [ ( "key", JE.string key ) 363 | , ( "description", JE.string description ) 364 | ] 365 | |> gm "connected" 366 | 367 | PIMessageReceived { key, message } -> 368 | JE.object 369 | [ ( "key", JE.string key ) 370 | , ( "message", JE.string message ) 371 | ] 372 | |> gm "messageReceived" 373 | 374 | PIClosed { key, bytesQueued, code, reason, wasClean } -> 375 | JE.object 376 | [ ( "key", JE.string key ) 377 | , ( "bytesQueued", JE.int bytesQueued ) 378 | , ( "code", JE.int code ) 379 | , ( "reason", JE.string reason ) 380 | , ( "wasClean", JE.bool wasClean ) 381 | ] 382 | |> gm "closed" 383 | 384 | PIBytesQueued { key, bufferedAmount } -> 385 | JE.object 386 | [ ( "key", JE.string key ) 387 | , ( "bufferedAmount", JE.int bufferedAmount ) 388 | ] 389 | |> gm "bytesQueued" 390 | 391 | PIDelayed { id } -> 392 | JE.object [ ( "id", JE.string id ) ] 393 | |> gm "delayed" 394 | 395 | PIError { key, code, description, name, message } -> 396 | List.concat 397 | [ case key of 398 | Just k -> 399 | [ ( "key", JE.string k ) ] 400 | 401 | Nothing -> 402 | [] 403 | , [ ( "code", JE.string code ) 404 | , ( "description", JE.string description ) 405 | ] 406 | , case name of 407 | Just n -> 408 | [ ( "name", JE.string n ) ] 409 | 410 | Nothing -> 411 | [] 412 | , case message of 413 | Just m -> 414 | [ ( "message", JE.string m ) ] 415 | 416 | Nothing -> 417 | [] 418 | ] 419 | |> JE.object 420 | |> gm "error" 421 | 422 | 423 | 424 | -- 425 | -- A bunch of helper type aliases, to ease writing `decode` below. 426 | -- 427 | 428 | 429 | type alias KeyUrl = 430 | { key : String, url : String } 431 | 432 | 433 | type alias KeyUrlKeepAlive = 434 | { key : String, url : String, keepAlive : Bool } 435 | 436 | 437 | type alias KeyMessage = 438 | { key : String, message : String } 439 | 440 | 441 | type alias KeyReason = 442 | { key : String, reason : String } 443 | 444 | 445 | type alias MillisId = 446 | { millis : Int, id : String } 447 | 448 | 449 | type alias KeyDescription = 450 | { key : String, description : String } 451 | 452 | 453 | type alias KeyBufferedAmount = 454 | { key : String, bufferedAmount : Int } 455 | 456 | 457 | {-| This is basically `Json.Decode.decodeValue`, 458 | 459 | but with the args reversed, and converting the error to a string. 460 | 461 | -} 462 | valueDecode : Value -> Decoder a -> Result String a 463 | valueDecode value decoder = 464 | case JD.decodeValue decoder value of 465 | Ok a -> 466 | Ok a 467 | 468 | Err err -> 469 | Err <| JD.errorToString err 470 | 471 | 472 | {-| Decode a `GenericMessage` into a `Message`. 473 | 474 | Only exposed so the tests can use it. 475 | 476 | User code will use it implicitly through `moduleDesc`. 477 | 478 | -} 479 | decode : GenericMessage -> Result String Message 480 | decode { tag, args } = 481 | case tag of 482 | "startup" -> 483 | Ok Startup 484 | 485 | "open" -> 486 | JD.succeed KeyUrl 487 | |> required "key" JD.string 488 | |> required "url" JD.string 489 | |> JD.map POOpen 490 | |> valueDecode args 491 | 492 | "send" -> 493 | JD.succeed KeyMessage 494 | |> required "key" JD.string 495 | |> required "message" JD.string 496 | |> JD.map POSend 497 | |> valueDecode args 498 | 499 | "close" -> 500 | JD.succeed KeyReason 501 | |> required "key" JD.string 502 | |> required "reason" JD.string 503 | |> JD.map POClose 504 | |> valueDecode args 505 | 506 | "getBytesQueued" -> 507 | JD.succeed (\key -> { key = key }) 508 | |> required "key" JD.string 509 | |> JD.map POBytesQueued 510 | |> valueDecode args 511 | 512 | "delay" -> 513 | JD.succeed MillisId 514 | |> required "millis" JD.int 515 | |> required "id" JD.string 516 | |> JD.map PODelay 517 | |> valueDecode args 518 | 519 | "willopen" -> 520 | JD.succeed KeyUrlKeepAlive 521 | |> required "key" JD.string 522 | |> required "url" JD.string 523 | |> required "keepAlive" JD.bool 524 | |> JD.map PWillOpen 525 | |> valueDecode args 526 | 527 | "willsend" -> 528 | JD.succeed KeyMessage 529 | |> required "key" JD.string 530 | |> required "message" JD.string 531 | |> JD.map PWillSend 532 | |> valueDecode args 533 | 534 | "willclose" -> 535 | JD.succeed KeyReason 536 | |> required "key" JD.string 537 | |> required "reason" JD.string 538 | |> JD.map PWillClose 539 | |> valueDecode args 540 | 541 | "connected" -> 542 | JD.succeed KeyDescription 543 | |> required "key" JD.string 544 | |> required "description" JD.string 545 | |> JD.map PIConnected 546 | |> valueDecode args 547 | 548 | "messageReceived" -> 549 | JD.succeed KeyMessage 550 | |> required "key" JD.string 551 | |> required "message" JD.string 552 | |> JD.map PIMessageReceived 553 | |> valueDecode args 554 | 555 | "closed" -> 556 | JD.succeed PIClosedRecord 557 | |> required "key" JD.string 558 | |> required "bytesQueued" JD.int 559 | |> required "code" JD.int 560 | |> required "reason" JD.string 561 | |> required "wasClean" JD.bool 562 | |> JD.map PIClosed 563 | |> valueDecode args 564 | 565 | "bytesQueued" -> 566 | JD.succeed KeyBufferedAmount 567 | |> required "key" JD.string 568 | |> required "bufferedAmount" JD.int 569 | |> JD.map PIBytesQueued 570 | |> valueDecode args 571 | 572 | "delayed" -> 573 | JD.succeed (\id -> { id = id }) 574 | |> required "id" JD.string 575 | |> JD.map PIDelayed 576 | |> valueDecode args 577 | 578 | "error" -> 579 | JD.succeed PIErrorRecord 580 | |> optional "key" (JD.nullable JD.string) Nothing 581 | |> required "code" JD.string 582 | |> required "description" JD.string 583 | |> optional "name" (JD.nullable JD.string) Nothing 584 | |> optional "message" (JD.nullable JD.string) Nothing 585 | |> JD.map PIError 586 | |> valueDecode args 587 | 588 | _ -> 589 | Err <| "Unknown tag: " ++ tag 590 | 591 | 592 | {-| Send a `Message` through a `Cmd` port. 593 | -} 594 | send : (Value -> Cmd msg) -> Message -> Cmd msg 595 | send = 596 | PortFunnel.sendMessage moduleDesc 597 | 598 | 599 | emptySocketState : SocketState 600 | emptySocketState = 601 | { phase = IdlePhase 602 | , url = "" 603 | , backoff = 0 604 | , continuationId = Nothing 605 | , keepAlive = False 606 | } 607 | 608 | 609 | getSocketState : String -> StateRecord -> SocketState 610 | getSocketState key state = 611 | Dict.get key state.socketStates 612 | |> Maybe.withDefault emptySocketState 613 | 614 | 615 | process : Message -> State -> ( State, Response ) 616 | process mess ((State state) as unboxed) = 617 | case mess of 618 | Startup -> 619 | ( State { state | isLoaded = True } 620 | , NoResponse 621 | ) 622 | 623 | PWillOpen { key, url, keepAlive } -> 624 | doOpen state key url keepAlive 625 | 626 | PWillSend { key, message } -> 627 | doSend state key message 628 | 629 | PWillClose { key, reason } -> 630 | doClose state key reason 631 | 632 | PIConnected { key, description } -> 633 | let 634 | socketState = 635 | getSocketState key state 636 | in 637 | if socketState.phase /= ConnectingPhase then 638 | ( State state 639 | , ErrorResponse <| 640 | UnexpectedConnectedError 641 | { key = key, description = description } 642 | ) 643 | 644 | else 645 | let 646 | newState = 647 | { state 648 | | socketStates = 649 | Dict.insert key 650 | { socketState 651 | | phase = ConnectedPhase 652 | , backoff = 0 653 | } 654 | state.socketStates 655 | } 656 | in 657 | if socketState.backoff == 0 then 658 | ( State newState 659 | , ConnectedResponse 660 | { key = key, description = description } 661 | ) 662 | 663 | else 664 | processQueuedMessage newState 665 | key 666 | <| 667 | ReconnectedResponse 668 | { key = key, description = description } 669 | 670 | PIMessageReceived { key, message } -> 671 | let 672 | socketState = 673 | getSocketState key state 674 | in 675 | if socketState.phase /= ConnectedPhase then 676 | ( State state 677 | , ErrorResponse <| 678 | UnexpectedMessageError 679 | { key = key, message = message } 680 | ) 681 | 682 | else 683 | ( State state 684 | , if socketState.keepAlive then 685 | NoResponse 686 | 687 | else 688 | MessageReceivedResponse { key = key, message = message } 689 | ) 690 | 691 | PIClosed ({ key, bytesQueued, code, reason, wasClean } as closedRecord) -> 692 | let 693 | socketState = 694 | getSocketState key state 695 | 696 | expected = 697 | socketState.phase == ClosingPhase 698 | in 699 | if not expected && not (Set.member key state.noAutoReopenKeys) then 700 | handleUnexpectedClose state closedRecord 701 | 702 | else 703 | ( State 704 | { state 705 | | socketStates = 706 | Dict.remove key state.socketStates 707 | } 708 | , ClosedResponse 709 | { key = key 710 | , code = closedCode code 711 | , reason = reason 712 | , wasClean = wasClean 713 | , expected = expected 714 | } 715 | ) 716 | 717 | PIBytesQueued { key, bufferedAmount } -> 718 | -- TODO 719 | ( State state, NoResponse ) 720 | 721 | PIDelayed { id } -> 722 | case getContinuation id state of 723 | Nothing -> 724 | ( State state, NoResponse ) 725 | 726 | Just ( key, kind, state2 ) -> 727 | case kind of 728 | DrainOutputQueue -> 729 | processQueuedMessage state2 key NoResponse 730 | 731 | RetryConnection -> 732 | let 733 | socketState = 734 | getSocketState key state 735 | 736 | url = 737 | socketState.url 738 | in 739 | if url /= "" then 740 | ( State 741 | { state2 742 | | socketStates = 743 | Dict.insert key 744 | { socketState 745 | | phase = ConnectingPhase 746 | } 747 | state.socketStates 748 | } 749 | , CmdResponse <| POOpen { key = key, url = url } 750 | ) 751 | 752 | else 753 | -- This shouldn't be possible 754 | unexpectedClose state 755 | { key = key 756 | , code = 757 | closedCodeNumber AbnormalClosure 758 | , bytesQueued = 0 759 | , reason = 760 | "Missing URL for reconnect" 761 | , wasClean = 762 | False 763 | } 764 | 765 | PIError { key, code, description, name, message } -> 766 | ( State state 767 | , ErrorResponse <| 768 | -- TODO. 769 | -- Can get an error on send or close while unexpected close retry. 770 | LowLevelError 771 | { key = key 772 | , code = code 773 | , description = description 774 | , name = name 775 | , message = message 776 | } 777 | ) 778 | 779 | _ -> 780 | ( State state 781 | , ErrorResponse <| 782 | InvalidMessageError { message = mess } 783 | ) 784 | 785 | 786 | {-| All the errors that can be returned in a Response.ErrorResponse. 787 | 788 | If an error tag has a single `String` arg, that string is a socket `key`. 789 | 790 | -} 791 | type Error 792 | = SocketAlreadyOpenError String 793 | | SocketConnectingError String 794 | | SocketClosingError String 795 | | SocketNotOpenError String 796 | | UnexpectedConnectedError { key : String, description : String } 797 | | UnexpectedMessageError { key : String, message : String } 798 | | LowLevelError PIErrorRecord 799 | | InvalidMessageError { message : Message } 800 | 801 | 802 | {-| Convert an `Error` to a string, for simple reporting. 803 | -} 804 | errorToString : Error -> String 805 | errorToString theError = 806 | case theError of 807 | SocketAlreadyOpenError key -> 808 | "SocketAlreadyOpenError \"" ++ key ++ "\"" 809 | 810 | SocketConnectingError key -> 811 | "SocketConnectingError \"" ++ key ++ "\"" 812 | 813 | SocketClosingError key -> 814 | "SocketClosingError \"" ++ key ++ "\"" 815 | 816 | SocketNotOpenError key -> 817 | "SocketNotOpenError \"" ++ key ++ "\"" 818 | 819 | UnexpectedConnectedError { key, description } -> 820 | "UnexpectedConnectedError\n { key = \"" 821 | ++ key 822 | ++ "\", description = \"" 823 | ++ description 824 | ++ "\" }" 825 | 826 | UnexpectedMessageError { key, message } -> 827 | "UnexpectedMessageError { key = \"" 828 | ++ key 829 | ++ "\", message = \"" 830 | ++ message 831 | ++ "\" }" 832 | 833 | LowLevelError { key, code, description, name } -> 834 | "LowLevelError { key = \"" 835 | ++ maybeStringToString key 836 | ++ "\", code = \"" 837 | ++ code 838 | ++ "\", description = \"" 839 | ++ description 840 | ++ "\", code = \"" 841 | ++ maybeStringToString name 842 | ++ "\" }" 843 | 844 | InvalidMessageError { message } -> 845 | "InvalidMessageError: " ++ toString message 846 | 847 | 848 | maybeStringToString : Maybe String -> String 849 | maybeStringToString string = 850 | case string of 851 | Nothing -> 852 | "Nothing" 853 | 854 | Just s -> 855 | "Just \"" ++ s ++ "\"" 856 | 857 | 858 | boolToString : Bool -> String 859 | boolToString bool = 860 | if bool then 861 | "True" 862 | 863 | else 864 | "False" 865 | 866 | 867 | {-| Responsible for sending a `CmdResponse` back through the port. 868 | 869 | Called by `PortFunnel.appProcess` for each response returned by `process`. 870 | 871 | -} 872 | commander : (GenericMessage -> Cmd msg) -> Response -> Cmd msg 873 | commander gfPort response = 874 | case response of 875 | CmdResponse message -> 876 | encode message 877 | |> gfPort 878 | 879 | ListResponse responses -> 880 | List.foldl 881 | (\rsp res -> 882 | case rsp of 883 | CmdResponse message -> 884 | message :: res 885 | 886 | _ -> 887 | res 888 | ) 889 | [] 890 | responses 891 | |> List.map (encode >> gfPort) 892 | |> Cmd.batch 893 | 894 | _ -> 895 | Cmd.none 896 | 897 | 898 | simulator : Message -> Maybe Message 899 | simulator mess = 900 | case mess of 901 | Startup -> 902 | Nothing 903 | 904 | PWillOpen record -> 905 | Just <| PWillOpen record 906 | 907 | POOpen { key } -> 908 | Just <| 909 | PIConnected { key = key, description = "Simulated connection." } 910 | 911 | PWillSend record -> 912 | Just <| PWillSend record 913 | 914 | POSend { key, message } -> 915 | Just <| PIMessageReceived { key = key, message = message } 916 | 917 | PWillClose record -> 918 | Just <| PWillClose record 919 | 920 | POClose { key, reason } -> 921 | Just <| 922 | PIClosed 923 | { key = key 924 | , bytesQueued = 0 925 | , code = closedCodeNumber NormalClosure 926 | , reason = "You asked for it, you got it, Toyota!" 927 | , wasClean = True 928 | } 929 | 930 | POBytesQueued { key } -> 931 | Just <| PIBytesQueued { key = key, bufferedAmount = 0 } 932 | 933 | PODelay { millis, id } -> 934 | Just <| PIDelayed { id = id } 935 | 936 | _ -> 937 | let 938 | name = 939 | .tag <| encode mess 940 | in 941 | Just <| 942 | PIError 943 | { key = Nothing 944 | , code = "Unknown message" 945 | , description = "You asked me to simulate an incoming message." 946 | , name = Just name 947 | , message = Nothing 948 | } 949 | 950 | 951 | {-| Make a simulated `Cmd` port. 952 | -} 953 | makeSimulatedCmdPort : (Value -> msg) -> Value -> Cmd msg 954 | makeSimulatedCmdPort = 955 | PortFunnel.makeSimulatedFunnelCmdPort 956 | moduleDesc 957 | simulator 958 | 959 | 960 | {-| Convert a `Message` to a nice-looking human-readable string. 961 | -} 962 | toString : Message -> String 963 | toString mess = 964 | case mess of 965 | Startup -> 966 | "" 967 | 968 | PWillOpen { key, url, keepAlive } -> 969 | "PWillOpen { key = \"" 970 | ++ key 971 | ++ "\", url = \"" 972 | ++ url 973 | ++ "\", keepAlive = " 974 | ++ (if keepAlive then 975 | "True" 976 | 977 | else 978 | "False" ++ "}" 979 | ) 980 | 981 | POOpen { key, url } -> 982 | "POOpen { key = \"" ++ key ++ "\", url = \"" ++ url ++ "\"}" 983 | 984 | PIConnected { key, description } -> 985 | "PIConnected { key = \"" 986 | ++ key 987 | ++ "\", description = \"" 988 | ++ description 989 | ++ "\"}" 990 | 991 | PWillSend { key, message } -> 992 | "PWillSend { key = \"" ++ key ++ "\", message = \"" ++ message ++ "\"}" 993 | 994 | POSend { key, message } -> 995 | "POSend { key = \"" ++ key ++ "\", message = \"" ++ message ++ "\"}" 996 | 997 | PIMessageReceived { key, message } -> 998 | "PIMessageReceived { key = \"" 999 | ++ key 1000 | ++ "\", message = \"" 1001 | ++ message 1002 | ++ "\"}" 1003 | 1004 | PWillClose { key, reason } -> 1005 | "PWillClose { key = \"" ++ key ++ "\", reason = \"" ++ reason ++ "\"}" 1006 | 1007 | POClose { key, reason } -> 1008 | "POClose { key = \"" ++ key ++ "\", reason = \"" ++ reason ++ "\"}" 1009 | 1010 | PIClosed { key, bytesQueued, code, reason, wasClean } -> 1011 | "PIClosed { key = \"" 1012 | ++ key 1013 | ++ "\", bytesQueued = \"" 1014 | ++ String.fromInt bytesQueued 1015 | ++ "\", code = \"" 1016 | ++ String.fromInt code 1017 | ++ "\", reason = \"" 1018 | ++ reason 1019 | ++ "\", wasClean = \"" 1020 | ++ (if wasClean then 1021 | "True" 1022 | 1023 | else 1024 | "False" 1025 | ++ "\"}" 1026 | ) 1027 | 1028 | POBytesQueued { key } -> 1029 | "POBytesQueued { key = \"" ++ key ++ "\"}" 1030 | 1031 | PIBytesQueued { key, bufferedAmount } -> 1032 | "PIBytesQueued { key = \"" 1033 | ++ key 1034 | ++ "\", bufferedAmount = \"" 1035 | ++ String.fromInt bufferedAmount 1036 | ++ "\"}" 1037 | 1038 | PODelay { millis, id } -> 1039 | "PODelay { millis = \"" 1040 | ++ String.fromInt millis 1041 | ++ "\" id = \"" 1042 | ++ id 1043 | ++ "\"}" 1044 | 1045 | PIDelayed { id } -> 1046 | "PIDelayed { id = \"" ++ id ++ "\"}" 1047 | 1048 | PIError { key, code, description, name } -> 1049 | "PIError { key = \"" 1050 | ++ maybeString key 1051 | ++ "\" code = \"" 1052 | ++ code 1053 | ++ "\" description = \"" 1054 | ++ description 1055 | ++ "\" name = \"" 1056 | ++ maybeString name 1057 | ++ "\"}" 1058 | 1059 | 1060 | maybeString : Maybe String -> String 1061 | maybeString s = 1062 | case s of 1063 | Nothing -> 1064 | "Nothing" 1065 | 1066 | Just string -> 1067 | "Just " ++ string 1068 | 1069 | 1070 | {-| Convert a `Message` to the same JSON string that gets sent 1071 | 1072 | over the wire to the JS code. 1073 | 1074 | -} 1075 | toJsonString : Message -> String 1076 | toJsonString message = 1077 | message 1078 | |> encode 1079 | |> PortFunnel.encodeGenericMessage 1080 | |> JE.encode 0 1081 | 1082 | 1083 | queueSend : StateRecord -> String -> String -> ( State, Response ) 1084 | queueSend state key message = 1085 | let 1086 | queues = 1087 | state.queues 1088 | 1089 | current = 1090 | Dict.get key queues 1091 | |> Maybe.withDefault [] 1092 | 1093 | new = 1094 | List.append current [ message ] 1095 | in 1096 | ( State 1097 | { state 1098 | | queues = Dict.insert key new queues 1099 | } 1100 | , NoResponse 1101 | ) 1102 | 1103 | 1104 | 1105 | -- COMMANDS 1106 | 1107 | 1108 | {-| Create a `Message` to send a string to a particular address. 1109 | 1110 | makeSend key message 1111 | 1112 | Example: 1113 | 1114 | makeSend "wss://echo.websocket.org" "Hello!" 1115 | |> send cmdPort 1116 | 1117 | You must send a `makeOpen` or `makeOpenWithKey` message before `makeSend`. 1118 | 1119 | If you send a `makeSend` message before the connection has been established, or while it is being reestablished after it was lost, your message will be buffered and sent after the connection has been (re)established. 1120 | 1121 | -} 1122 | makeSend : String -> String -> Message 1123 | makeSend key message = 1124 | PWillSend { key = key, message = message } 1125 | 1126 | 1127 | doSend : StateRecord -> String -> String -> ( State, Response ) 1128 | doSend state key message = 1129 | let 1130 | socketState = 1131 | getSocketState key state 1132 | in 1133 | if socketState.phase /= ConnectedPhase then 1134 | if socketState.backoff == 0 then 1135 | -- TODO: This will eventually open, send, close. 1136 | -- For now, though, it's an error. 1137 | ( State state, ErrorResponse <| SocketNotOpenError key ) 1138 | 1139 | else 1140 | -- We're attempting to reopen the connection. Queue sends. 1141 | queueSend state key message 1142 | 1143 | else if Dict.get key state.queues == Nothing then 1144 | -- Normal send 1145 | ( State state 1146 | , CmdResponse <| POSend { key = key, message = message } 1147 | ) 1148 | 1149 | else 1150 | -- We're queuing output. Add one more message to the queue. 1151 | queueSend state key message 1152 | 1153 | 1154 | {-| Create a `Message` to open a connection to a WebSocket server. 1155 | 1156 | makeOpen url 1157 | 1158 | Example: 1159 | 1160 | makeOpen "wss://echo.websocket.org" 1161 | |> send cmdPort 1162 | 1163 | -} 1164 | makeOpen : String -> Message 1165 | makeOpen url = 1166 | makeOpenWithKey url url 1167 | 1168 | 1169 | {-| Like `makeOpen`, but allows matching a unique key to the connection. 1170 | 1171 | `makeOpen` uses the url as the key. 1172 | 1173 | makeOpenWithKey key url 1174 | 1175 | Example: 1176 | 1177 | makeOpenWithKey "echo" "wss://echo.websocket.org" 1178 | 1179 | -} 1180 | makeOpenWithKey : String -> String -> Message 1181 | makeOpenWithKey key url = 1182 | PWillOpen { key = key, url = url, keepAlive = False } 1183 | 1184 | 1185 | doOpen : StateRecord -> String -> String -> Bool -> ( State, Response ) 1186 | doOpen state key url keepAlive = 1187 | case checkUsedSocket state key of 1188 | Err res -> 1189 | res 1190 | 1191 | Ok socketState -> 1192 | ( State 1193 | { state 1194 | | socketStates = 1195 | Dict.insert key 1196 | { socketState 1197 | | phase = ConnectingPhase 1198 | , url = url 1199 | , keepAlive = keepAlive 1200 | } 1201 | state.socketStates 1202 | } 1203 | , CmdResponse <| POOpen { key = key, url = url } 1204 | ) 1205 | 1206 | 1207 | checkUsedSocket : StateRecord -> String -> Result ( State, Response ) SocketState 1208 | checkUsedSocket state key = 1209 | let 1210 | socketState = 1211 | getSocketState key state 1212 | in 1213 | case socketState.phase of 1214 | IdlePhase -> 1215 | Ok socketState 1216 | 1217 | ConnectedPhase -> 1218 | Err ( State state, ErrorResponse <| SocketAlreadyOpenError key ) 1219 | 1220 | ConnectingPhase -> 1221 | Err ( State state, ErrorResponse <| SocketConnectingError key ) 1222 | 1223 | ClosingPhase -> 1224 | Err ( State state, ErrorResponse <| SocketClosingError key ) 1225 | 1226 | 1227 | {-| Create a `Message` to close a previously opened WebSocket. 1228 | 1229 | makeClose key 1230 | 1231 | The `key` arg is either they `key` arg to `makeOpenWithKey` or 1232 | `makeKeepAliveWithKey` or the `url` arg to `makeOpen` or `makeKeepAlive`. 1233 | 1234 | Example: 1235 | 1236 | makeClose "echo" 1237 | |> send cmdPort 1238 | 1239 | -} 1240 | makeClose : String -> Message 1241 | makeClose key = 1242 | PWillClose { key = key, reason = "user request" } 1243 | 1244 | 1245 | doClose : StateRecord -> String -> String -> ( State, Response ) 1246 | doClose state key reason = 1247 | let 1248 | socketState = 1249 | getSocketState key state 1250 | in 1251 | if socketState.phase /= ConnectedPhase then 1252 | ( State 1253 | { state 1254 | | continuations = 1255 | case socketState.continuationId of 1256 | Nothing -> 1257 | state.continuations 1258 | 1259 | Just id -> 1260 | Dict.remove id state.continuations 1261 | , socketStates = 1262 | Dict.remove key state.socketStates 1263 | } 1264 | -- An abnormal close error will be returned later 1265 | , NoResponse 1266 | ) 1267 | 1268 | else 1269 | ( State 1270 | { state 1271 | | socketStates = 1272 | Dict.insert key 1273 | { socketState | phase = ClosingPhase } 1274 | state.socketStates 1275 | } 1276 | , CmdResponse <| POClose { key = key, reason = "user request" } 1277 | ) 1278 | 1279 | 1280 | {-| Create a `Message` to connect to a WebSocket server, but not report received messages. 1281 | 1282 | makeKeepAlive url 1283 | 1284 | For keeping a connection open for when you only need to send `makeSend` messages. 1285 | 1286 | Example: 1287 | 1288 | makeKeepAlive "wss://echo.websocket.org" 1289 | |> send cmdPort 1290 | 1291 | -} 1292 | makeKeepAlive : String -> Message 1293 | makeKeepAlive url = 1294 | makeKeepAliveWithKey url url 1295 | 1296 | 1297 | {-| Like `makeKeepAlive`, but allows matching a unique key to the connection. 1298 | 1299 | makeKeepAliveWithKey key url 1300 | 1301 | Example: 1302 | 1303 | makeKeepAliveWithKey "echo" "wss://echo.websocket.org" 1304 | |> send cmdPort 1305 | 1306 | -} 1307 | makeKeepAliveWithKey : String -> String -> Message 1308 | makeKeepAliveWithKey key url = 1309 | PWillOpen { key = key, url = url, keepAlive = True } 1310 | 1311 | 1312 | 1313 | -- MANAGER 1314 | 1315 | 1316 | {-| Get the URL for a key. 1317 | -} 1318 | getKeyUrl : String -> State -> Maybe String 1319 | getKeyUrl key (State state) = 1320 | case Dict.get key state.socketStates of 1321 | Just socketState -> 1322 | Just socketState.url 1323 | 1324 | Nothing -> 1325 | Nothing 1326 | 1327 | 1328 | getContinuation : String -> StateRecord -> Maybe ( String, ContinuationKind, StateRecord ) 1329 | getContinuation id state = 1330 | case Dict.get id state.continuations of 1331 | Nothing -> 1332 | Nothing 1333 | 1334 | Just continuation -> 1335 | Just 1336 | ( continuation.key 1337 | , continuation.kind 1338 | , { state 1339 | | continuations = Dict.remove id state.continuations 1340 | } 1341 | ) 1342 | 1343 | 1344 | allocateContinuation : String -> ContinuationKind -> StateRecord -> ( String, StateRecord ) 1345 | allocateContinuation key kind state = 1346 | let 1347 | counter = 1348 | state.continuationCounter + 1 1349 | 1350 | id = 1351 | String.fromInt counter 1352 | 1353 | continuation = 1354 | { key = key, kind = kind } 1355 | 1356 | ( continuations, socketState ) = 1357 | case Dict.get key state.socketStates of 1358 | Nothing -> 1359 | ( state.continuations, getSocketState key state ) 1360 | 1361 | Just sockState -> 1362 | case sockState.continuationId of 1363 | Nothing -> 1364 | ( state.continuations 1365 | , { sockState 1366 | | continuationId = Just id 1367 | } 1368 | ) 1369 | 1370 | Just oldid -> 1371 | ( Dict.remove oldid state.continuations 1372 | , { sockState 1373 | | continuationId = Just id 1374 | } 1375 | ) 1376 | in 1377 | ( id 1378 | , { state 1379 | | continuationCounter = counter 1380 | , socketStates = Dict.insert key socketState state.socketStates 1381 | , continuations = Dict.insert id continuation continuations 1382 | } 1383 | ) 1384 | 1385 | 1386 | processQueuedMessage : StateRecord -> String -> Response -> ( State, Response ) 1387 | processQueuedMessage state key reconnectedResponse = 1388 | let 1389 | queues = 1390 | state.queues 1391 | in 1392 | case Dict.get key queues of 1393 | Nothing -> 1394 | ( State state, reconnectedResponse ) 1395 | 1396 | Just [] -> 1397 | ( State 1398 | { state 1399 | | queues = Dict.remove key queues 1400 | } 1401 | , reconnectedResponse 1402 | ) 1403 | 1404 | Just (message :: tail) -> 1405 | let 1406 | posend = 1407 | POSend 1408 | { key = key 1409 | , message = message 1410 | } 1411 | 1412 | ( id, state2 ) = 1413 | allocateContinuation key DrainOutputQueue state 1414 | 1415 | podelay = 1416 | PODelay 1417 | { millis = 20 1418 | , id = id 1419 | } 1420 | 1421 | response = 1422 | ListResponse <| 1423 | List.concat 1424 | [ case reconnectedResponse of 1425 | NoResponse -> 1426 | [] 1427 | 1428 | _ -> 1429 | [ reconnectedResponse ] 1430 | , [ CmdResponse podelay 1431 | , CmdResponse posend 1432 | ] 1433 | ] 1434 | in 1435 | ( State 1436 | { state2 1437 | | queues = 1438 | Dict.insert key tail queues 1439 | } 1440 | , response 1441 | ) 1442 | 1443 | 1444 | {-| Filter the `Response` arg with the predicate arg. 1445 | 1446 | If the `Response` is a `ListResponse`, then return the elements of its 1447 | encapsulated list which satisfy the predicate. 1448 | 1449 | If the `Response` itself satisfies the predicate, return it in a single-element list. 1450 | 1451 | Otherwise, return the empty list. 1452 | 1453 | -} 1454 | filterResponses : (Response -> Bool) -> Response -> List Response 1455 | filterResponses predicate response = 1456 | case response of 1457 | ListResponse list -> 1458 | List.filter predicate list 1459 | 1460 | _ -> 1461 | if predicate response then 1462 | [ response ] 1463 | 1464 | else 1465 | [] 1466 | 1467 | 1468 | {-| Return `True` iff the `Response` is a `ReconnectedResponse`. 1469 | -} 1470 | isReconnectedResponse : Response -> Bool 1471 | isReconnectedResponse response = 1472 | case response of 1473 | ReconnectedResponse _ -> 1474 | True 1475 | 1476 | _ -> 1477 | False 1478 | 1479 | 1480 | {-| Return a list of the `ReconnectedResponse` instances in the `Response`. 1481 | 1482 | reconnectedResponses response 1483 | 1484 | is equivalent to: 1485 | 1486 | filterResponse isReconnectedResponse response 1487 | 1488 | -} 1489 | reconnectedResponses : Response -> List Response 1490 | reconnectedResponses response = 1491 | case response of 1492 | ReconnectedResponse _ -> 1493 | [ response ] 1494 | 1495 | ListResponse list -> 1496 | List.filter isReconnectedResponse list 1497 | 1498 | _ -> 1499 | [] 1500 | 1501 | 1502 | {-| This will usually be `NormalClosure`. The rest are standard, except for `UnknownClosure`, which denotes a code that is not defined, and `TimeoutOutOnReconnect`, which means that exponential backoff connection reestablishment attempts timed out. 1503 | 1504 | The standard codes are from 1505 | 1506 | -} 1507 | type ClosedCode 1508 | = NormalClosure --1000 1509 | | GoingAwayClosure --1002 1510 | | ProtocolErrorClosure --1002 1511 | | UnsupportedDataClosure --1003 1512 | | NoStatusRecvdClosure --1005 1513 | | AbnormalClosure --1006 1514 | | InvalidFramePayloadDataClosure --1007 1515 | | PolicyViolationClosure --1008 1516 | | MessageTooBigClosure --1009 1517 | | MissingExtensionClosure --1010 1518 | | InternalErrorClosure --1011 1519 | | ServiceRestartClosure --1012 1520 | | TryAgainLaterClosure --1013 1521 | | BadGatewayClosure --1014 1522 | | TLSHandshakeClosure --1015 1523 | | TimedOutOnReconnect -- 4000 (available for use by applications) 1524 | | UnknownClosure 1525 | 1526 | 1527 | closurePairs : List ( Int, ClosedCode ) 1528 | closurePairs = 1529 | [ ( 1000, NormalClosure ) 1530 | , ( 1001, GoingAwayClosure ) 1531 | , ( 1002, ProtocolErrorClosure ) 1532 | , ( 1003, UnsupportedDataClosure ) 1533 | , ( 1005, NoStatusRecvdClosure ) 1534 | , ( 1006, AbnormalClosure ) 1535 | , ( 1007, InvalidFramePayloadDataClosure ) 1536 | , ( 1008, PolicyViolationClosure ) 1537 | , ( 1009, MessageTooBigClosure ) 1538 | , ( 1010, MissingExtensionClosure ) 1539 | , ( 1011, InternalErrorClosure ) 1540 | , ( 1012, ServiceRestartClosure ) 1541 | , ( 1013, TryAgainLaterClosure ) 1542 | , ( 1014, BadGatewayClosure ) 1543 | , ( 1015, TLSHandshakeClosure ) 1544 | , ( 4000, TimedOutOnReconnect ) 1545 | ] 1546 | 1547 | 1548 | closureDict : Dict Int ClosedCode 1549 | closureDict = 1550 | Dict.fromList closurePairs 1551 | 1552 | 1553 | closedCodeNumber : ClosedCode -> Int 1554 | closedCodeNumber code = 1555 | case LE.find (\( _, c ) -> c == code) closurePairs of 1556 | Just ( int, _ ) -> 1557 | int 1558 | 1559 | -- Can't happen 1560 | Nothing -> 1561 | 0 1562 | 1563 | 1564 | closedCode : Int -> ClosedCode 1565 | closedCode code = 1566 | Maybe.withDefault UnknownClosure <| Dict.get code closureDict 1567 | 1568 | 1569 | {-| Turn a `ClosedCode` into a `String`, for debugging. 1570 | -} 1571 | closedCodeToString : ClosedCode -> String 1572 | closedCodeToString code = 1573 | case code of 1574 | NormalClosure -> 1575 | "Normal" 1576 | 1577 | GoingAwayClosure -> 1578 | "GoingAway" 1579 | 1580 | ProtocolErrorClosure -> 1581 | "ProtocolError" 1582 | 1583 | UnsupportedDataClosure -> 1584 | "UnsupportedData" 1585 | 1586 | NoStatusRecvdClosure -> 1587 | "NoStatusRecvd" 1588 | 1589 | AbnormalClosure -> 1590 | "Abnormal" 1591 | 1592 | InvalidFramePayloadDataClosure -> 1593 | "InvalidFramePayloadData" 1594 | 1595 | PolicyViolationClosure -> 1596 | "PolicyViolation" 1597 | 1598 | MessageTooBigClosure -> 1599 | "MessageTooBig" 1600 | 1601 | MissingExtensionClosure -> 1602 | "MissingExtension" 1603 | 1604 | InternalErrorClosure -> 1605 | "InternalError" 1606 | 1607 | ServiceRestartClosure -> 1608 | "ServiceRestart" 1609 | 1610 | TryAgainLaterClosure -> 1611 | "TryAgainLater" 1612 | 1613 | BadGatewayClosure -> 1614 | "BadGateway" 1615 | 1616 | TLSHandshakeClosure -> 1617 | "TLSHandshake" 1618 | 1619 | TimedOutOnReconnect -> 1620 | "TimedOutOnReconnect" 1621 | 1622 | UnknownClosure -> 1623 | "UnknownClosureCode" 1624 | 1625 | 1626 | 1627 | -- REOPEN LOST CONNECTIONS AUTOMATICALLY 1628 | 1629 | 1630 | {-| 10 x 1024 milliseconds = 10.2 seconds 1631 | -} 1632 | maxBackoff : Int 1633 | maxBackoff = 1634 | 10 1635 | 1636 | 1637 | backoffMillis : Int -> Int 1638 | backoffMillis backoff = 1639 | 10 * (2 ^ backoff) 1640 | 1641 | 1642 | handleUnexpectedClose : StateRecord -> PIClosedRecord -> ( State, Response ) 1643 | handleUnexpectedClose state closedRecord = 1644 | let 1645 | key = 1646 | closedRecord.key 1647 | 1648 | socketState = 1649 | getSocketState key state 1650 | 1651 | backoff = 1652 | 1 + socketState.backoff 1653 | in 1654 | if 1655 | (backoff > maxBackoff) 1656 | || (backoff == 1 && socketState.phase /= ConnectedPhase) 1657 | || (closedRecord.bytesQueued > 0) 1658 | then 1659 | -- It was never successfully opened 1660 | -- or it was closed with output left unsent. 1661 | unexpectedClose state 1662 | { closedRecord 1663 | | code = 1664 | if backoff > maxBackoff then 1665 | closedCodeNumber TimedOutOnReconnect 1666 | 1667 | else 1668 | closedRecord.code 1669 | } 1670 | 1671 | else if socketState.url == "" then 1672 | -- Shouldn't happen 1673 | unexpectedClose state closedRecord 1674 | 1675 | else 1676 | -- It WAS successfully opened. Wait for the backoff time, and reopen. 1677 | let 1678 | ( id, state2 ) = 1679 | allocateContinuation key RetryConnection state 1680 | 1681 | delay = 1682 | PODelay 1683 | { millis = 1684 | backoffMillis backoff 1685 | , id = id 1686 | } 1687 | in 1688 | ( State 1689 | { state2 1690 | | socketStates = 1691 | Dict.insert key 1692 | { socketState | backoff = backoff } 1693 | state.socketStates 1694 | } 1695 | , CmdResponse delay 1696 | ) 1697 | 1698 | 1699 | unexpectedClose : StateRecord -> PIClosedRecord -> ( State, Response ) 1700 | unexpectedClose state { key, code, reason, wasClean } = 1701 | ( State 1702 | { state 1703 | | socketStates = Dict.remove key state.socketStates 1704 | } 1705 | , ClosedResponse 1706 | { key = key 1707 | , code = closedCode code 1708 | , reason = reason 1709 | , wasClean = wasClean 1710 | , expected = False 1711 | } 1712 | ) 1713 | 1714 | 1715 | {-| This is used to force a major version bump when the JS changes. 1716 | 1717 | You'll usually not use it for anything. 1718 | 1719 | -} 1720 | type alias JSVersion = 1721 | { v4_1 : () } 1722 | -------------------------------------------------------------------------------- /src/PortFunnel/WebSocket/InternalMessage.elm: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------------------- 2 | -- 3 | -- InternalMessage.elm 4 | -- The internals of the PortFunnel.WebSocket.Message type. 5 | -- Copyright (c) 2018 Bill St. Clair 6 | -- Some rights reserved. 7 | -- Distributed under the MIT License 8 | -- See LICENSE 9 | -- 10 | ---------------------------------------------------------------------- 11 | 12 | 13 | module PortFunnel.WebSocket.InternalMessage exposing 14 | ( InternalMessage(..) 15 | , PIClosedRecord 16 | , PIErrorRecord 17 | ) 18 | 19 | import Dict exposing (Dict) 20 | import Json.Decode as JD exposing (Decoder) 21 | import Json.Encode as JE exposing (Value) 22 | 23 | 24 | type alias PIClosedRecord = 25 | { key : String 26 | , bytesQueued : Int 27 | , code : Int 28 | , reason : String 29 | , wasClean : Bool 30 | } 31 | 32 | 33 | type alias PIErrorRecord = 34 | { key : Maybe String 35 | , code : String 36 | , description : String 37 | , name : Maybe String 38 | , message : Maybe String 39 | } 40 | 41 | 42 | type InternalMessage 43 | = Startup 44 | -- output 45 | | POOpen { key : String, url : String } 46 | | POSend { key : String, message : String } 47 | | POClose { key : String, reason : String } 48 | | POBytesQueued { key : String } 49 | | PODelay { millis : Int, id : String } 50 | -- loop 51 | | PWillOpen { key : String, url : String, keepAlive : Bool } 52 | | PWillSend { key : String, message : String } 53 | | PWillClose { key : String, reason : String } 54 | -- input 55 | | PIConnected { key : String, description : String } 56 | | PIMessageReceived { key : String, message : String } 57 | | PIClosed PIClosedRecord 58 | | PIBytesQueued { key : String, bufferedAmount : Int } 59 | | PIDelayed { id : String } 60 | | PIError PIErrorRecord 61 | -------------------------------------------------------------------------------- /tests/Tests.elm: -------------------------------------------------------------------------------- 1 | module Tests exposing (all) 2 | 3 | import Dict 4 | import Expect exposing (Expectation) 5 | import Json.Decode as JD exposing (Decoder) 6 | import Json.Encode as JE exposing (Value) 7 | import List 8 | import Maybe exposing (withDefault) 9 | import PortFunnel exposing (GenericMessage) 10 | import PortFunnel.WebSocket exposing (Message, decode, encode) 11 | import PortFunnel.WebSocket.InternalMessage exposing (InternalMessage(..)) 12 | import Test exposing (..) 13 | 14 | 15 | testMap : (x -> String -> Test) -> List x -> List Test 16 | testMap test data = 17 | let 18 | numbers = 19 | List.map String.fromInt <| List.range 1 (List.length data) 20 | in 21 | List.map2 test data numbers 22 | 23 | 24 | all : Test 25 | all = 26 | Test.concat <| 27 | List.concat 28 | [ testMap encodeDecodeTest messages 29 | ] 30 | 31 | 32 | expectResult : Result String a -> Result String a -> Expectation 33 | expectResult sb was = 34 | case was of 35 | Err pm -> 36 | case sb of 37 | Err _ -> 38 | Expect.true "You shouldn't ever see this." True 39 | 40 | Ok _ -> 41 | Expect.false pm True 42 | 43 | Ok wasv -> 44 | case sb of 45 | Err _ -> 46 | Expect.false "Expected an error but didn't get one." True 47 | 48 | Ok sbv -> 49 | Expect.equal sbv wasv 50 | 51 | 52 | encodeDecodeTest : Message -> String -> Test 53 | encodeDecodeTest message name = 54 | test ("encodeDecode #" ++ name) 55 | (\_ -> 56 | expectResult (Ok message) (decode <| encode message) 57 | ) 58 | 59 | 60 | messages : List Message 61 | messages = 62 | [ POOpen 63 | { key = "thekey" 64 | , url = "theurl" 65 | } 66 | , POSend 67 | { key = "thekey" 68 | , message = "hello" 69 | } 70 | , POClose 71 | { key = "anotherkey" 72 | , reason = "because" 73 | } 74 | , PWillOpen 75 | { key = "thekey" 76 | , url = "theurl" 77 | , keepAlive = False 78 | } 79 | , PWillSend 80 | { key = "thekey" 81 | , message = "hello" 82 | } 83 | , PWillClose 84 | { key = "anotherkey" 85 | , reason = "because" 86 | } 87 | , POBytesQueued { key = "anotherkey" } 88 | , PODelay 89 | { millis = 20 90 | , id = "1" 91 | } 92 | , PIConnected 93 | { key = "somekey" 94 | , description = "bloody fine" 95 | } 96 | , PIMessageReceived 97 | { key = "somekey" 98 | , message = "Earth to Bob. Come in Bob" 99 | } 100 | , PIClosed 101 | { key = "somekey" 102 | , bytesQueued = 0 103 | , code = 1000 --normal close 104 | , reason = "because we like you" 105 | , wasClean = True 106 | } 107 | , PIClosed 108 | { key = "somekey" 109 | , bytesQueued = 12 110 | , code = 1006 --abnormal closure 111 | , reason = "I had a bad day" 112 | , wasClean = False 113 | } 114 | , PIBytesQueued 115 | { key = "somekey" 116 | , bufferedAmount = 12 117 | } 118 | , PIDelayed { id = "2" } 119 | , PIError 120 | { key = Just "somekey" 121 | , code = "green" 122 | , description = "You rock!" 123 | , name = Just "SecurityError" 124 | , message = Just "Please close the door." 125 | } 126 | , PIError 127 | { key = Just "somekey" 128 | , code = "orange" 129 | , description = "Hit me with your best shot" 130 | , name = Nothing 131 | , message = Nothing 132 | } 133 | , PIError 134 | { key = Nothing 135 | , code = "green" 136 | , description = "You rock!" 137 | , name = Nothing 138 | , message = Nothing 139 | } 140 | ] 141 | --------------------------------------------------------------------------------