Merge remote-tracking branch 'refs/remotes/origin/f-webrtc' into f-webrtc

- now using zj as a dep instead of just having it locally
- put WFC into its own service tree

  this surgery is not complete, but it has been started and the repo is
  currently not in a botched state

- deleted orphan "wsp" (web socket process) module

ebin/fewd.app

@@ -4,10 +4,11 @@
               {included_applications,[]},
               {applications,[stdlib,kernel]},
               {vsn,"0.2.0"},
-              {modules,[fd_cache,fd_httpd,fd_httpd_client,fd_httpd_client_man,
+              {modules,[fd_httpd,fd_httpd_client,fd_httpd_client_man,
                         fd_httpd_client_sup,fd_httpd_clients,fd_httpd_sfc,
                         fd_httpd_sfc_cache,fd_httpd_sfc_entry,fd_httpd_utils,
-                        fd_sup,fd_wsp,fewd,qhl,qhl_ws,wfc,wfc_bm,wfc_eval,
-                        wfc_eval_context,wfc_ltr,wfc_pp,wfc_read,wfc_sentence,
-                        wfc_sftt,wfc_ttfuns,wfc_utils,wfc_word,zj]},
+                        fd_sup,fd_wfcd,fd_wfcd_cache,fewd,qhl,qhl_ws,wfc,
+                        wfc_bm,wfc_eval,wfc_eval_context,wfc_ltr,wfc_pp,
+                        wfc_read,wfc_sentence,wfc_sftt,wfc_ttfuns,wfc_utils,
+                        wfc_word,zj]},
               {mod,{fewd,[]}}]}.

priv/static/index.html

@@ -17,6 +17,7 @@
 
         <ul>
             <li><a href="/echo.html">Echo</a></li>
+            <li><a href="/webrtc.html">WebRTC</a></li>
             <li><a href="/wfc.html">WFC</a></li>
         </ul>
     </div>

priv/static/js/dist/webrtc.d.ts

@@ -0,0 +1,16 @@
+/**
+ * webrtc page script
+ *
+ * Author: Peter Harpending <peterharpending@qpq.swiss>
+ * Date: 2026-02-04
+ * Copyright: Copyright (c) 2026 QPQ AG
+ *
+ * Reference: https://git.qpq.swiss/QPQ-AG/research-megadoc/src/commit/c7c4592d4b21ad120145ef63334471a1a7ec1e60/paste/2026-02/grok-webrtc.html
+ *
+ * @module
+ */
+declare function main(): Promise<void>;
+type ws_msg = ["username", string] | ["users", Array<string>];
+declare function handle_ws_msg(message: ws_msg, roster_ul: HTMLUListElement, whoami: HTMLHeadingElement): void;
+declare function handle_join(init: HTMLDivElement, init_name: HTMLInputElement, peers: HTMLDivElement, ws: WebSocket): Promise<void>;
+declare function ws_send_json(ws: WebSocket, x: any): void;

priv/static/js/dist/webrtc.js

@@ -0,0 +1,66 @@
+"use strict";
+/**
+ * webrtc page script
+ *
+ * Author: Peter Harpending <peterharpending@qpq.swiss>
+ * Date: 2026-02-04
+ * Copyright: Copyright (c) 2026 QPQ AG
+ *
+ * Reference: https://git.qpq.swiss/QPQ-AG/research-megadoc/src/commit/c7c4592d4b21ad120145ef63334471a1a7ec1e60/paste/2026-02/grok-webrtc.html
+ *
+ * @module
+ */
+main();
+async function main() {
+    // start websocket immediately
+    let ws = new WebSocket('/ws/webrtc');
+    // grab document elements
+    let init = document.getElementById('init');
+    let roster = document.getElementById('roster');
+    let roster_ul = document.getElementById('roster-ul');
+    let whoami = document.getElementById('whoami');
+    let init_name = document.getElementById('init-name');
+    let init_join = document.getElementById('init-join');
+    // handle button click
+    init_join.addEventListener('click', function () {
+        handle_join(init, init_name, roster, ws);
+    });
+    // handle message from ws
+    ws.onopen = function (e) { console.log('ws open:', e); };
+    ws.onclose = function (e) { console.warn('ws closed:', e); };
+    ws.onerror = function (e) { console.error('ws error:', e); };
+    ws.onmessage =
+        function (e) {
+            // console.log('ws message:', e.data);
+            let message = JSON.parse(e.data);
+            handle_ws_msg(message, roster_ul, whoami);
+        };
+}
+function handle_ws_msg(message, roster_ul, whoami) {
+    switch (message[0]) {
+        case "username":
+            whoami.innerText = 'Whoami: ' + message[1];
+            break;
+        case "users":
+            for (let uname of message[1]) {
+                let thisli = document.createElement('li');
+                thisli.innerText = uname;
+                roster_ul.appendChild(thisli);
+            }
+            break;
+    }
+}
+async function handle_join(init, init_name, peers, ws) {
+    console.log('connecting...');
+    let user_name = init_name.value.trim();
+    console.log('username:', user_name);
+    ws_send_json(ws, ['username', user_name]);
+    init.hidden = true;
+    peers.hidden = false;
+}
+function ws_send_json(ws, x) {
+    let s = JSON.stringify(x, undefined, 4);
+    console.log('sending:\n', s);
+    ws.send(s);
+}
+//# sourceMappingURL=webrtc.js.map

priv/static/js/dist/webrtc.js.map

@@ -0,0 +1 @@
+{"version":3,"file":"webrtc.js","sourceRoot":"","sources":["../ts/webrtc.ts"],"names":[],"mappings":";AAAA;;;;;;;;;;GAUG;AAEH,IAAI,EAAE,CAAC;AAEP,KAAK,UACL,IAAI;IAIA,8BAA8B;IAC9B,IAAI,EAAE,GAAG,IAAI,SAAS,CAAC,YAAY,CAAC,CAAC;IAErC,yBAAyB;IACzB,IAAI,IAAI,GAAQ,QAAQ,CAAC,cAAc,CAAC,MAAM,CAAwB,CAAC;IACvE,IAAI,MAAM,GAAM,QAAQ,CAAC,cAAc,CAAC,QAAQ,CAAsB,CAAC;IACvE,IAAI,SAAS,GAAG,QAAQ,CAAC,cAAc,CAAC,WAAW,CAAqB,CAAC;IACzE,IAAI,MAAM,GAAM,QAAQ,CAAC,cAAc,CAAC,QAAQ,CAA0B,CAAC;IAE3E,IAAI,SAAS,GAAG,QAAQ,CAAC,cAAc,CAAC,WAAW,CAAqB,CAAC;IACzE,IAAI,SAAS,GAAG,QAAQ,CAAC,cAAc,CAAC,WAAW,CAAsB,CAAC;IAE1E,sBAAsB;IACtB,SAAS,CAAC,gBAAgB,CAAC,OAAO,EAC9B;QACI,WAAW,CAAC,IAAI,EAAE,SAAS,EAAE,MAAM,EAAE,EAAE,CAAC,CAAC;IAC7C,CAAC,CACJ,CAAC;IAEF,yBAAyB;IACzB,EAAE,CAAC,MAAM,GAAM,UAAS,CAAC,IAAI,OAAO,CAAC,GAAG,CAAC,UAAU,EAAE,CAAC,CAAC,CAAC,CAAC,CAAC,CAAC;IAC3D,EAAE,CAAC,OAAO,GAAK,UAAS,CAAC,IAAI,OAAO,CAAC,IAAI,CAAC,YAAY,EAAE,CAAC,CAAC,CAAC,CAAC,CAAC,CAAC;IAC9D,EAAE,CAAC,OAAO,GAAK,UAAS,CAAC,IAAI,OAAO,CAAC,KAAK,CAAC,WAAW,EAAE,CAAC,CAAC,CAAC,CAAC,CAAC,CAAC;IAC9D,EAAE,CAAC,SAAS;QACR,UAAS,CAAC;YACN,sCAAsC;YACtC,IAAI,OAAO,GAAG,IAAI,CAAC,KAAK,CAAC,CAAC,CAAC,IAAI,CAAW,CAAC;YAC3C,aAAa,CAAC,OAAO,EAAE,SAAS,EAAE,MAAM,CAAC,CAAC;QAC9C,CAAC,CAAC;AACV,CAAC;AAKD,SACA,aAAa,CACR,OAAkB,EAClB,SAA4B,EAC5B,MAA8B;IAG/B,QAAO,OAAO,CAAC,CAAC,CAAC,EAAE,CAAC;QAChB,KAAK,UAAU;YACX,MAAM,CAAC,SAAS,GAAG,UAAU,GAAG,OAAO,CAAC,CAAC,CAAC,CAAC;YAC3C,MAAM;QACV,KAAK,OAAO;YACR,KAAK,IAAI,KAAK,IAAI,OAAO,CAAC,CAAC,CAAC,EAAE,CAAC;gBAC3B,IAAI,MAAM,GAAG,QAAQ,CAAC,aAAa,CAAC,IAAI,CAAC,CAAC;gBAC1C,MAAM,CAAC,SAAS,GAAG,KAAK,CAAC;gBACzB,SAAS,CAAC,WAAW,CAAC,MAAM,CAAC,CAAC;YAClC,CAAC;YACD,MAAM;IACd,CAAC;AAEL,CAAC;AAID,KAAK,UACL,WAAW,CACN,IAA0B,EAC1B,SAA4B,EAC5B,KAA0B,EAC1B,EAAqB;IAGtB,OAAO,CAAC,GAAG,CAAC,eAAe,CAAC,CAAC;IAC7B,IAAI,SAAS,GAAW,SAAS,CAAC,KAAK,CAAC,IAAI,EAAE,CAAC;IAC/C,OAAO,CAAC,GAAG,CAAC,WAAW,EAAE,SAAS,CAAC,CAAC;IAEpC,YAAY,CAAC,EAAE,EAAE,CAAC,UAAU,EAAE,SAAS,CAAC,CAAC,CAAC;IAE1C,IAAI,CAAC,MAAM,GAAG,IAAI,CAAC;IACnB,KAAK,CAAC,MAAM,GAAG,KAAK,CAAC;AACzB,CAAC;AAGD,SACA,YAAY,CACP,EAAc,EACd,CAAQ;IAGT,IAAI,CAAC,GAAW,IAAI,CAAC,SAAS,CAAC,CAAC,EAAE,SAAS,EAAE,CAAC,CAAC,CAAC;IAChD,OAAO,CAAC,GAAG,CAAC,YAAY,EAAE,CAAC,CAAC,CAAC;IAE7B,EAAE,CAAC,IAAI,CAAC,CAAC,CAAC,CAAC;AACf,CAAC"}

priv/static/js/ts/webrtc.ts

@@ -0,0 +1,107 @@
+/**
+ * webrtc page script
+ *
+ * Author: Peter Harpending <peterharpending@qpq.swiss>
+ * Date: 2026-02-04
+ * Copyright: Copyright (c) 2026 QPQ AG
+ *
+ * Reference: https://git.qpq.swiss/QPQ-AG/research-megadoc/src/commit/c7c4592d4b21ad120145ef63334471a1a7ec1e60/paste/2026-02/grok-webrtc.html
+ *
+ * @module
+ */
+
+main();
+
+async function
+main
+    ()
+    : Promise<void>
+{
+    // start websocket immediately
+    let ws = new WebSocket('/ws/webrtc');
+
+    // grab document elements
+    let init      = document.getElementById('init')      as HTMLDivElement;
+    let roster    = document.getElementById('roster')    as HTMLDivElement;
+    let roster_ul = document.getElementById('roster-ul') as HTMLUListElement;
+    let whoami    = document.getElementById('whoami')    as HTMLHeadingElement;
+
+    let init_name = document.getElementById('init-name') as HTMLInputElement;
+    let init_join = document.getElementById('init-join') as HTMLButtonElement;
+
+    // handle button click
+    init_join.addEventListener('click',
+        function() {
+            handle_join(init, init_name, roster, ws);
+        }
+    );
+
+    // handle message from ws
+    ws.onopen    = function(e) { console.log('ws open:', e); };
+    ws.onclose   = function(e) { console.warn('ws closed:', e); };
+    ws.onerror   = function(e) { console.error('ws error:', e); };
+    ws.onmessage =
+        function(e) {
+            // console.log('ws message:', e.data);
+            let message = JSON.parse(e.data) as ws_msg;
+            handle_ws_msg(message, roster_ul, whoami);
+        };
+}
+
+type ws_msg = ["username", string]
+            | ["users", Array<string>];
+
+function
+handle_ws_msg
+    (message   : ws_msg,
+     roster_ul : HTMLUListElement,
+     whoami    : HTMLHeadingElement)
+    : void
+{
+    switch(message[0]) {
+        case "username":
+            whoami.innerText = 'Whoami: ' + message[1];
+            break;
+        case "users":
+            for (let uname of message[1]) {
+                let thisli = document.createElement('li');
+                thisli.innerText = uname;
+                roster_ul.appendChild(thisli);
+            }
+            break;
+    }
+
+}
+
+
+
+async function
+handle_join
+    (init      : HTMLDivElement,
+     init_name : HTMLInputElement,
+     peers     : HTMLDivElement,
+     ws        : WebSocket)
+    : Promise<void>
+{
+    console.log('connecting...');
+    let user_name: string = init_name.value.trim();
+    console.log('username:', user_name);
+
+    ws_send_json(ws, ['username', user_name]);
+
+    init.hidden = true;
+    peers.hidden = false;
+}
+
+
+function
+ws_send_json
+    (ws : WebSocket,
+     x  : any)
+    : void
+{
+    let s: string = JSON.stringify(x, undefined, 4);
+    console.log('sending:\n', s);
+
+    ws.send(s);
+}

priv/static/webrtc.html

@@ -0,0 +1,36 @@
+<!DOCTYPE html>
+<html lang="en">
+<head>
+    <meta charset="utf-8">
+    <title>FEWD: voice chat demo</title>
+    <link rel="stylesheet" href="/css/default.css">
+</head>
+<body>
+    <div id="titlebar">
+        <div class="content">
+            <a href="/" class="tb-home">Home</a>
+        </div>
+    </div>
+
+    <div class="content">
+        <h1 class="content-title">FEWD: webrtc demo</h1>
+
+        <div id="init">
+            <label for="init-name">username:</label>
+            <input autofocus id="init-name" type="text" value='alice'>
+            <button id="init-join">connect</button>
+        </div>
+
+
+        <div id="roster" hidden>
+            <h2 id="whoami">Whoami: </h2>
+
+            <h2>Roster</h2>
+
+            <ul id="roster-ul"></ul>
+        </div>
+    </div>
+
+    <script src="/js/dist/webrtc.js"></script>
+</body>
+</html>

scratch/grok-webrtc.html

@@ -0,0 +1,166 @@
+<!DOCTYPE html>
+<html lang="en">
+<head>
+  <meta charset="UTF-8" />
+  <title>Super Simple WebRTC – Manual Signaling</title>
+  <style>
+    body { font-family: sans-serif; margin: 20px; }
+    textarea { width: 100%; height: 90px; font-family: monospace; }
+    button { margin: 6px 0; padding: 8px 16px; }
+    video { max-width: 320px; border: 1px solid #444; margin: 8px; background: #000; }
+  </style>
+</head>
+<body>
+
+<h2>WebRTC 1:1 test (copy-paste signaling)</h2>
+
+<div>
+  <button id="btnCreateOffer">1. Create Offer (Peer A)</button>
+  <button id="btnSetRemoteOffer">2. Paste offer → Set remote description</button><br>
+  <textarea id="offerSdp" placeholder="Offer SDP will appear here (Peer A) or paste offer here (Peer B)"></textarea>
+</div>
+
+<div style="margin-top: 24px;">
+  <button id="btnCreateAnswer">3. Create Answer (Peer B)</button>
+  <button id="btnSetRemoteAnswer">4. Paste answer → Set remote description</button><br>
+  <textarea id="answerSdp" placeholder="Answer SDP will appear here (Peer B) or paste answer here (Peer A)"></textarea>
+</div>
+
+<div style="margin-top: 20px;">
+  <button id="btnAddIce">Add ICE candidate manually (if needed)</button><br>
+  <textarea id="iceInput" placeholder="Paste remote ICE candidate here"></textarea>
+  <div id="iceLog"></div>
+</div>
+
+<div style="margin-top: 20px;">
+  <video id="localVideo" autoplay playsinline muted></video>
+  <video id="remoteVideo" autoplay playsinline></video>
+</div>
+
+<pre id="status">Status: ready</pre>
+
+<script>
+// ────────────────────────────────────────────────
+const $ = s => document.querySelector(s);
+const status = $('pre#status');
+const offerArea  = $('#offerSdp');
+const answerArea = $('#answerSdp');
+const iceInput   = $('#iceInput');
+const iceLog     = $('#iceLog');
+
+let pc = null;
+let localStream = null;
+
+// ────────────────────────────────────────────────
+async function initPeerConnection() {
+  if (pc) pc.close();
+
+  pc = new RTCPeerConnection({
+    iceServers: [
+      { urls: "stun:stun.l.google.com:19302" },
+      { urls: "stun:stun.stunprotocol.org" }
+    ]
+  });
+
+  pc.onicecandidate = e => {
+    if (e.candidate) {
+      console.log("New ICE candidate:", e.candidate);
+      iceLog.innerHTML += "<div style='color:#c33'>→ " + e.candidate.candidate + "</div>";
+    }
+  };
+
+  pc.oniceconnectionstatechange = () => {
+    status.textContent = "ICE state: " + pc.iceConnectionState;
+  };
+
+  pc.ontrack = e => {
+    console.log("ontrack", e);
+    const remoteVideo = $('#remoteVideo');
+    remoteVideo.srcObject = e.streams[0];
+    status.textContent = "ICE state: " + pc.iceConnectionState + " (receiving media!)";
+  };
+
+  // Add local stream if we have camera/mic
+  if (localStream) {
+    localStream.getTracks().forEach(track => {
+      pc.addTrack(track, localStream);
+    });
+  }
+}
+
+// ────────────────────────────────────────────────
+async function startLocalCamera() {
+  try {
+    localStream = await navigator.mediaDevices.getUserMedia({
+      video: true,
+      audio: false    // change to true if you want audio too
+    });
+    $('#localVideo').srcObject = localStream;
+  } catch (err) {
+    console.error("Camera access failed", err);
+    status.textContent = "Camera access failed: " + err.message;
+  }
+}
+
+// ────────────────────────────────────────────────
+$('#btnCreateOffer').onclick = async () => {
+  await initPeerConnection();
+  await startLocalCamera();
+
+  const offer = await pc.createOffer();
+  await pc.setLocalDescription(offer);
+
+  offerArea.value = JSON.stringify(pc.localDescription, null, 2);
+  status.textContent = "Offer created – copy and send to peer B";
+};
+
+// ────────────────────────────────────────────────
+$('#btnCreateAnswer').onclick = async () => {
+  await initPeerConnection();
+  await startLocalCamera();
+
+  const offer = JSON.parse(offerArea.value);
+  await pc.setRemoteDescription(offer);
+
+  const answer = await pc.createAnswer();
+  await pc.setLocalDescription(answer);
+
+  answerArea.value = JSON.stringify(pc.localDescription, null, 2);
+  status.textContent = "Answer created – copy and send to peer A";
+};
+
+// ────────────────────────────────────────────────
+$('#btnSetRemoteOffer').onclick = async () => {
+  if (!pc) await initPeerConnection();
+
+  const remote = JSON.parse(offerArea.value);
+  await pc.setRemoteDescription(remote);
+  status.textContent = "Remote offer set";
+};
+
+// ────────────────────────────────────────────────
+$('#btnSetRemoteAnswer').onclick = async () => {
+  const remote = JSON.parse(answerArea.value);
+  await pc.setRemoteDescription(remote);
+  status.textContent = "Remote answer set – waiting for ICE/media";
+};
+
+// ────────────────────────────────────────────────
+$('#btnAddIce').onclick = async () => {
+  if (!iceInput.value.trim()) return;
+  try {
+    const candidate = new RTCIceCandidate(JSON.parse(iceInput.value));
+    await pc.addIceCandidate(candidate);
+    iceLog.innerHTML += "<div style='color:#3a3'>← added ICE candidate</div>";
+    iceInput.value = "";
+  } catch (err) {
+    console.error("Bad ICE candidate", err);
+  }
+};
+
+// Optional: auto-start camera when page loads
+// startLocalCamera();
+
+</script>
+</body>
+</html>

src/fd_httpd.erl

@@ -23,6 +23,12 @@ start_link() ->
 
 init([]) ->
     RestartStrategy = {one_for_one, 1, 60},
+    WebRTC    = {fd_httpd_webrtc,
+                 {fd_httpd_webrtc, start_link, []},
+                 permanent,
+                 5000,
+                 worker,
+                 [fd_httpd_webrtc]},
     FileCache = {fd_httpd_sfc,
                  {fd_httpd_sfc, start_link, []},
                  permanent,
@@ -35,5 +41,6 @@ init([]) ->
                  5000,
                  supervisor,
                  [fd_httpd_clients]},
-    Children  = [FileCache, Clients],
+    Children  = [WebRTC, FileCache, Clients],
+    %Children  = [FileCache, Clients],
     {ok, {RestartStrategy, Children}}.

src/fd_httpd_client.erl

@@ -135,8 +135,19 @@ loop(Parent, Debug, State = #s{socket = Socket, next = Next0}) ->
             Received = <<Next0/binary, Message/binary>>,
             case qhl:parse(Socket, Received) of
                 {ok, Req, Next1} ->
-                    Next2 = handle_request(Socket, Req, Next1),
-                    NewState = State#s{next = Next2},
+                    %% FIXME: unfuck received logic here
+                    %% handle_request should eventually call back into
+                    %% loop/3 or close the socket
+                    %%
+                    %% also loop/3 should be loop/1, because we need to pass
+                    %% the state down the callchains
+                    Next2 = unfuck_retarded_qhl_bullshit(Next1),
+                        case Next1 of
+                            none -> <<>>;
+                            Bin  -> Bin
+                        end,
+                    Next3 = handle_request(Socket, Req, Next2),
+                    NewState = State#s{next = Next3},
                     loop(Parent, Debug, NewState);
                 Error ->
                     %% should trigger bad request
@@ -233,6 +244,7 @@ handle_request(Sock, R = #request{method = M, path = P}, Received) when M =/= un
 route(Sock, get, Route, Request, Received) ->
     case Route of
          <<"/ws/echo">>   -> ws_echo(Sock, Request)                 , Received;
+         <<"/ws/webrtc">> -> ws_webrtc(Sock, Request, Received)     , Received;
          <<"/">>          -> route_static(Sock, <<"/index.html">>)  , Received;
          _                -> route_static(Sock, Route)              , Received
     end;
@@ -279,6 +291,107 @@ respond_static(Sock, not_found) ->
     fd_httpd_utils:http_err(Sock, 404).
 
 
+%% ------------------------------
+%% webrtc
+%% ------------------------------
+
+-record(rs,
+        {socket               :: gen_tcp:socket(),
+         received = <<>>      :: binary(),
+         username = undefined :: undefined | string()}).
+
+-type webrtc_state() :: #rs{}.
+
+ws_webrtc(Sock, Request, Received) ->
+    try
+        case qhl_ws:handshake(Request) of
+            {ok, Response} ->
+                fd_httpd_utils:respond(Sock, Response),
+                ws_webrtc_loop(#rs{socket = Sock, received = Received});
+            Error ->
+                tell("ws_webrtc: error: ~tp", [Error]),
+                fd_httpd_utils:http_err(Sock, 400)
+        end
+    catch
+        X:Y:Z ->
+            tell(error, "CRASH ws_webrtc: ~tp:~tp:~tp", [X, Y, Z]),
+            fd_httpd_utils:http_err(Sock, 500)
+    end.
+
+
+-define(WEBRTC_TIMEOUT, 30*qhl_ws:min()).
+
+
+
+-spec ws_webrtc_loop(webrtc_state()) -> no_return().
+
+%% first thing is to get username
+ws_webrtc_loop(State = #rs{socket   = Socket,
+                           received = Recv,
+                           username = undefined}) ->
+    {ok, ["username", Username], NewRecv} =
+        qhl_ws:recv_json(Socket, Recv, ?WEBRTC_TIMEOUT),
+    tell("~p ws_webrtc_loop: request username: ~p", [self(), Username]),
+    {ok, ActualUsername} = fd_httpd_webrtc:join(Username),
+    ok = qhl_ws:send_json(Socket, ["username", ActualUsername]),
+    NewState = State#rs{received = NewRecv,
+                        username = ActualUsername},
+    ws_webrtc_loop(NewState);
+% we have no tcp bytes waiting to be parsed
+ws_webrtc_loop(State = #rs{socket   = Socket,
+                           received = <<>>}) ->
+    ok = inet:setopts(Socket, [{active, once}]),
+    receive
+        {tcp, Socket, Message} ->
+            NewState = State#rs{received = Message},
+            ws_webrtc_loop(NewState);
+        {webrtc, Message} ->
+            NewState = ws_webrtc_handle_webrtc(Message, State),
+            ws_webrtc_loop(NewState);
+        {tcp_closed, Socket} ->
+            ok = tell("~p Socket closed, retiring.~n", [self()]),
+            exit(normal)
+    end;
+% we have TCP bytes sitting and waiting to be parsed
+ws_webrtc_loop(State = #rs{socket   = Socket,
+                           received = R}) ->
+    {ok, Message, NewR} = qhl_ws:recv_json(Socket, R, 5000),
+    NewState = ws_webrtc_handle_json(Message, State#rs{received = NewR}),
+    ws_webrtc_loop(NewState).
+
+
+
+-spec ws_webrtc_handle_webrtc(Message, State) -> NewState
+    when Message  :: any(),
+         State    :: webrtc_state(),
+         NewState :: webrtc_state().
+% @private handle a message from the server
+
+ws_webrtc_handle_webrtc(Message, State = #rs{socket = Sock}) ->
+    tell("~p received message from webrtc: ~p", [self(), Message]),
+    NewState =
+        case Message of
+            {users, Users} ->
+                ok = qhl_ws:send_json(Sock, ["users", Users]),
+                State;
+            _ ->
+                tell("~p unknown webrtc message: ~p", [self, Message])
+        end,
+    NewState.
+
+
+
+-spec ws_webrtc_handle_json(Message, State) -> NewState
+    when Message  :: zj:value(),
+         State    :: webrtc_state(),
+         NewState :: webrtc_state().
+% @private handle a message from the client
+
+ws_webrtc_handle_json(Message, State) ->
+    tell("~p received json message from client: ~p", [self(), Message]),
+    State.
+
+
 %% ------------------------------
 %% echo
 %% ------------------------------
@@ -348,7 +461,7 @@ wfcin(Sock, #request{enctype = json,
                 {fd_httpd_utils:jsbad(ErrorMessage), Ctx0}
         end,
     % update cache with new context
-    ok = fd_cache:set(Cookie, NewCtx),
+    ok = fd_wfcd_cache:set(Cookie, NewCtx),
     Body    = zj:encode(RespObj),
     Response = #response{headers = [{"content-type", "application/json"},
                                     {"set-cookie",   ["wfc=", Cookie]}],
@@ -366,17 +479,9 @@ wfcin(Sock, Request) ->
          Context :: wfc_eval_context:context().
 
 ctx(#{<<"wfc">> := Cookie}) ->
-    case fd_cache:query(Cookie) of
+    case fd_wfcd_cache:query(Cookie) of
         {ok, Context} -> {Cookie, Context};
         error         -> {Cookie, wfc_eval_context:default()}
     end;
 ctx(_) ->
     {fd_httpd_utils:new_cookie(), wfc_eval_context:default()}.
-
-
-
-
-
-
-
-

src/fd_httpd_webrtc.erl

@@ -0,0 +1,174 @@
+% @doc webrtc peer pool
+-module(fd_httpd_webrtc).
+
+-behavior(gen_server).
+
+%% api (caller context)
+-export([
+    join/1
+]).
+
+% startup/gen_server callbacks
+-export([
+    % caller context
+    start_link/0,
+    % process context
+    init/1, handle_call/3, handle_cast/2, handle_info/2,
+    code_change/3, terminate/2
+]).
+
+-include("$zx_include/zx_logger.hrl").
+
+
+-record(u,
+        {pid      :: pid(),
+         username :: string()}).
+
+-type user() :: #u{}.
+
+-record(s,
+        {users = [] :: [user()]}).
+
+-type state() :: #s{}.
+
+
+%%-----------------------------------------------------------------------------
+%% caller context
+%%-----------------------------------------------------------------------------
+
+
+start_link() ->
+    gen_server:start_link({local, ?MODULE}, ?MODULE, none, []).
+
+
+
+-spec join(Username :: string()) -> {ok, ActualUsername :: string()} | {error, any()}.
+
+join(Username) ->
+    gen_server:call(?MODULE, {join, Username}).
+
+
+
+%%-----------------------------------------------------------------------------
+%% process context
+%%-----------------------------------------------------------------------------
+
+%% gen_server callbacks
+
+init(none) ->
+    tell("starting fd_httpd_webrtc", []),
+    InitState = #s{},
+    {ok, InitState}.
+
+
+handle_call({join, Username}, _From = {PID, _Tag}, State) ->
+    {Reply, NewState} = do_join(Username, PID, State),
+    {reply, Reply, NewState};
+handle_call(Unexpected, From, State) ->
+    tell("~tp: unexpected call from ~tp: ~tp", [?MODULE, Unexpected, From]),
+    {noreply, State}.
+
+
+handle_cast(Unexpected, State) ->
+    tell("~tp: unexpected cast: ~tp", [?MODULE, Unexpected]),
+    {noreply, State}.
+
+
+handle_info({'DOWN', _Ref, process, PID, _Reason}, State) ->
+    NewState = do_down(PID, State),
+    {noreply, NewState};
+handle_info(Unexpected, State) ->
+    tell("~tp: unexpected info: ~tp", [?MODULE, Unexpected]),
+    {noreply, State}.
+
+
+code_change(_, State, _) ->
+    {ok, State}.
+
+terminate(_, _) ->
+    ok.
+
+
+%%---------------------
+%% doers
+%%---------------------
+
+-spec do_join(Username, PID, State) -> {Reply, NewState}
+    when Username :: string(),
+         PID      :: pid(),
+         State    :: state(),
+         Reply    :: {ok, ActualUsername :: string()}
+                   | {error, any()},
+         NewState :: state().
+% @private join a user to a pool
+
+do_join(Username, PID, State = #s{users = Users}) ->
+    % see if pid is already there
+    case lists:keymember(PID, #u.pid, Users) of
+        true -> {error, already_joined};
+        false -> do_join2(Username, PID, State)
+    end.
+
+do_join2(Username, PID, State = #s{users = Users}) ->
+    monitor(process, PID),
+    ActualUsername = unique_username(Username, Users),
+    NewUser = #u{pid = PID, username = ActualUsername},
+    NewRoster = usort([NewUser | Users]),
+    NewState  = State#s{users = NewRoster},
+    ok = gossip_roster(NewState),
+    {{ok, ActualUsername}, NewState}.
+
+usort(Users) ->
+    lists:keysort(#u.username, Users).
+
+unique_username(Username, Users) ->
+    tell("~p unique_username(~p, ~p)", [?MODULE, Username, Users]),
+    case lists:keymember(Username, #u.username, Users) of
+        true  -> unique_username(Username, 1, Users);
+        false -> Username
+    end.
+
+unique_username(Username, N, Users) ->
+    tell("~p unique_username(~p, ~p ~p)", [?MODULE, Username, N, Users]),
+    U = Username ++ integer_to_list(N),
+    case lists:keymember(U, #u.username, Users) of
+        true  -> unique_username(Username, N + 1, Users);
+        false -> U
+    end.
+
+
+
+-spec do_down(PID, State) -> NewState
+    when PID      :: pid(),
+         State    :: state(),
+         NewState :: state().
+% @private handle a user dying
+
+do_down(PID, State = #s{users = Users}) ->
+    % remove from users
+    NewUsers = usort(lists:keydelete(PID, #u.pid, Users)),
+    NewState = State#s{users = NewUsers},
+    % broadcast username
+    ok = gossip_roster(State),
+    NewState.
+
+
+
+-spec gossip_roster(state()) -> ok.
+% @private gossip the roster to everyone
+
+gossip_roster(State = #s{users = Users}) ->
+    Usernames = [Username || #u{username = Username} <- Users],
+    gossip({users, Usernames}, State).
+
+
+
+-spec gossip(any(), state()) -> ok.
+% @private gossip a message to everyone
+
+gossip(Message, #s{users = Users}) ->
+    GossipTo =
+        fun(#u{pid = PID}) ->
+            PID ! {webrtc, Message}
+        end,
+    lists:foreach(GossipTo, Users).

src/fd_sup.erl

@@ -36,17 +36,17 @@ start_link() ->
 
 init([]) ->
     RestartStrategy = {one_for_one, 1, 60},
-    Cache     = {fd_cache,
-                 {fd_cache, start_link, []},
+    WFCd      = {fd_wfcd,
+                 {fd_wfcd, start_link, []},
                  permanent,
                  5000,
-                 worker,
-                 [fd_cache]},
+                 supervisor,
+                 [fd_wfcd]},
     Httpd     = {fd_httpd,
                  {fd_httpd, start_link, []},
                  permanent,
                  5000,
                  supervisor,
                  [fd_httpd]},
-    Children  = [Cache, Httpd],
+    Children  = [WFCd, Httpd],
     {ok, {RestartStrategy, Children}}.

src/fd_wfcd.erl

@@ -0,0 +1,33 @@
+-module(fd_wfcd).
+-vsn("0.2.0").
+-behaviour(supervisor).
+-author("Peter Harpending <peterharpending@qpq.swiss>").
+-copyright("Peter Harpending <peterharpending@qpq.swiss>").
+-license("BSD-2-Clause-FreeBSD").
+
+-export([start_link/0]).
+-export([init/1]).
+
+
+-spec start_link() -> {ok, pid()}.
+%% @private
+%% This supervisor's own start function.
+
+start_link() ->
+  supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+
+-spec init([]) -> {ok, {supervisor:sup_flags(), [supervisor:child_spec()]}}.
+%% @private
+%% The OTP init/1 function.
+
+init([]) ->
+    RestartStrategy = {one_for_one, 1, 60},
+    Cache     = {fd_wfcd_cache,
+                 {fd_wfcd_cache, start_link, []},
+                 permanent,
+                 5000,
+                 worker,
+                 [fd_wfcd_cache]},
+    Children  = [Cache],
+    {ok, {RestartStrategy, Children}}.

src/fd_wfcd_cache.erl

@@ -1,5 +1,5 @@
 % @doc storing map #{cookie := Context}
--module(fd_cache).
+-module(fd_wfcd_cache).
 -vsn("0.2.0").
 
 -behavior(gen_server).

src/fd_wsp.erl

@@ -1,105 +0,0 @@
-% @doc Abstracts a web socket into a process
-%
-% hands the TCP socket over to this process, also this process does the
-% handshake.
-%
-% this process sends back `{ws, self(), Message: qhl_ws:ws_msg()}'
-%
-% for each websocket message it gets
--module(fd_wsp).
--vsn("0.2.0").
-
--behavior(gen_server).
-
--export_type([
-
-]).
-
--export([
-    %% caller context
-    %handshake/0,
-    start_link/3,
-
-    %% process context
-    init/1, handle_call/3, handle_cast/2, handle_info/2,
-    code_change/3, terminate/2
-]).
-
--include("http.hrl").
--include("$zx_include/zx_logger.hrl").
-
--record(s, {socket     :: gen_tcp:socket()}).
--type state() :: #s{}.
-
-
-%%-----------------------------------------------------------------------------
-%% caller context
-%%-----------------------------------------------------------------------------
-
-
--spec start_link(Socket, HandshakeReq, Received) -> Result
-    when Socket       :: gen_tcp:socket(),
-         HandshakeReq :: request(),
-         Received     :: binary(),
-         Result       :: {ok, pid()}
-                       | {error, term()}.
-% @doc
-% starts a websocket and hands control of socket over to child process
-
-start_link(Socket, HandshakeReq, Received) ->
-    case gen_server:start_link(?MODULE, [Socket, HandshakeReq, Received], []) of
-        {ok, PID} ->
-            gen_tcp:controlling_process(Socket, PID),
-            {ok, PID};
-        Error ->
-            Error
-    end.
-
-
-%%-----------------------------------------------------------------------------
-%% process context below this line
-%%-----------------------------------------------------------------------------
-
-%% gen_server callbacks
-
-init([Socket, HandshakeReq, Received]) ->
-    log("~p:~p init", [?MODULE, self()]),
-    case qhl_ws:handshake(HandshakeReq) of
-        {ok, Response} ->
-            ok = fd_http_utils:respond(Socket, Response),
-            InitState = #s{socket = Socket},
-            {ok, InitState};
-        Error ->
-            tell("~p:~p websocket handshake err: ~p", [?MODULE, self(), Error]),
-            fd_http_utils:http_err(Socket, 400),
-            Error
-    end.
-
-
-handle_call(Unexpected, From, State) ->
-    tell("~tp: unexpected call from ~tp: ~tp", [?MODULE, Unexpected, From]),
-    {noreply, State}.
-
-
-handle_cast(Unexpected, State) ->
-    tell("~tp: unexpected cast: ~tp", [?MODULE, Unexpected]),
-    {noreply, State}.
-
-
-handle_info({tcp, Sock, Bytes}, State = #s{socket = Sock}) ->
-    {noreply, State};
-handle_info(Unexpected, State) ->
-    tell("~tp: unexpected info: ~tp", [?MODULE, Unexpected]),
-    {noreply, State}.
-
-
-code_change(_, State, _) ->
-    {ok, State}.
-
-terminate(_, _) ->
-    ok.
-
-
-%%-----------------------------------------------------------------------------
-%% internals
-%%-----------------------------------------------------------------------------

src/qhl_ws.erl

@@ -16,7 +16,9 @@
     %% porcelain
     handshake/1,
     recv/3, recv/4,
-    send/2
+    recv_strict/3, recv_json/3,
+    send/2,
+    send_dwim/2, send_json/2
 ]).
 
 -include("http.hrl").
@@ -259,6 +261,54 @@ response_token(ChallengeToken) when is_binary(ChallengeToken) ->
     base64:encode(Sha1).
 
 
+-spec recv_json(Socket, Received, TimeoutMS) -> Result
+    when Socket    :: gen_tcp:socket(),
+         Received  :: binary(),
+         TimeoutMS :: non_neg_integer(),
+         Result    :: {ok, zj:value(), Remainder}
+                    | {error, Reason},
+         Remainder :: binary(),
+         Reason    :: any().
+% @doc
+% asserts response is text
+
+recv_json(Sock, Recv, TimeoutMS) ->
+    case recv_strict(Sock, Recv, TimeoutMS) of
+        {ok, {Type, Payload}, NewRecv} when Type =:= text orelse
+                                            Type =:= binary ->
+            case zj:decode(Payload) of
+                {ok, Value} ->
+                    io:format("~p value: ~p~n", [self(), Value]),
+                    {ok, Value, NewRecv};
+                Error       -> {error, {zj_decode, Error}}
+            end;
+        Error ->
+            Error
+    end.
+
+
+-spec recv_strict(Socket, Received, TimeoutMS) -> Result
+    when Socket    :: gen_tcp:socket(),
+         Received  :: binary(),
+         TimeoutMS :: non_neg_integer(),
+         Result    :: {ok, Message, Remainder}
+                    | {error, Reason},
+         Message   :: ws_msg(),
+         Remainder :: binary(),
+         Reason    :: any().
+% @doc
+% Almost equivalent to recv/3, but asserts resulting frames are empty
+
+recv_strict(Sock, Recv, TimeoutMS) ->
+    case recv(Sock, Recv, TimeoutMS) of
+        {ok, Message, [], Remainder} ->
+            {ok, Message, Remainder};
+        Illegal = {ok, _, _NonEmptyFrames, _} ->
+            {error, {bad_frame_stack, Illegal}};
+        Error ->
+            Error
+    end.
+
 
 -spec recv(Socket, Received, TimeoutMS) -> Result
     when Socket    :: gen_tcp:socket(),
@@ -604,10 +654,15 @@ recv_frame(Frame = #frame{payload_length = Len, payload = none}, Sock, Received,
 
 %% factoring this out into a function to reduce repetition
 recv_frame_await(Frame, Sock, Received, Timeout) ->
+    io:format("~p called: recv_frame_await(~p, ~p, ~p, ~p)~n",
+              [self(), Frame, Sock, Received, Timeout]),
     case inet:setopts(Sock, [{active, once}]) of
         ok ->
             receive
-                {tcp, Sock, Bin}          -> recv_frame(Frame, Sock, <<Received/bits, Bin/binary>>, Timeout);
+                {tcp, Sock, Bin}          ->
+                    io:format("~p calling: recv_frame(~p, ~p, ~p, ~p)~n",
+                        [self(),Frame, Sock, <<Received/bits, Bin/binary>>, Timeout]),
+                    recv_frame(Frame, Sock, <<Received/bits, Bin/binary>>, Timeout);
                 {tcp_closed, Sock}        -> {error, tcp_closed};
                 {tcp_error, Sock, Reason} -> {error, {tcp_error, Reason}}
             after Timeout ->
@@ -618,6 +673,34 @@ recv_frame_await(Frame, Sock, Received, Timeout) ->
     end.
 
 
+send_json(Socket, X) ->
+    send_dwim(Socket, {json, X}).
+
+
+-spec send_dwim(Socket, Message) -> Result
+    when Socket  :: gen_tcp:socket(),
+         Message :: string()
+                  | binary()
+                  | {json, zj:value()}
+                  | ws_msg(),
+         Result  :: ok
+                  | {error, Reason},
+         Reason  :: any().
+% @doc
+% equivalent to send/2 but assumes iolists/strings are meant to be `text`, and
+% naked binaries are meant to be `binary`
+%
+% lists are assumed to be unicode iolists and are converted to strings via
+% unicode:characters_to_list
+%
+% json is encoded as text and sent as such
+% @end
+
+send_dwim(Socket, X) when is_list(X)   -> send(Socket, {text, X});
+send_dwim(Socket, X) when is_binary(X) -> send(Socket, {binary, X});
+send_dwim(Socket, {json, X})           -> send(Socket, {text, zj:encode(X)});
+send_dwim(Socket, {Type, Payload})     -> send(Socket, {Type, Payload}).
+
 
 -spec send(Socket, Message) -> Result
     when Socket  :: gen_tcp:socket(),

src/zj.erl

@@ -1,694 +0,0 @@
-%%% @doc
-%%% ZJ: The tiny JSON parser
-%%%
-%%% This module exports four functions and accepts no options.
-%%% @end
-
--module(zj).
--vsn("0.2.0").
--author("Craig Everett <zxq9@zxq9.com>").
--copyright("Craig Everett <zxq9@zxq9.com>").
--license("MIT").
-
--export([encode/1,        decode/1,
-         binary_encode/1, binary_decode/1]).
-
--export_type([value/0, bin_value/0]).
-
--type value()     :: string()
-                   | number()
-                   | true
-                   | false
-                   | undefined
-                   | [value()]
-                   | #{string() := value()}.
-
-
--type bin_value() :: binary()
-                   | number()
-                   | true
-                   | false
-                   | undefined
-                   | [bin_value()]
-                   | #{binary() := bin_value()}.
-
-
-
-%%% Character constants
-
--define(BKSPC, 16#08).
--define(H_TAB, 16#09).
--define(NEW_L, 16#0A).
--define(FORMF, 16#0C).
--define(CAR_R, 16#0D).
--define(SPACE, 16#20).
-
-
-%%% Interface Functions
-
--spec encode(term()) -> string().
-
-%% @doc
-%% Take any convertable Erlang term and convert it to a JSON string.
-%%
-%% As JSON can only satirically be referred to as "a serialization format", it is
-%% almost impossible to map any interesting data between Erlang (or any other language)
-%% and JSON. For example, tuples do not exist in JSON, so converting an Erlang tuple
-%% turns it into a list (a JSON array). Atoms also do not exist, so atoms other than
-%% the ternay logic values `true', `false' and `null' become strings (those three
-%% remain as atoms, with the added detail that JSON `null' maps to Erlang
-%% `undefined').
-%%
-%% Unless care is taken to pick types that JSON can accurately express (integers,
-%% floats, strings, maps, lists, ternary logic atoms) it is not possible to guarantee
-%% (or even reasonable to expect) that `Term == decode(encode(Term))' will be true.
-%%
-%% This function crashes when it fails. Things that will cause a crash are trying to
-%% convert non-UTF-8 binaries to strings, use non-string values as object keys,
-%% encode an unaligned bitstring, etc.
-%%
-%% Note that Erlang terms are converted as type primitives, meaning that compound
-%% functional structures like GB-trees, dicts, sets, etc. will wind up having their
-%% underlying structures converted as-is which is almost never what you want. It is
-%% usually best to reduce compound values down to primitives (lists or maps) before
-%% running encode.
-%%
-%% The only unsupported Erlang pritmitive is bitstrings. Care has NOT been taken to
-%% ensure separation between actual binary data and binaries that are supposed to be
-%% interpreted as strings. The same is true of deep list data: it just comes out raw
-%% unless you flatten or convert it to a utf8 string with the unicode module.
-%%
-%% NOTE: If you need a serialization format that is less ambiguous and expresses more
-%% types consider using BERT (language-independent implementations of Erlang external
-%% binary format) instead: http://bert-rpc.org
-
-encode(true)                   -> "true";
-encode(false)                  -> "false";
-encode(undefined)              -> "null";
-encode([])                     -> "[]";
-encode(T) when is_atom(T)      -> quote(atom_to_list(T));
-encode(T) when is_float(T)     -> float_to_list(T);
-encode(T) when is_integer(T)   -> integer_to_list(T);
-encode(T) when is_pid(T)       -> quote(pid_to_list(T));
-encode(T) when is_port(T)      -> quote(port_to_list(T));
-encode(T) when is_function(T)  -> quote(erlang:fun_to_list(T));
-encode(T) when is_reference(T) -> quote(ref_to_list(T));
-encode(T)                      -> unicode:characters_to_list(encode_value(T)).
-
-
--spec decode(Stream) -> Result
-    when Stream    :: unicode:chardata(),
-         Result    :: {ok, value()}
-                    | {error, Parsed, Remainder}
-                    | {incomplete, Parsed, Remainder},
-         Parsed    :: value(),
-         Remainder :: unicode:chardata()
-                    | unicode:external_chardata()
-                    | binary().
-%% @doc
-%% Take any IO data acceptable to the unicode module and return a parsed data structure.
-%% In the event of a parsing error whatever part of the structure could be successfully
-%% parsed will be returned along with the remainder of the string. Note that the string
-%% remainder may have been changed to a different form by unicode:characters_to_list/1.
-%% If the unicode library itself runs into a problem performing the initial conversion
-%% its error return (`error' or `incomplete') will be returned directly.
-
-decode(Stream) ->
-    case unicode:characters_to_list(Stream) of
-        E when is_tuple(E) -> E;
-        [16#FEFF | String] -> parse(seek(String));
-        String             -> parse(seek(String))
-    end.
-
-
--spec binary_encode(term()) -> binary().
-%% @doc
-%% A strict encoding routine that works very similarly to `encode/1' but with a few
-%% differences:
-%% ```
-%%  - Lists and Strings are firmly separated:
-%%     ALL lists are lists of discrete values, never strings.
-%%     ALL binaries are always UTF-8 strings.
-%%     An Erlang string or io_list will be encoded as JSON array.
-%%  - This function generates a UTF-8 binary, not a list.
-%%  - The burden is on the user to ensure that io_lists are collapsed to unicode
-%%    binaries via `unicode:characters_to_binary/1' before passing in string values.
-%%  - Erlang strings (lists) are still accepted as map/object keys.
-%% '''
-%%
-%% NOTE:
-%% Most cases are better served by `encode/1', as most code deals in strings and not
-%% arrays of integer values.
-%%
-%% Using this function requires a little bit more work up front (because ununified
-%% io_list() data will always be interpreted as a JSON array), but provides a way to
-%% reliably generate lists or strings in an unambiguous way in the special case where
-%% your code is generating both strings and lists of integer values that may overlap
-%% with valid UTF-8 codepoint values.
-
-binary_encode(true)                   -> <<"true">>;
-binary_encode(false)                  -> <<"false">>;
-binary_encode(undefined)              -> <<"null">>;
-binary_encode(T) when is_atom(T)      -> <<"\"", (atom_to_binary(T, utf8))/binary, "\"">>;
-binary_encode(T) when is_float(T)     -> float_to_binary(T);
-binary_encode(T) when is_integer(T)   -> integer_to_binary(T);
-binary_encode(T) when is_pid(T)       -> <<"\"", (list_to_binary(pid_to_list(T)))/binary, "\"">>;
-binary_encode(T) when is_port(T)      -> <<"\"", (list_to_binary(port_to_list(T)))/binary, "\"">>;
-binary_encode(T) when is_function(T)  -> <<"\"", (list_to_binary(erlang:fun_to_list(T)))/binary, "\"">>;
-binary_encode(T) when is_reference(T) -> <<"\"", (list_to_binary(ref_to_list(T)))/binary, "\"">>;
-binary_encode(T)                      -> unicode:characters_to_binary(b_encode_value(T)).
-
-
--spec binary_decode(Stream) -> Result
-    when Stream    :: unicode:chardata(),
-         Result    :: {ok, bin_value()}
-                    | {error, Parsed, Remainder}
-                    | {incomplete, Parsed, Remainder},
-         Parsed    :: bin_value(),
-         Remainder :: binary().
-%% @doc
-%% Almost identical in behavior to `decode/1' except this returns strings as binaries
-%% and arrays of integers as Erlang lists (which may also be valid strings if the
-%% values are valid UTF-8 codepoints).
-%%
-%% NOTE:
-%% This function returns map keys as binaries
-
-binary_decode(Stream) ->
-    case b_decode(Stream) of
-        {error, Part, Rest} -> {error, Part, unicode:characters_to_binary(Rest)};
-        Result              -> Result
-    end.
-
-
-
-%%% Encoding Functions
-
-encode_value(true)                   -> "true";
-encode_value(false)                  -> "false";
-encode_value(undefined)              -> "null";
-encode_value(T) when is_atom(T)      -> quote(atom_to_list(T));
-encode_value(T) when is_float(T)     -> float_to_list(T);
-encode_value(T) when is_integer(T)   -> integer_to_list(T);
-encode_value(T) when is_binary(T)    -> maybe_string(T);
-encode_value(T) when is_list(T)      -> maybe_array(T);
-encode_value(T) when is_map(T)       -> pack_object(T);
-encode_value(T) when is_tuple(T)     -> pack_array(tuple_to_list(T));
-encode_value(T) when is_pid(T)       -> quote(pid_to_list(T));
-encode_value(T) when is_port(T)      -> quote(port_to_list(T));
-encode_value(T) when is_function(T)  -> quote(erlang:fun_to_list(T));
-encode_value(T) when is_reference(T) -> quote(ref_to_list(T)).
-
-
-maybe_string(T) ->
-    L = binary_to_list(T),
-    true = io_lib:printable_unicode_list(L),
-    quote(L).
-
-
-maybe_array(T) ->
-    case io_lib:printable_unicode_list(T) of
-        true  -> quote(T);
-        false -> pack_array(T)
-    end.
-
-
-quote(T) -> [$" | escape(T)].
-
-escape([])        -> [$"];
-escape([$\b | T]) -> [$\\, $b  | escape(T)];
-escape([$\f | T]) -> [$\\, $f  | escape(T)];
-escape([$\n | T]) -> [$\\, $n  | escape(T)];
-escape([$\r | T]) -> [$\\, $r  | escape(T)];
-escape([$\t | T]) -> [$\\, $t  | escape(T)];
-escape([$\" | T]) -> [$\\, $"  | escape(T)];
-escape([$\\ | T]) -> [$\\, $\\ | escape(T)];
-escape([H | T])   -> [H | escape(T)].
-
-
-pack_array([])        -> "[]";
-pack_array([H | []])  -> [$[, encode_value(H), $]];
-pack_array([H | T])   -> [$[, encode_value(H), $,, encode_array(T), $]].
-
-encode_array([H | []]) -> encode_value(H);
-encode_array([H | T])  -> [encode_value(H), $,, encode_array(T)].
-
-
-pack_object(M) ->
-    case maps:to_list(M) of
-        [] ->
-            "{}";
-        [{K, V} | T] when is_list(K) ->
-            true = io_lib:printable_unicode_list(K),
-            Init = [$", K, $", $:, encode_value(V)],
-            [${, lists:foldl(fun pack_object/2, Init, T), $}];
-        [{K, V} | T] when is_binary(K) ->
-            Key = unicode:characters_to_list(K),
-            true = io_lib:printable_unicode_list(Key),
-            Init = [$", Key, $", $:, encode_value(V)],
-            [${, lists:foldl(fun pack_object/2, Init, T), $}];
-        [{K, V} | T] when is_float(K) ->
-            Key = float_to_list(K),
-            Init = [$", Key, $", $:, encode_value(V)],
-            [${, lists:foldl(fun pack_object/2, Init, T), $}];
-        [{K, V} | T] when is_integer(K) ->
-            Key = integer_to_list(K),
-            Init = [$", Key, $", $:, encode_value(V)],
-            [${, lists:foldl(fun pack_object/2, Init, T), $}];
-        [{K, V} | T] when is_atom(K) ->
-            Init = [$", atom_to_list(K), $", $:, encode_value(V)],
-            [${, lists:foldl(fun pack_object/2, Init, T), $}]
-    end.
-
-pack_object({K, V}, L) when is_list(K) ->
-    true = io_lib:printable_unicode_list(K),
-    [$", K, $", $:, encode_value(V), $, | L];
-pack_object({K, V}, L) when is_binary(K) ->
-    Key = unicode:characters_to_list(K),
-    true = io_lib:printable_unicode_list(Key),
-    [$", Key, $", $:, encode_value(V), $, | L];
-pack_object({K, V}, L) when is_float(K) ->
-    Key = float_to_list(K),
-    [$", Key, $", $:, encode_value(V), $, | L];
-pack_object({K, V}, L) when is_integer(K) ->
-    Key = integer_to_list(K),
-    [$", Key, $", $:, encode_value(V), $, | L];
-pack_object({K, V}, L) when is_atom(K) ->
-    [$", atom_to_list(K), $", $:, encode_value(V), $, | L].
-
-
-b_encode_value(true)                   -> <<"true">>;
-b_encode_value(false)                  -> <<"false">>;
-b_encode_value(undefined)              -> <<"null">>;
-b_encode_value(T) when is_atom(T)      -> [$", atom_to_binary(T, utf8), $"];
-b_encode_value(T) when is_float(T)     -> float_to_binary(T);
-b_encode_value(T) when is_integer(T)   -> integer_to_binary(T);
-b_encode_value(T) when is_binary(T)    -> [$", b_maybe_string(T), $"];
-b_encode_value(T) when is_list(T)      -> b_pack_array(T);
-b_encode_value(T) when is_map(T)       -> b_pack_object(T);
-b_encode_value(T) when is_tuple(T)     -> b_pack_array(tuple_to_list(T));
-b_encode_value(T) when is_pid(T)       -> [$", list_to_binary(pid_to_list(T)), $"];
-b_encode_value(T) when is_port(T)      -> [$", list_to_binary(port_to_list(T)), $"];
-b_encode_value(T) when is_function(T)  -> [$", list_to_binary(erlang:fun_to_list(T)), $"];
-b_encode_value(T) when is_reference(T) -> [$", list_to_binary(ref_to_list(T)), $"].
-
-
-b_maybe_string(T) ->
-    S = unicode:characters_to_binary(T),
-    true = is_binary(S),
-    S.
-
-
-b_pack_array([])       -> "[]";
-b_pack_array([H | []]) -> [$[, b_encode_value(H), $]];
-b_pack_array([H | T])  -> [$[, b_encode_value(H), $,, b_encode_array(T), $]].
-
-b_encode_array([H | []]) -> b_encode_value(H);
-b_encode_array([H | T])  -> [b_encode_value(H), $,, b_encode_array(T)].
-
-
-b_pack_object(M) ->
-    case maps:to_list(M) of
-        [] ->
-            "{}";
-        [{K, V} | T] when is_list(K) ->
-            true = io_lib:printable_unicode_list(K),
-            Init = [$", K, $", $:, b_encode_value(V)],
-            [${, lists:foldl(fun b_pack_object/2, Init, T), $}];
-        [{K, V} | T] when is_binary(K) ->
-            true = io_lib:printable_unicode_list(unicode:characters_to_list(K)),
-            Init = [$", K, $", $:, b_encode_value(V)],
-            [${, lists:foldl(fun b_pack_object/2, Init, T), $}];
-        [{K, V} | T] when is_float(K) ->
-            Key = float_to_list(K),
-            Init = [$", Key, $", $:, b_encode_value(V)],
-            [${, lists:foldl(fun b_pack_object/2, Init, T), $}];
-        [{K, V} | T] when is_integer(K) ->
-            Key = integer_to_list(K),
-            Init = [$", Key, $", $:, b_encode_value(V)],
-            [${, lists:foldl(fun b_pack_object/2, Init, T), $}];
-        [{K, V} | T] when is_atom(K) ->
-            Init = [$", atom_to_binary(K, utf8), $", $:, b_encode_value(V)],
-            [${, lists:foldl(fun b_pack_object/2, Init, T), $}]
-    end.
-
-b_pack_object({K, V}, L) when is_list(K) ->
-    true = io_lib:printable_unicode_list(K),
-    [$", K, $", $:, b_encode_value(V), $, | L];
-b_pack_object({K, V}, L) when is_binary(K) ->
-    true = io_lib:printable_unicode_list(unicode:characters_to_list(K)),
-    [$", K, $", $:, b_encode_value(V), $, | L];
-b_pack_object({K, V}, L) when is_float(K) ->
-    Key = float_to_list(K),
-    [$", Key, $", $:, b_encode_value(V), $, | L];
-b_pack_object({K, V}, L) when is_integer(K) ->
-    Key = integer_to_list(K),
-    [$", Key, $", $:, b_encode_value(V), $, | L];
-b_pack_object({K, V}, L) when is_atom(K) ->
-    [$", atom_to_list(K), $", $:, b_encode_value(V), $, | L].
-
-
-%%% Decode Functions
-
--spec parse(Stream) -> Result
-    when Stream    :: string(),
-         Result    :: {ok, value()}
-                    | {error, Extracted :: value(), Remaining :: string()}.
-%% @private
-%% The top-level dispatcher. This packages the top level value (or top-level error)
-%% for return to the caller. A very similar function (value/1) is used for inner
-%% values.
-
-parse([${ | Rest]) ->
-    case object(Rest) of
-        {ok, Object, ""}   -> {ok, Object};
-        {ok, Object, More} -> polish(Object, seek(More));
-        Error              -> Error
-    end;
-parse([$[ | Rest]) ->
-    case array(Rest) of
-        {ok, Array, ""}   -> {ok, Array};
-        {ok, Array, More} -> polish(Array, seek(More));
-        Error             -> Error
-    end;
-parse([$" | Rest]) ->
-    case string(Rest) of
-        {ok, String, ""}   -> {ok, String};
-        {ok, String, More} -> polish(String, seek(More));
-        Error              -> Error
-    end;
-parse([I | Rest]) when I == $-; $0 =< I, I =< $9 ->
-    case number_int(Rest, [I]) of
-        {ok, Number, ""}   -> {ok, Number};
-        {ok, Number, More} -> polish(Number, seek(More));
-        Error              -> Error
-    end;
-parse("true" ++ More) ->
-    polish(true, seek(More));
-parse("false" ++ More) ->
-    polish(false, seek(More));
-parse("null" ++ More) ->
-    polish(undefined, seek(More));
-parse(Other) ->
-    {error, [], Other}.
-
-
-polish(Value, "")   -> {ok, Value};
-polish(Value, More) -> {error, Value, More}.
-
-
-value([${ | Rest])                               -> object(Rest);
-value([$[ | Rest])                               -> array(Rest);
-value([$" | Rest])                               -> string(Rest);
-value([I | Rest]) when I == $-; $0 =< I, I =< $9 -> number_int(Rest, [I]);
-value("true" ++ Rest)                            -> {ok, true, Rest};
-value("false" ++ Rest)                           -> {ok, false, Rest};
-value("null" ++  Rest)                           -> {ok, undefined, Rest};
-value(_)                                         -> error.
-
-
-object([$} | Rest]) -> {ok, #{}, Rest};
-object(String)      -> object(seek(String), #{}).
-
-object([$} | Rest], Map) ->
-    {ok, Map, Rest};
-object([$" | Rest], Map) ->
-    case string(Rest) of
-        {ok, Key, Remainder} -> object_value(seek(Remainder), Key, Map);
-        {error, _, _}        -> {error, Map, Rest}
-    end;
-object(Rest, Map) ->
-    {error, Map, Rest}.
-
-object_value([$: | Rest], Key, Map) ->
-    object_value_parse(seek(Rest), Key, Map);
-object_value(Rest, Key, Map) ->
-    {error, maps:put(Key, undefined, Map), Rest}.
-
-object_value_parse(String, Key, Map) ->
-    case value(String) of
-        {ok, Value, Rest}    -> object_next(seek(Rest), maps:put(Key, Value, Map));
-        {error, Value, Rest} -> {error, maps:put(Key, Value, Map), Rest};
-        error                -> {error, Map, String}
-    end.
-
-
-object_next([$, | Rest], Map) -> object(seek(Rest), Map);
-object_next([$} | Rest], Map) -> {ok, Map, seek(Rest)};
-object_next(Rest, Map)        -> {error, Map, Rest}.
-
-
-array([$] | Rest]) -> {ok, [], Rest};
-array(String)      -> array(seek(String), []).
-
-array([$] | Rest], List) ->
-    {ok, lists:reverse(List), seek(Rest)};
-array(String, List) ->
-    case value(String) of
-        {ok, Value, Rest}    -> array_next(seek(Rest), [Value | List]);
-        {error, Value, Rest} -> {error, lists:reverse([Value | List]), Rest};
-        error                -> {error, lists:reverse(List), String}
-    end.
-
-array_next([$, | Rest], List) -> array(seek(Rest), List);
-array_next([$] | Rest], List) -> {ok, lists:reverse(List), seek(Rest)};
-array_next(Rest, List)        -> {error, lists:reverse(List), Rest}.
-
-
-string(Stream) -> string(Stream, "").
-
-string([$" | Rest], String) ->
-    {ok, lists:reverse(String), Rest};
-string([$\\, $" | Rest], String) ->
-    string(Rest, [$" | String]);
-string([$\\, $\\ | Rest], String) ->
-    string(Rest, [$\\ | String]);
-string([$\\, $b | Rest], String) ->
-    string(Rest, [?BKSPC | String]);
-string([$\\, $t | Rest], String) ->
-    string(Rest, [?H_TAB | String]);
-string([$\\, $n | Rest], String) ->
-    string(Rest, [?NEW_L | String]);
-string([$\\, $f | Rest], String) ->
-    string(Rest, [?FORMF | String]);
-string([$\\, $r | Rest], String) ->
-    string(Rest, [?CAR_R | String]);
-string([$\\, $u, A, B, C, D | Rest], String)
-    when (($0 =< A andalso A =< $9) or ($A =< A andalso A =< $F) or ($a =< A andalso A =< $f))
-     and (($0 =< B andalso B =< $9) or ($A =< B andalso B =< $F) or ($a =< B andalso B =< $f))
-     and (($0 =< C andalso C =< $9) or ($A =< C andalso C =< $F) or ($a =< C andalso C =< $f))
-     and (($0 =< D andalso D =< $9) or ($A =< D andalso D =< $F) or ($a =< D andalso D =< $f)) ->
-    Char = list_to_integer([A, B, C, D], 16),
-    string(Rest, [Char | String]);
-string(Stream = [$\\, $u | _], String) ->
-    {error, String, Stream};
-string([$\\, Char | Rest], String)
-        when Char == 16#20;
-             Char == 16#21;
-             16#23 =< Char, Char =< 16#5B;
-             16#5D =< Char, Char =< 16#10FFFF ->
-    string(Rest, [$\\, Char | String]);
-string([Char | Rest], String)
-        when Char == 16#20;
-             Char == 16#21;
-             16#23 =< Char, Char =< 16#5B;
-             16#5D =< Char, Char =< 16#10FFFF ->
-    string(Rest, [Char | String]);
-string(Rest, String) ->
-    {error, lists:reverse(String), Rest}.
-
-
-number_int([$. | Rest], String) ->
-    number_float(Rest, [$. | String]);
-number_int([$e, Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_float_exp(Rest, [Char, $+, $e, $0, $. | String]);
-number_int([$E, Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_float_exp(Rest, [Char, $+, $e, $0, $. | String]);
-number_int([$e, $+, Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_float_exp(Rest, [Char, $+, $e, $0, $. | String]);
-number_int([$E, $+, Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_float_exp(Rest, [Char, $+, $e, $0, $. | String]);
-number_int([$e, $-, Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_float_exp(Rest, [Char, $-, $e, $0, $. | String]);
-number_int([$E, $-, Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_float_exp(Rest, [Char, $-, $e, $0, $. | String]);
-number_int([Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_int(Rest, [Char | String]);
-number_int(Rest, "-") ->
-    {error, "", [$- | Rest]};
-number_int(Rest, String) ->
-    {ok, list_to_integer(lists:reverse(String)), seek(Rest)}.
-
-number_float([Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_float(Rest, [Char | String]);
-number_float([$E, Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_float_exp(Rest, [Char, $+, $e | String]);
-number_float([$e, Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_float_exp(Rest, [Char, $+, $e | String]);
-number_float([$E, $+, Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_float_exp(Rest, [Char, $+, $e | String]);
-number_float([$e, $+, Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_float_exp(Rest, [Char, $+, $e | String]);
-number_float([$E, $-, Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_float_exp(Rest, [Char, $-, $e | String]);
-number_float([$e, $-, Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_float_exp(Rest, [Char, $-, $e | String]);
-number_float(Rest, String) ->
-    Target = lists:reverse(String),
-    try
-        Number = list_to_float(Target),
-        {ok, Number, seek(Rest)}
-    catch
-        error:badarg -> {error, "", Target ++ Rest}
-    end.
-
-
-number_float_exp([Char | Rest], String) when $0 =< Char, Char =< $9 ->
-    number_float_exp(Rest, [Char | String]);
-number_float_exp(Rest, String) ->
-    Target = lists:reverse(String),
-    try
-        Number = list_to_float(Target),
-        {ok, Number, seek(Rest)}
-    catch
-        error:badarg -> {error, "", Target ++ Rest}
-    end.
-
-
-seek([?H_TAB | Rest]) -> seek(Rest);
-seek([?NEW_L | Rest]) -> seek(Rest);
-seek([?CAR_R | Rest]) -> seek(Rest);
-seek([?SPACE | Rest]) -> seek(Rest);
-seek(String)          -> String.
-
-
-b_decode(Stream) ->
-    case unicode:characters_to_list(Stream) of
-        E when is_tuple(E) -> E;
-        [16#FEFF | String] -> binary_parse(seek(String));
-        String             -> binary_parse(seek(String))
-    end.
-
--spec binary_parse(Stream) -> Result
-    when Stream    :: string(),
-         Result    :: {ok, bin_value()}
-                    | {error, Extracted :: bin_value(), Remaining :: binary()}.
-%% @private
-%% The top-level dispatcher. This packages the top level value (or top-level error)
-%% for return to the caller. A very similar function (b_value/1) is used for inner
-%% values.
-
-binary_parse([${ | Rest]) ->
-    case b_object(Rest) of
-        {ok, Object, ""}   -> {ok, Object};
-        {ok, Object, More} -> b_polish(Object, seek(More));
-        Error              -> Error
-    end;
-binary_parse([$[ | Rest]) ->
-    case b_array(Rest) of
-        {ok, Array, ""}   -> {ok, Array};
-        {ok, Array, More} -> b_polish(Array, seek(More));
-        Error             -> Error
-    end;
-binary_parse([$" | Rest]) ->
-    case string(Rest) of
-        {ok, String, ""} ->
-            case unicode:characters_to_binary(String) of
-                E when is_tuple(E) -> E;
-                Result             -> {ok, Result}
-            end;
-        {ok, String, More} ->
-            case unicode:characters_to_binary(String) of
-                E when is_tuple(E) -> E;
-                Result             -> b_polish(Result, seek(More))
-            end;
-        Error ->
-            Error
-    end;
-binary_parse([I | Rest]) when I == $-; $0 =< I, I =< $9 ->
-    case number_int(Rest, [I]) of
-        {ok, Number, ""}   -> {ok, Number};
-        {ok, Number, More} -> b_polish(Number, seek(More));
-        Error              -> Error
-    end;
-binary_parse("true" ++ More) ->
-    b_polish(true, seek(More));
-binary_parse("false" ++ More) ->
-    b_polish(false, seek(More));
-binary_parse("null" ++ More) ->
-    b_polish(undefined, seek(More));
-binary_parse(Other) ->
-    {error, [], Other}.
-
-
-b_polish(Value, "")   -> {ok, Value};
-b_polish(Value, More) -> {error, Value, More}.
-
-
-b_value([${ | Rest])                               -> b_object(Rest);
-b_value([$[ | Rest])                               -> b_array(Rest);
-b_value([$" | Rest])                               -> b_string(Rest);
-b_value([I | Rest]) when I == $-; $0 =< I, I =< $9 -> number_int(Rest, [I]);
-b_value("true" ++ Rest)                            -> {ok, true, Rest};
-b_value("false" ++ Rest)                           -> {ok, false, Rest};
-b_value("null" ++  Rest)                           -> {ok, undefined, Rest};
-b_value(_)                                         -> error.
-
-
-b_string(Stream) ->
-    case string(Stream) of
-        {ok, String, More} ->
-            case unicode:characters_to_binary(String) of
-                E when is_tuple(E) -> E;
-                Result             -> {ok, Result, More}
-            end;
-        Error  -> Error
-    end.
-
-
-b_object([$} | Rest]) -> {ok, #{}, Rest};
-b_object(String)      -> b_object(seek(String), #{}).
-
-b_object([$} | Rest], Map) ->
-    {ok, Map, Rest};
-b_object([$" | Rest], Map) ->
-    case string(Rest) of
-        {ok, Key, Remainder} ->
-            b_object_value(seek(Remainder), unicode:characters_to_binary(Key), Map);
-        {error, _, _} ->
-            {error, Map, Rest}
-    end;
-b_object(Rest, Map) ->
-    {error, Map, Rest}.
-
-b_object_value([$: | Rest], Key, Map) -> b_object_value_parse(seek(Rest), Key, Map);
-b_object_value(Rest, Key, Map)        -> {error, maps:put(Key, undefined, Map), Rest}.
-
-b_object_value_parse(String, Key, Map) ->
-    case b_value(String) of
-        {ok, Value, Rest}    -> b_object_next(seek(Rest), maps:put(Key, Value, Map));
-        {error, Value, Rest} -> {error, maps:put(Key, Value, Map), Rest};
-        error                -> {error, Map, String}
-    end.
-
-
-b_object_next([$, | Rest], Map) -> b_object(seek(Rest), Map);
-b_object_next([$} | Rest], Map) -> {ok, Map, seek(Rest)};
-b_object_next(Rest, Map)        -> {error, Map, Rest}.
-
-
-b_array([$] | Rest]) -> {ok, [], Rest};
-b_array(String)      -> b_array(seek(String), []).
-
-b_array([$] | Rest], List) ->
-    {ok, lists:reverse(List), seek(Rest)};
-b_array(String, List) ->
-    case b_value(String) of
-        {ok, Value, Rest}    -> b_array_next(seek(Rest), [Value | List]);
-        {error, Value, Rest} -> {error, lists:reverse([Value | List]), Rest};
-        error                -> {error, lists:reverse(List), String}
-    end.
-
-b_array_next([$, | Rest], List) -> b_array(seek(Rest), List);
-b_array_next([$] | Rest], List) -> {ok, lists:reverse(List), seek(Rest)};
-b_array_next(Rest, List)        -> {error, lists:reverse(List), Rest}.

zomp.meta

@@ -5,7 +5,7 @@
 {prefix,"fd"}.
 {desc,"Front End Web Dev in Erlang stuff"}.
 {package_id,{"otpr","fewd",{0,2,0}}}.
-{deps,[]}.
+{deps,[{"otpr","zj",{1,1,2}}]}.
 {key_name,none}.
 {a_email,"peterharpending@qpq.swiss"}.
 {c_email,"peterharpending@qpq.swiss"}.