As per the last post, justin’s simple-json is now in the purerl package set, which seemed to be the perfect opportunity to write a demo app with PureScript backend (purerl and cowboy) and PureScript frontend chatting over a websocket.

This will also be an opportunity to discuss some of the changes which make writing low-level bindings to OTP behaviours possible. Expect to see some cool stuff soon exposing some higher level (and likely more opinionated) bindings.

Server

Our demo app will be streaming load numbers, so we add the application os_mon and write some basic FFI to wrap cpu_sup:avg1

avg1_(Nothing, Just) -> fun () ->
    case cpu_sup:avg1() of
        {error, _} -> Nothing;
        Load when is_integer(Load) -> Just(Load)
    end
end.

foreign import avg1_ :: Maybe Int -> (Int -> Maybe Int) -> Effect (Maybe Int)
avg1 :: Effect (Maybe Int)
avg1 = avg1_ Nothing Just

Now we can write a websocket handler. A cowboy handler is a callback module with various mandatory and optional callbacks. To write a callback module in PureScript, we need to ensure that we write a module with top-level bindings with the correct names and types; the purescript-erl-cowboy library gives a few utilities to help get these types right, but ultimately this is rather fiddly and low-level, and we will ultimately want a higher-level API which allows us to treat handlers as composable values - the disconnect being that modules are not run-time value-level constructs.

A cowboy_websocket handler has 2 init functions: firstly a plain init that initialises state from initial config and switches to the websocket behavior (in common with other cowboy handlers), and secondly a websocket_init that performs initialisation that should be done in the context of the websocket process itself.

We’re not going to save any state or initial config, so we can define an init as follows:

type State = Unit
init :: forall c. InitHandler c State
init = mkEffectFn2 \req _ -> do
  log "init was called"
  pure $ initResult unit req

The pointless log call is included to illustrate the fact that these handler functions can be effectful things. Now, what ensures “the types line up”? Firstly, InitHandler is defined as

type InitHandler c s = EffectFn2 Req c (InitResult s)

and secondly the compiler guarantees that a top level binding which is an EffectFn*N*, Fn*N* or is a curried function of arity N is represented as an erlang function of arity N. The type EffectFnN is an arity-N erlang function (as in the JS backend though with a stronger notion of arity) and has no thunking, and this carries over to the top level definition. (I told you it was fiddly.) Ro cap it off, erl-cowboy has defined InitHandler c s to match the cowboy type init(cowboy_req:req(), Config) -> {cowboy_websocket, cowboy_req:req(), State}.

We now write a websocket_init function, which we’ll use to set off a timer to send updates. Define a quick

foreign import startInterval :: forall a. Int -> a -> Effect Unit

and we can simply have

data InfoMessage = Timer

websocket_init :: WSInitHandler State
websocket_init = mkEffectFn1 \s -> do
  startInterval 100 Timer
  pure $ okResult s

Now to the interesting bits. When a frame is recieved, websocket_handle is called, actually for this app we don’t care as we will only get some ping messages

websocket_handle :: forall f. FrameHandler f
websocket_handle = mkEffectFn2 \frame state -> do
  log "got frame"
  pure $ okResult state

Now the interesting bit is the websocket_info handler, which will handle messages sent to our websocket handler process. The startInterval call above sends a message Timer of type InfoMessage, so we will define

websocket_info :: InfoHandler InfoMessage State

We are basically asserting here that nobody else will send a message of any other form to the process, this is morally in the “FFI has no guarantees” camp, here we only send the right messages with our FFI but if that invariant is not maintained, the process will crash.

So without further ado here’s the info handler:

websocket_info = mkEffectFn2 info1
  where
  info1 :: InfoMessage -> State -> Effect (CallResult Unit)
  info1 msg state = do
    avg1' <- CPU.avg1
    avg5' <- CPU.avg5
    avg15' <- CPU.avg15
    case avg1', avg5', avg15' of 
      Just avg1, Just avg5, Just avg15 -> do
        let msg :: Message
            msg = { load: { avg1, avg5, avg15 }}
        let outFrames = singleton $ outFrame $ TextFrame $ SimpleJSON.writeJSON msg
        pure $ replyResult state outFrames
      _, _, _ -> do
        log "Some issue fetching load info"
        pure $ okResult state

So the interesting bit is the line defining outFrames. We wrap a string in a TextFrame to send, and encoding our message as JSON is sas simple as SimpleJSON.writeJSON. The Message type is defined as follows, and crucially this type is shared between server and client:

type Load = {
  avg1 :: Int,
  avg5 :: Int,
  avg15 :: Int
}

type Message = {
  load :: Load
}

simple-json, it’s just that simple.

We’ll omit the code to stand up the cowboy server with routing etc., but you can find it in the repo.

Client

For a client we’ll use spork to render a few bits of HTML to the page (because really, who wants to use the DOM). Firstly, a little utility to create and subscribe to the socket, here using the purescript-web-socket low level WebSocket bindings.

createSocket :: String -> (String -> Effect Unit) -> Effect Unit
createSocket url cb = do
  socket <- WS.create url []
  listener <- EET.eventListener \ev ->
    for_ (ME.fromEvent ev) \msgEvent ->
      for_ (runExcept $ readString $ ME.data_ msgEvent) cb
  EET.addEventListener WSET.onMessage listener false (WS.toEventTarget socket)
  void $ setInterval 10000 $ WS.sendString socket "pingy"

Now the client - firstly the scaffolding to render our type to the page:

type Model = Load

data Action = UpdateMessage Message

update ∷ Model → Action → Model
update _ = case _ of
  UpdateMessage { load } → load

render ∷ Model → Html Action
render { avg1, avg5, avg15 } =
  H.ul []
    [ H.li [] [ H.text $ show avg1 ]
    , H.li [] [ H.text $ show avg5 ]
    , H.li [] [ H.text $ show avg15 ]
    ]

app ∷ PureApp Model Action
app = { update, render, init: { avg1: 0, avg5: 0, avg15: 0 } }

Nothing to see here, folks, spork makes it simple. We then subscribe to the websocket and push in messages:

main ∷ Effect Unit
main = do
    appInstance <- PureApp.makeWithSelector app "#app"
    createSocket "ws://localhost:8082/ws" \json -> 
        for_ (SimpleJSON.readJSON json) \msg -> do
            appInstance.push $ UpdateMessage msg
            appInstance.run

Again the connection is the use of the shared Message type and the use of SimpleJSON.readJSON. We decode JSON with simple-json on the JavaScript backend, while it was encoded with simple-json on the Erlang backend - the underlying JSON encoder/decoder was different, but we need not care.

Last words

I think this is pretty cool, but there’s some way to go from this to a more natural, type-safe version of the websocket handler shown here. This is something actively being worked on now, and there are definitely some better options for individual APIs (with different tradeoffs), but I think it’s still useful to see we can implement a callback module directly.

The code for this example is available in the repo.