WebSocket.purs

module Diplomat.WebSocket (
    Url()
  , parseUrl

  , AttemptCount()
  , MsDelay()
  , Connection()
  , PendingConnection()
  , WebSocketEvent(..)
  , WebSocketOptions()
  , WS()

  , newWebSocket
  , connect
  , disconnect
  , reconnect
  , send
  ) where

import Math (min, pow)

import Control.Monad.Eff
import Control.Monad.Eff.Exception (Error())

import Data.Either (Either(..))
import Data.Maybe (Maybe(), maybe)
import Data.Function
import Data.Foreign
import Data.Foreign.Null
import qualified Data.String.Regex as R

--------------------------------------------------------------------------------

foreign import undefined "var undefined;" :: forall a. a

--------------------------------------------------------------------------------

newtype Url = Url String

instance showUrl :: Show Url where
  show (Url url) = show url

parseUrl :: String -> Either String Url
parseUrl url = Right $ Url url

--------------------------------------------------------------------------------

foreign import data WS :: !

type AttemptCount = Number
type MsDelay = Number


data WebSocketEvent
  = OnConnected Connection
  | OnDisconnected
  | OnReconnect AttemptCount MsDelay
  | OnError Error
  | OnMessage Connection Foreign

type WebSocketOptions eff
  = { shouldReconnect :: Boolean
    , backoffFn       :: Maybe (AttemptCount -> MsDelay)
    , eventsCallback  :: WebSocketEvent -> Eff ( websocket :: WS | eff ) Unit
    }

data EnhancedWebSocket
  = EnhancedWebSocket {
    wsConnect    :: forall eff. Eff ( websocket :: WS | eff ) Unit
  , wsDisconnect :: forall eff. Eff ( websocket :: WS | eff ) Unit
  , wsReconnect  :: forall eff. Eff ( websocket :: WS | eff ) Unit
  , wsSend       :: forall a eff. a -> Eff ( websocket :: WS | eff ) Unit
  }

newtype Connection = Connection EnhancedWebSocket
newtype PendingConnection = PendingConnection EnhancedWebSocket

foreign import enhancedWebSocket
  """
  function enhancedWebSocket(url, shouldReconnect_, backoffFn, eventsCallback_) {

      var reconnectAttemptCount = 0,
          timeoutDescriptor = null,
          innerReconnect = function() {},
          resetTimeout = null,
          backoffCeiling = 60 * 1000,
          onopen = null,
          onclose = null,
          onmessage = null,
          onerror = null,
          sendmsg = null,
          connect = null,
          disconnect = null,
          reconnect = null,
          conn = null,
          websocket = null;

      if (shouldReconnect_) {
        innerReconnect = function innerReconnect() {
            var timeoutMs = backoffFn(reconnectAttemptCount);
            eventsCallback_
              .call(null, new OnReconnect(reconnectAttemptCount, timeoutMs))();

            setTimeout(function timeoutDone() {
                         reconnectAttemptCount++;
                         connect();
                       }, timeoutMs);
        };
      }

      resetTimeout = function resetTimeout() {
        if (timeoutDescriptor) {
          reconnectAttemptCount = 0;
          clearTimeout(timeoutDescriptor);
          timeoutDescriptor = null;
        }
      };

      onopen = function onopen(ev) {
          resetTimeout();
          eventsCallback_.call(null, OnConnected.create(websocket))();
      };

      onclose = function onclose(ev) {
          if (conn) { conn = null; }
          eventsCallback_.call(null, OnDisconnected.value)();
          innerReconnect();
      };

      onmessage = function onmessage(ev) {
          eventsCallback_.call(null, new OnMessage(websocket, ev))();
      };

      onerror = function onerror(ev) {
          eventsCallback_.call(null, new OnError(ev))();
      };

      // 'public' API

      sendmsg = function(msg) {
          return function() {
              if(conn) { conn.send(msg); }
          };
      };

      connect = function connect() {
          conn = new WebSocket(url);
          conn.onopen = onopen();
          conn.onclose = onclose;
          conn.onmessage = onmessage;
          conn.onerror = onerror;
          return {};
      };

      disconnect = function disconnect() {
          if (conn === null) return {};
          ws.close();
          return {};
      }

      reconnect = function reconnect() {
          resetTimeout();
          innerReconnect();
          return {};
      }

      websocket = EnhancedWebSocket.create({ wsConnect: connect
                                           , wsDisconnect: disconnect
                                           , wsReconnect: reconnect
                                           , wsSend: send });

      return function() {
          return websocket;
      }

  }
  """ :: forall eff. Fn4 String
                         Boolean
                         (AttemptCount -> MsDelay)
                         (WebSocketEvent -> Eff ( websocket :: WS | eff) Unit)
                         (Eff ( websocket :: WS | eff ) PendingConnection)

maxBackoffDelay :: MsDelay
maxBackoffDelay = 60 * 1000

backoffFn :: AttemptCount -> MsDelay
backoffFn attempt =  min ((pow 2 attempt) * 1000) maxBackoffDelay

newWebSocket :: forall eff. Url -> WebSocketOptions eff -> Eff ( websocket :: WS | eff ) PendingConnection
newWebSocket (Url url) options = do
  runFn4 enhancedWebSocket url
                              options.shouldReconnect
                              (maybe backoffFn id options.backoffFn)
                              options.eventsCallback


connect (PendingConnection (EnhancedWebSocket { wsConnect = connect_ }))
  = connect_

disconnect (Connection (EnhancedWebSocket { wsDisconnect = disconnect_ }))
  = disconnect_

reconnect (Connection (EnhancedWebSocket { wsReconnect = reconnect_ }))
  = reconnect_

send (Connection (EnhancedWebSocket { wsSend = innerSend })) msg
  = innerSend msg