pharpend/fewd
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Compare commits

base: pharpend/fewd:master
Branches Tags
pharpend/fewd:master pharpend/fewd:f-qrdemo pharpend/fewd:f-webrtc pharpend/fewd:develop pharpend/fewd:staging
pharpend/fewd:0.1.0
..
compare: pharpend/fewd:ad5df4f550c401816bed2b20e5feb3f0b77c7666
Branches Tags
pharpend/fewd:f-qrdemo pharpend/fewd:f-webrtc pharpend/fewd:develop pharpend/fewd:staging pharpend/fewd:master
pharpend/fewd:0.1.0

14 Commits
master .. ad5df4f550

Author SHA1 Message Date
pharpend ad5df4f550 merging 2026-02-12 17:57:29 -08:00
pharpend b871968f8c roster kind of sort of works 2026-02-09 21:11:53 -08:00
pharpend 6028bb5850 roster is broadcast 2026-02-09 20:48:43 -08:00
pharpend 25a775ee96 webrtc frontend can request username from backend 2026-02-09 16:24:33 -08:00
Peter Harpending b6436c84ee wip 2026-02-09 14:48:47 -08:00
pharpend cc95fc5829 webrtc 2026-02-09 12:54:45 -08:00
pharpend ce7b8a1ccd add webrtc grok demo 2026-02-04 21:59:37 -08:00
pharpend 8d5320e4e5 [works] cleanups, wfc service architecture 
- 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
 2025-12-17 16:39:00 -08:00
pharpend 57e7254f8d wip: updating version 2025-12-16 22:18:51 -08:00
pharpend e379a86020 remove references and links to broken features 2025-12-16 22:11:27 -08:00
pharpend e160701403 runs 2025-12-16 22:09:10 -08:00
pharpend cbfc496057 renaming/deleting 
:wq
 2025-12-12 23:21:00 -08:00
pharpend ff257ae976 wip: renaming 2025-11-19 10:57:23 -08:00
pharpend e12466d5f2 start renaming 2025-10-31 12:33:11 -07:00
46 changed files with 818 additions and 1663 deletions
Expand all files Collapse all files
NOTES.txt
+7
View File
@@ -1,3 +1,10 @@
OPEN LOOPS - 2025-11-12
- websockets
- separate websocket handling from websocket parsing/sending
- do renaming
- make wfc not terrible
VIDEO 1 - 2025-09-16
TODONE
- add qhl as dep
ebin/fewd.app
+8 -3
View File
@@ -3,7 +3,12 @@
{registered,[]},
{included_applications,[]},
{applications,[stdlib,kernel]},
{vsn,"0.1.0"},
{modules,[fd_client,fd_client_man,fd_client_sup,fd_clients,
fd_sup,fewd]},
{vsn,"0.2.0"},
{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_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/chat.html
-106
View File
@@ -1,106 +0,0 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>Chat with Websockets</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">Chat with websockets</h1>
<div class="content-body">
<input autofocus label="Nick" id="nick"></input>
<textarea hidden disabled id="wfc-output"></textarea>
<input hidden id="wfc-input"></input>
</div>
</div>
<script>
let nelt = document.getElementById('nick');
let ielt = document.getElementById('wfc-input');
let oelt = document.getElementById('wfc-output');
let ws = new WebSocket("/ws/chat");
let nick = '';
// when user hits any key while typing in nick
function on_nick(evt) {
if (evt.key === 'Enter') {
// don't do default thing
evt.preventDefault();
// grab contents
let contents = nelt.value;
let trimmed = contents.trim();
// if contents are nonempty
let nonempty_contents = trimmed.length > 0;
if (nonempty_contents) {
nick = trimmed;
let msg_obj = ['nick', nick];
let msg_str = JSON.stringify(msg_obj);
console.log('message to server:', contents.trim());
// query backend for result
ws.send(msg_str);
// delete element from dom
nelt.remove();
oelt.hidden = false;
ielt.hidden = false;
ielt.autofocus = true;
}
}
}
// when user hits any key while typing in ielt
function on_input_key(evt) {
if (evt.key === 'Enter') {
// don't do default thing
evt.preventDefault();
// grab contents
let contents = ielt.value;
let trimmed = contents.trim();
// if contents are nonempty
let nonempty_contents = trimmed.length > 0;
if (nonempty_contents) {
let msg_obj = ['chat', trimmed];
let msg_str = JSON.stringify(msg_obj);
console.log('message to server:', contents.trim());
// query backend for result
ws.send(msg_str);
// clear input
ielt.value = '';
// add to output
oelt.value += '> ';
oelt.value += trimmed;
oelt.value += '\n';
}
}
}
function main() {
nelt.addEventListener('keydown', on_nick);
ielt.addEventListener('keydown', on_input_key);
ws.onmessage =
function (msg_evt) {
console.log('message from server:', msg_evt);
let msg_str = msg_evt.data;
let msg_obj = JSON.parse(msg_str);
oelt.value += msg_obj.nick;
oelt.value += '> ';
oelt.value += msg_obj.msg;
oelt.value += '\n';
};
}
main();
</script>
</body>
</html>
priv/static/index.html
+1 -2
View File
@@ -16,9 +16,8 @@
<h1 class="content-title">FEWD: index</h1>
<ul>
<li><a href="/chat.html">Chatroom</a></li>
<li><a href="/echo.html">Echo</a></li>
<li><a href="/tetris.html">Tetris</a></li>
<li><a href="/webrtc.html">WebRTC</a></li>
<li><a href="/wfc.html">WFC</a></li>
</ul>
</div>
priv/static/js/dist/libfewd.js.map
Vendored
+1 -1
View File
@@ -1 +1 @@
{"version":3,"file":"libfewd.js","sourceRoot":"","sources":["../ts/libfewd.ts"],"names":[],"mappings":"AAAA;;;;GAIG;AAEH,OAAO,EACH,WAAW,EACX,qBAAqB,EACxB,CAAC;AAGF,SACA,WAAW,CACN,gBAAmC,EACnC,cAAsC,EACtC,UAAyB;IAG1B,+DAA+D;IAC/D,IAAI,gBAAgB,CAAC,OAAO,EAAE,CAAC;QAC3B,IAAI,aAAa,GAAW,cAAc,CAAC,YAAY,CAAC;QACxD,sCAAsC;QACtC,IAAI,aAAa,GAAG,UAAU;YAC1B,cAAc,CAAC,KAAK,CAAC,MAAM,GAAG,MAAM,CAAC,aAAa,CAAC,GAAG,IAAI,CAAC;;YAE3D,cAAc,CAAC,KAAK,CAAC,MAAM,GAAG,MAAM,CAAC,UAAU,CAAC,GAAG,IAAI,CAAC;IAChE,CAAC;AACL,CAAC;AAGD,SACA,qBAAqB,CAChB,gBAAmC,EACnC,cAAsC;IAGvC,IAAI,gBAAgB,CAAC,OAAO,EAAE,CAAC;QAC3B,mBAAmB;QACnB,cAAc,CAAC,SAAS,GAAG,cAAc,CAAC,YAAY,CAAC;IAC3D,CAAC;AACL,CAAC"}
{"version":3,"file":"libfewd.js","sourceRoot":"","sources":["../ts/libfewd.ts"],"names":[],"mappings":"AAAA;;;;GAIG;AAEH,OAAO,EACH,WAAW,EACX,qBAAqB,EACxB,CAAC;AAGF,SACA,WAAW,CACN,gBAAmC,EACnC,cAAsC,EACtC,UAAyB;IAG1B,+DAA+D;IAC/D,IAAI,gBAAgB,CAAC,OAAO,EAAE;QAC1B,IAAI,aAAa,GAAW,cAAc,CAAC,YAAY,CAAC;QACxD,sCAAsC;QACtC,IAAI,aAAa,GAAG,UAAU;YAC1B,cAAc,CAAC,KAAK,CAAC,MAAM,GAAG,MAAM,CAAC,aAAa,CAAC,GAAG,IAAI,CAAC;;YAE3D,cAAc,CAAC,KAAK,CAAC,MAAM,GAAG,MAAM,CAAC,UAAU,CAAC,GAAG,IAAI,CAAC;KAC/D;AACL,CAAC;AAGD,SACA,qBAAqB,CAChB,gBAAmC,EACnC,cAAsC;IAGvC,IAAI,gBAAgB,CAAC,OAAO,EAAE;QAC1B,mBAAmB;QACnB,cAAc,CAAC,SAAS,GAAG,cAAc,CAAC,YAAY,CAAC;KAC1D;AACL,CAAC"}
priv/static/js/dist/webrtc.d.ts
Vendored
+16
View File
@@ -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
Vendored
+66
View File
@@ -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
Vendored
+1
View File
@@ -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;QACf,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;gBAC1B,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;aACjC;YACD,MAAM;KACb;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/dist/wfc.js.map
Vendored
+1 -1
View File
@@ -1 +1 @@
{"version":3,"file":"wfc.js","sourceRoot":"","sources":["../ts/wfc.ts"],"names":[],"mappings":"AAAA;;;;GAIG;AAEH,OAAO,KAAK,OAAO,MAAM,cAAc,CAAA;AAEvC,oEAAoE;AACpE,qBAAqB;AACrB,oEAAoE;AAEpE,IAAI,EAAE,CAAC;AAEP,SACA,IAAI;IAIA,IAAI,IAAI,GAAoC,QAAQ,CAAC,cAAc,CAAC,WAAW,CAA8B,CAAK;IAClH,IAAI,IAAI,GAAoC,QAAQ,CAAC,cAAc,CAAC,YAAY,CAAgC,CAAE;IAClH,IAAI,SAAS,GAA+B,QAAQ,CAAC,cAAc,CAAC,oBAAoB,CAAqB,CAAK;IAClH,IAAI,SAAS,GAA+B,QAAQ,CAAC,cAAc,CAAC,aAAa,CAA4B,CAAK;IAClH,IAAI,eAAe,GAAyB,GAAG,CAAC;IAGhD,IAAI,CAAC,gBAAgB,CAAC,SAAS,EAC3B,UAAS,CAAgB;QACrB,YAAY,CAAC,CAAC,EAAE,IAAI,EAAE,IAAI,EAAE,SAAS,EAAE,SAAS,EAAE,eAAe,CAAC,CAAC;IACvE,CAAC,CACJ,CAAC;AACN,CAAC;AAGD,yBAAyB;AACzB,KAAK,UACL,YAAY,CACP,GAA0B,EAC1B,IAA6B,EAC7B,IAAgC,EAChC,SAA6B,EAC7B,SAA6B,EAC7B,UAAmB;IAGpB,IAAI,GAAG,CAAC,GAAG,KAAK,OAAO,EAAE,CAAC;QACtB,yBAAyB;QACzB,GAAG,CAAC,cAAc,EAAE,CAAC;QACrB,gBAAgB;QAChB,IAAI,QAAQ,GAAa,IAAI,CAAC,KAAK,CAAC;QACpC,IAAI,OAAO,GAAc,QAAQ,CAAC,IAAI,EAAE,CAAC;QACzC,IAAI,QAAQ,GAAa,OAAO,CAAC,MAAM,GAAG,CAAC,CAAC;QAC5C,2BAA2B;QAC3B,IAAI,QAAQ,EAAE,CAAC;YACX,cAAc;YACd,IAAI,CAAC,KAAK,GAAG,EAAE,CAAC;YAEhB,gBAAgB;YAChB,IAAI,CAAC,KAAK,IAAI,IAAI,GAAG,OAAO,GAAG,IAAI,CAAC;YACpC,IAAI,CAAC,MAAM,GAAG,KAAK,CAAC;YAEpB,2BAA2B;YAC3B,IAAI,MAAM,GAAY,MAAM,WAAW,CAAC,OAAO,CAAC,CAAC;YAEjD,IAAI,MAAM,CAAC,EAAE;gBACT,IAAI,CAAC,KAAK,IAAI,MAAM,CAAC,MAAM,CAAC;;gBAE5B,IAAI,CAAC,KAAK,IAAI,MAAM,CAAC,KAAK,CAAC;YAC/B,IAAI,CAAC,KAAK,IAAI,IAAI,CAAC;YAEnB,cAAc;YACd,OAAO,CAAC,WAAW,CAAC,SAAS,EAAE,IAAI,EAAE,UAAU,CAAC,CAAC;YACjD,OAAO,CAAC,qBAAqB,CAAC,SAAS,EAAE,IAAI,CAAC,CAAC;QACnD,CAAC;IACL,CAAC;AACL,CAAC;AAaD,SACA,MAAM,CACD,SAAmB,EACnB,QAAkB;IAGnB,IAAG,CAAC,SAAS;QACT,MAAM,IAAI,KAAK,CAAC,QAAQ,CAAC,CAAC;AAClC,CAAC;AAGD,KAAK,UACL,WAAW,CACN,SAAkB;IAGnB,IAAI,YAAY,GAAG,EAAC,KAAK,EAAE,SAAS,EAAC,CAAC;IACtC,IAAI,YAAY,GAAG,IAAI,CAAC,SAAS,CAAC,YAAY,CAAC,CAAC;IAEhD,IAAI,WAAW,GAAI,EAAC,MAAM,EAAG,MAAM;QACf,OAAO,EAAE,EAAC,cAAc,EAAE,kBAAkB,EAAC;QAC7C,IAAI,EAAK,YAAY,EAAC,CAAC;IAE3C,mEAAmE;IACnE,4CAA4C;IAC5C,IAAI,MAAM,GAAW,EAAC,EAAE,EAAM,KAAK;QACb,KAAK,EAAG,kCAAkC,EAAC,CAAC;IAElE,IAAI,CAAC;QACD,IAAI,QAAQ,GAAc,MAAM,KAAK,CAAC,QAAQ,EAAE,WAAW,CAAC,CAAC;QAC7D,IAAI,QAAQ,CAAC,EAAE;YACX,MAAM,GAAG,MAAM,QAAQ,CAAC,IAAI,EAAY,CAAC;aACxC,CAAC;YACF,OAAO,CAAC,GAAG,CAAC,oBAAoB,EAAE,QAAQ,CAAC,CAAC;YAC5C,MAAM,GAAG,EAAC,EAAE,EAAE,KAAK,EAAE,KAAK,EAAE,mBAAmB,EAAC,CAAC;QACrD,CAAC;IACL,CAAC;IACD,OAAO,CAAM,EAAE,CAAC;QACZ,OAAO,CAAC,GAAG,CAAC,gBAAgB,EAAE,CAAC,CAAC,CAAC;QACjC,MAAM,GAAG,EAAC,EAAE,EAAE,KAAK,EAAE,KAAK,EAAE,eAAe,EAAC,CAAC;IACjD,CAAC;IAED,OAAO,MAAM,CAAC;AAClB,CAAC"}
{"version":3,"file":"wfc.js","sourceRoot":"","sources":["../ts/wfc.ts"],"names":[],"mappings":"AAAA;;;;GAIG;AAEH,OAAO,KAAK,OAAO,MAAM,cAAc,CAAA;AAEvC,oEAAoE;AACpE,qBAAqB;AACrB,oEAAoE;AAEpE,IAAI,EAAE,CAAC;AAEP,SACA,IAAI;IAIA,IAAI,IAAI,GAAoC,QAAQ,CAAC,cAAc,CAAC,WAAW,CAA8B,CAAK;IAClH,IAAI,IAAI,GAAoC,QAAQ,CAAC,cAAc,CAAC,YAAY,CAAgC,CAAE;IAClH,IAAI,SAAS,GAA+B,QAAQ,CAAC,cAAc,CAAC,oBAAoB,CAAqB,CAAK;IAClH,IAAI,SAAS,GAA+B,QAAQ,CAAC,cAAc,CAAC,aAAa,CAA4B,CAAK;IAClH,IAAI,eAAe,GAAyB,GAAG,CAAC;IAGhD,IAAI,CAAC,gBAAgB,CAAC,SAAS,EAC3B,UAAS,CAAgB;QACrB,YAAY,CAAC,CAAC,EAAE,IAAI,EAAE,IAAI,EAAE,SAAS,EAAE,SAAS,EAAE,eAAe,CAAC,CAAC;IACvE,CAAC,CACJ,CAAC;AACN,CAAC;AAGD,yBAAyB;AACzB,KAAK,UACL,YAAY,CACP,GAA0B,EAC1B,IAA6B,EAC7B,IAAgC,EAChC,SAA6B,EAC7B,SAA6B,EAC7B,UAAmB;IAGpB,IAAI,GAAG,CAAC,GAAG,KAAK,OAAO,EAAE;QACrB,yBAAyB;QACzB,GAAG,CAAC,cAAc,EAAE,CAAC;QACrB,gBAAgB;QAChB,IAAI,QAAQ,GAAa,IAAI,CAAC,KAAK,CAAC;QACpC,IAAI,OAAO,GAAc,QAAQ,CAAC,IAAI,EAAE,CAAC;QACzC,IAAI,QAAQ,GAAa,OAAO,CAAC,MAAM,GAAG,CAAC,CAAC;QAC5C,2BAA2B;QAC3B,IAAI,QAAQ,EAAE;YACV,cAAc;YACd,IAAI,CAAC,KAAK,GAAG,EAAE,CAAC;YAEhB,gBAAgB;YAChB,IAAI,CAAC,KAAK,IAAI,IAAI,GAAG,OAAO,GAAG,IAAI,CAAC;YACpC,IAAI,CAAC,MAAM,GAAG,KAAK,CAAC;YAEpB,2BAA2B;YAC3B,IAAI,MAAM,GAAY,MAAM,WAAW,CAAC,OAAO,CAAC,CAAC;YAEjD,IAAI,MAAM,CAAC,EAAE;gBACT,IAAI,CAAC,KAAK,IAAI,MAAM,CAAC,MAAM,CAAC;;gBAE5B,IAAI,CAAC,KAAK,IAAI,MAAM,CAAC,KAAK,CAAC;YAC/B,IAAI,CAAC,KAAK,IAAI,IAAI,CAAC;YAEnB,cAAc;YACd,OAAO,CAAC,WAAW,CAAC,SAAS,EAAE,IAAI,EAAE,UAAU,CAAC,CAAC;YACjD,OAAO,CAAC,qBAAqB,CAAC,SAAS,EAAE,IAAI,CAAC,CAAC;SAClD;KACJ;AACL,CAAC;AAaD,SACA,MAAM,CACD,SAAmB,EACnB,QAAkB;IAGnB,IAAG,CAAC,SAAS;QACT,MAAM,IAAI,KAAK,CAAC,QAAQ,CAAC,CAAC;AAClC,CAAC;AAGD,KAAK,UACL,WAAW,CACN,SAAkB;IAGnB,IAAI,YAAY,GAAG,EAAC,KAAK,EAAE,SAAS,EAAC,CAAC;IACtC,IAAI,YAAY,GAAG,IAAI,CAAC,SAAS,CAAC,YAAY,CAAC,CAAC;IAEhD,IAAI,WAAW,GAAI,EAAC,MAAM,EAAG,MAAM;QACf,OAAO,EAAE,EAAC,cAAc,EAAE,kBAAkB,EAAC;QAC7C,IAAI,EAAK,YAAY,EAAC,CAAC;IAE3C,mEAAmE;IACnE,4CAA4C;IAC5C,IAAI,MAAM,GAAW,EAAC,EAAE,EAAM,KAAK;QACb,KAAK,EAAG,kCAAkC,EAAC,CAAC;IAElE,IAAI;QACA,IAAI,QAAQ,GAAc,MAAM,KAAK,CAAC,QAAQ,EAAE,WAAW,CAAC,CAAC;QAC7D,IAAI,QAAQ,CAAC,EAAE;YACX,MAAM,GAAG,MAAM,QAAQ,CAAC,IAAI,EAAY,CAAC;aACxC;YACD,OAAO,CAAC,GAAG,CAAC,oBAAoB,EAAE,QAAQ,CAAC,CAAC;YAC5C,MAAM,GAAG,EAAC,EAAE,EAAE,KAAK,EAAE,KAAK,EAAE,mBAAmB,EAAC,CAAC;SACpD;KACJ;IACD,OAAO,CAAM,EAAE;QACX,OAAO,CAAC,GAAG,CAAC,gBAAgB,EAAE,CAAC,CAAC,CAAC;QACjC,MAAM,GAAG,EAAC,EAAE,EAAE,KAAK,EAAE,KAAK,EAAE,eAAe,EAAC,CAAC;KAChD;IAED,OAAO,MAAM,CAAC;AAClB,CAAC"}
priv/static/js/ts/webrtc.ts
+107
View File
@@ -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/tetris.html
-24
View File
@@ -1,24 +0,0 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>Tetris with Websockets</title>
<link rel="stylesheet" href="/css/default.css">
<link rel="stylesheet" href="/css/tetris.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">Tetris</h1>
<textarea id="tetris-state"></textarea>
</div>
<script type="module" src="./js/dist/tetris.js"></script>
</body>
</html>
priv/static/webrtc.html
+36
View File
@@ -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>
src/et_piece.erl
-105
View File
@@ -1,105 +0,0 @@
-module(et_piece).
-vsn("1.0.4").
-author("Craig Everett <zxq9@zxq9.com>").
-copyright("Craig Everett <zxq9@zxq9.com>").
-license("MIT").
-export([rand/0, new/1, flip/2, points/2, points/1, type/1, sides/1]).
-export_type([data/0]).
-record(p,
{flip = 1 :: 1..4,
type = i :: erltris:type()}).
-opaque data() :: #p{}.
rand() ->
case rand:uniform(7) of
1 -> new(i);
2 -> new(o);
3 -> new(t);
4 -> new(s);
5 -> new(z);
6 -> new(j);
7 -> new(l)
end.
new(T) -> #p{type = T}.
flip(r, Piece = #p{flip = 4}) -> Piece#p{flip = 1};
flip(r, Piece = #p{flip = F}) -> Piece#p{flip = F + 1};
flip(l, Piece = #p{flip = 1}) -> Piece#p{flip = 4};
flip(l, Piece = #p{flip = F}) -> Piece#p{flip = F - 1}.
points(Piece, {LX, LY}) ->
Offsets = points(Piece),
Translate = fun({OX, OY}) -> {LX + OX, LY + OY} end,
lists:map(Translate, Offsets).
points(#p{flip = F, type = T}) ->
offset(T, F).
offset(i, 1) -> [{0, 2}, {1, 2}, {2, 2}, {3, 2}];
offset(i, 2) -> [{2, 3}, {2, 2}, {2, 1}, {2, 0}];
offset(i, 3) -> [{0, 1}, {1, 1}, {2, 1}, {3, 1}];
offset(i, 4) -> [{1, 3}, {1, 2}, {1, 1}, {1, 0}];
offset(o, _) -> [{1, 1}, {1, 2}, {2, 1}, {2, 2}];
offset(t, 1) -> [{0, 1}, {1, 1}, {2, 1}, {1, 2}];
offset(t, 2) -> [{1, 2}, {1, 1}, {1, 0}, {2, 1}];
offset(t, 3) -> [{0, 1}, {1, 1}, {2, 1}, {1, 0}];
offset(t, 4) -> [{1, 2}, {1, 1}, {1, 0}, {0, 1}];
offset(s, 1) -> [{0, 1}, {1, 1}, {1, 2}, {2, 2}];
offset(s, 2) -> [{1, 2}, {1, 1}, {2, 1}, {2, 0}];
offset(s, 3) -> [{0, 0}, {1, 0}, {1, 1}, {2, 1}];
offset(s, 4) -> [{0, 2}, {0, 1}, {1, 1}, {1, 0}];
offset(z, 1) -> [{0, 2}, {1, 2}, {1, 1}, {2, 1}];
offset(z, 2) -> [{1, 0}, {1, 1}, {2, 1}, {2, 2}];
offset(z, 3) -> [{0, 1}, {1, 1}, {1, 0}, {2, 0}];
offset(z, 4) -> [{0, 0}, {0, 1}, {1, 1}, {1, 2}];
offset(j, 1) -> [{0, 2}, {0, 1}, {1, 1}, {2, 1}];
offset(j, 2) -> [{1, 0}, {1, 1}, {1, 2}, {2, 2}];
offset(j, 3) -> [{0, 1}, {1, 1}, {2, 1}, {2, 0}];
offset(j, 4) -> [{0, 0}, {1, 0}, {1, 1}, {1, 2}];
offset(l, 1) -> [{0, 1}, {1, 1}, {2, 1}, {2, 2}];
offset(l, 2) -> [{1, 2}, {1, 1}, {1, 0}, {2, 0}];
offset(l, 3) -> [{0, 0}, {0, 1}, {1, 1}, {2, 1}];
offset(l, 4) -> [{0, 2}, {1, 2}, {1, 1}, {1, 0}].
type(#p{type = T}) -> T.
sides(#p{type = T, flip = F}) ->
sides(T, F).
sides(i, 1) -> {0, 3, 2};
sides(i, 2) -> {2, 2, 3};
sides(i, 3) -> {0, 3, 1};
sides(i, 4) -> {1, 1, 3};
sides(o, _) -> {1, 2, 2};
sides(t, 1) -> {0, 2, 2};
sides(t, 2) -> {1, 2, 2};
sides(t, 3) -> {0, 2, 1};
sides(t, 4) -> {0, 1, 2};
sides(s, 1) -> {0, 2, 2};
sides(s, 2) -> {1, 2, 2};
sides(s, 3) -> {0, 2, 1};
sides(s, 4) -> {0, 1, 2};
sides(z, 1) -> {0 ,2, 2};
sides(z, 2) -> {1, 2, 2};
sides(z, 3) -> {0 ,2, 1};
sides(z, 4) -> {0, 1, 2};
sides(j, 1) -> {0, 2, 2};
sides(j, 2) -> {1, 2, 2};
sides(j, 3) -> {0, 2, 1};
sides(j, 4) -> {0, 1, 2};
sides(l, 1) -> {0, 2, 2};
sides(l, 2) -> {1, 2, 2};
sides(l, 3) -> {0, 2, 1};
sides(l, 4) -> {0, 1, 2}.
src/et_well.erl
-79
View File
@@ -1,79 +0,0 @@
-module(et_well).
-vsn("1.0.4").
-author("Craig Everett <zxq9@zxq9.com>").
-copyright("Craig Everett <zxq9@zxq9.com>").
-license("MIT").
-export([new/0, new/2,
dimensions/1, height/1, width/1,
fetch/3, store/4, complete/1, collapse/2]).
-export_type([playfield/0]).
-opaque playfield() :: tuple().
new() ->
new(10, 20).
new(W, H) ->
erlang:make_tuple(H, row(W)).
row(W) ->
erlang:make_tuple(W, x).
dimensions(Well) ->
H = size(Well),
W = size(element(1, Well)),
{W, H}.
height(Well) ->
size(Well).
width(Well) ->
size(element(1, Well)).
fetch(Well, X, Y) ->
element(X, element(Y, Well)).
store(Well, Value, X, Y) ->
setelement(Y, Well, setelement(X, element(Y, Well), Value)).
complete(Well) ->
{W, H} = dimensions(Well),
complete(H, W, Well, []).
complete(Y, W, Well, Lines) when Y >= 1 ->
case line_complete(W, element(Y, Well)) of
true -> complete(Y - 1, W, Well, [Y | Lines]);
false -> complete(Y - 1, W, Well, Lines)
end;
complete(_, _, _, Lines) ->
Lines.
line_complete(X, Line) when X >= 1 ->
case element(X, Line) of
x -> false;
_ -> line_complete(X - 1, Line)
end;
line_complete(_, _) ->
true.
collapse(Well, Lines) ->
Blank = row(width(Well)),
Crunch =
fun(L, {W, Count}) ->
Crunched = erlang:insert_element(1, erlang:delete_element(L, W), Blank),
{Crunched, Count + 1}
end,
lists:foldl(Crunch, {Well, 0}, Lines).
src/fd_chat.erl
-262
View File
@@ -1,262 +0,0 @@
% @doc
% controller for chat
-module(fd_chat).
-vsn("0.1.0").
-behavior(gen_server).
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
-license("BSD-2-Clause-FreeBSD").
-export([
join/1,
relay/1,
nick_available/1
]).
-export([start_link/0]).
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
code_change/3, terminate/2]).
-include("$zx_include/zx_logger.hrl").
-record(o, {pid :: pid(),
nick :: string()}).
-type orator() :: #o{}.
-record(s, {orators = [] :: [orator()]}).
-type state() :: #s{}.
%%% Service Interface
-spec join(Nick) -> Result
when Nick :: string(),
Result :: ok
| {error, Reason :: any()}.
join(Nick) ->
gen_server:call(?MODULE, {join, Nick}).
-spec nick_available(Nick) -> Result
when Nick :: string(),
Result :: boolean().
nick_available(Nick) ->
gen_server:call(?MODULE, {nick_available, Nick}).
-spec relay(Message) -> ok
when Message :: string().
relay(Message) ->
gen_server:cast(?MODULE, {relay, self(), Message}).
%%% Startup Functions
-spec start_link() -> Result
when Result :: {ok, pid()}
| {error, Reason :: term()}.
%% @private
%% This should only ever be called by fd_chat_orators (the service-level supervisor).
start_link() ->
gen_server:start_link({local, ?MODULE}, ?MODULE, none, []).
-spec init(none) -> {ok, state()}.
%% @private
%% Called by the supervisor process to give the process a chance to perform any
%% preparatory work necessary for proper function.
init(none) ->
ok = tell("~p Starting.", [?MODULE]),
State = #s{},
{ok, State}.
%%% gen_server Message Handling Callbacks
-spec handle_call(Message, From, State) -> Result
when Message :: term(),
From :: {pid(), reference()},
State :: state(),
Result :: {reply, Response, NewState}
| {noreply, State},
Response :: term(),
NewState :: state().
%% @private
%% The gen_server:handle_call/3 callback.
%% See: http://erlang.org/doc/man/gen_server.html#Module:handle_call-3
handle_call({join, Nick}, {Pid, _}, State) ->
{Reply, NewState} = do_join(Pid, Nick, State),
{reply, Reply, NewState};
handle_call({nick_available, Nick}, _, State = #s{orators = Orators}) ->
Reply = is_nick_available(Nick, Orators),
{reply, Reply, State};
handle_call(Unexpected, From, State) ->
ok = tell("~p Unexpected call from ~tp: ~tp~n", [?MODULE, From, Unexpected]),
{noreply, State}.
-spec handle_cast(Message, State) -> {noreply, NewState}
when Message :: term(),
State :: state(),
NewState :: state().
%% @private
%% The gen_server:handle_cast/2 callback.
%% See: http://erlang.org/doc/man/gen_server.html#Module:handle_cast-2
handle_cast({relay, From, Message}, State = #s{orators = Orators}) ->
do_relay(From, Message, Orators),
{noreply, State};
handle_cast(Unexpected, State) ->
ok = tell("~p Unexpected cast: ~tp~n", [?MODULE, Unexpected]),
{noreply, State}.
-spec handle_info(Message, State) -> {noreply, NewState}
when Message :: term(),
State :: state(),
NewState :: state().
%% @private
%% The gen_server:handle_info/2 callback.
%% See: http://erlang.org/doc/man/gen_server.html#Module:handle_info-2
handle_info(Msg = {'DOWN', _Mon, process, _Pid, _Reason}, State) ->
NewState = handle_down(Msg, State),
{noreply, NewState};
handle_info(Unexpected, State) ->
ok = tell("~p Unexpected info: ~tp~n", [?MODULE, Unexpected]),
{noreply, State}.
%%% OTP Service Functions
-spec code_change(OldVersion, State, Extra) -> Result
when OldVersion :: {down, Version} | Version,
Version :: term(),
State :: state(),
Extra :: term(),
Result :: {ok, NewState}
| {error, Reason :: term()},
NewState :: state().
%% @private
%% The gen_server:code_change/3 callback.
%% See: http://erlang.org/doc/man/gen_server.html#Module:code_change-3
code_change(_, State, _) ->
{ok, State}.
-spec terminate(Reason, State) -> no_return()
when Reason :: normal
| shutdown
| {shutdown, term()}
| term(),
State :: state().
%% @private
%% The gen_server:terminate/2 callback.
%% See: http://erlang.org/doc/man/gen_server.html#Module:terminate-2
terminate(_, _) ->
ok.
%%% internals
-spec do_join(Pid, Nick, State) -> {Reply, NewState}
when Pid :: pid(),
Nick :: string(),
Reply :: ok | {error, Reason :: any()},
NewState :: State.
do_join(Pid, Nick, State = #s{orators = Orators}) ->
case ensure_can_join(Pid, Nick, Orators) of
ok -> do_join2(Pid, Nick, State);
Error -> {Error, State}
end.
do_join2(Pid, Nick, State = #s{orators = Orators}) ->
_Monitor = erlang:monitor(process, Pid),
NewOrator = #o{pid = Pid, nick = Nick},
NewOrators = [NewOrator | Orators],
NewState = State#s{orators = NewOrators},
{ok, NewState}.
-spec ensure_can_join(Pid, Nick, Orators) -> Result
when Pid :: pid(),
Nick :: string(),
Orators :: [orator()],
Result :: ok
| {error, Reason},
Reason :: any().
% @private
% ensures both Pid and Nick are unique
ensure_can_join(Pid, _ , [#o{pid = Pid} | _ ]) -> {error, already_joined};
ensure_can_join(_ , Nick, [#o{nick = Nick} | _ ]) -> {error, {nick_taken, Nick}};
ensure_can_join(Pid, Nick, [_ | Rest]) -> ensure_can_join(Pid, Nick, Rest);
ensure_can_join(_ , _ , [] ) -> ok.
-spec is_nick_available(Nick, Orators) -> boolean()
when Nick :: string(),
Orators :: [orator()].
is_nick_available(Nick, [#o{nick = Nick} | _ ]) -> false;
is_nick_available(Nick, [_ | Rest]) -> is_nick_available(Nick, Rest);
is_nick_available(_ , [] ) -> true.
-spec handle_down(Msg, State) -> NewState
when Msg :: {'DOWN', Mon, process, Pid, Reason},
Mon :: erlang:monitor(),
Pid :: pid(),
Reason :: any(),
State :: state(),
NewState :: State.
handle_down(Msg = {'DOWN', _, process, Pid, _}, State = #s{orators = Orators}) ->
NewOrators = hdn(Msg, Pid, Orators, []),
NewState = State#s{orators = NewOrators},
NewState.
% encountered item, removing
hdn(_, Pid, [#o{pid = Pid} | Rest], Acc) -> Rest ++ Acc;
hdn(Msg, Pid, [Skip | Rest], Acc) -> hdn(Msg, Pid, Rest, [Skip | Acc]);
hdn(Msg, _, [] , Acc) ->
log("~tp: Unexpected message: ~tp", [?MODULE, Msg]),
Acc.
do_relay(Pid, Message, Orators) ->
case lists:keyfind(Pid, #o.pid, Orators) of
#o{nick = Nick} ->
do_relay2(Nick, Message, Orators);
false ->
tell("~tp: Message received from outsider ~tp: ~tp", [?MODULE, Pid, Message]),
error
end.
% skip
do_relay2(Nick, Msg, [#o{nick = Nick} | Rest]) ->
do_relay2(Nick, Msg, Rest);
do_relay2(Nick, Msg, [#o{pid = Pid} | Rest]) ->
Pid ! {chat, {relay, Nick, Msg}},
do_relay2(Nick, Msg, Rest);
do_relay2(_, _, []) ->
ok.
src/fd_httpd.erl
+46
View File
@@ -0,0 +1,46 @@
-module(fd_httpd).
-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},
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,
5000,
worker,
[fd_httpd_sfc]},
Clients = {fd_httpd_clients,
{fd_httpd_clients, start_link, []},
permanent,
5000,
supervisor,
[fd_httpd_clients]},
Children = [WebRTC, FileCache, Clients],
%Children = [FileCache, Clients],
{ok, {RestartStrategy, Children}}.
src/fd_client.erl → src/fd_httpd_client.erl
+145 -110
View File
@@ -13,8 +13,8 @@
%%% http://erlang.org/doc/design_principles/spec_proc.html
%%% @end
-module(fd_client).
-vsn("0.1.0").
-module(fd_httpd_client).
-vsn("0.2.0").
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
-license("BSD-2-Clause-FreeBSD").
@@ -52,11 +52,11 @@
| {shutdown, term()}
| term().
%% @private
%% How the fd_client_man or a prior fd_client kicks things off.
%% This is called in the context of fd_client_man or the prior fd_client.
%% How the fd_httpd_client_man or a prior fd_httpd_client kicks things off.
%% This is called in the context of fd_httpd_client_man or the prior fd_httpd_client.
start(ListenSocket) ->
fd_client_sup:start_acceptor(ListenSocket).
fd_httpd_client_sup:start_acceptor(ListenSocket).
-spec start_link(ListenSocket) -> Result
@@ -67,7 +67,7 @@ start(ListenSocket) ->
| {shutdown, term()}
| term().
%% @private
%% This is called by the fd_client_sup. While start/1 is called to iniate a startup
%% This is called by the fd_httpd_client_sup. While start/1 is called to iniate a startup
%% (essentially requesting a new worker be started by the supervisor), this is
%% actually called in the context of the supervisor.
@@ -86,7 +86,7 @@ start_link(ListenSocket) ->
%% call to listen/3.
init(Parent, ListenSocket) ->
ok = io:format("~p Listening.~n", [self()]),
ok = tell("~p Listening.~n", [self()]),
Debug = sys:debug_options([]),
ok = proc_lib:init_ack(Parent, {ok, self()}),
listen(Parent, Debug, ListenSocket).
@@ -98,7 +98,7 @@ init(Parent, ListenSocket) ->
ListenSocket :: gen_tcp:socket().
%% @private
%% This function waits for a TCP connection. The owner of the socket is still
%% the fd_client_man (so it can still close it on a call to fd_client_man:ignore/0),
%% the fd_httpd_client_man (so it can still close it on a call to fd_httpd_client_man:ignore/0),
%% but the only one calling gen_tcp:accept/1 on it is this process. Closing the socket
%% is one way a manager process can gracefully unblock child workers that are blocking
%% on a network accept.
@@ -110,12 +110,12 @@ listen(Parent, Debug, ListenSocket) ->
{ok, Socket} ->
{ok, _} = start(ListenSocket),
{ok, Peer} = inet:peername(Socket),
ok = io:format("~p Connection accepted from: ~p~n", [self(), Peer]),
ok = fd_client_man:enroll(),
ok = tell("~p Connection accepted from: ~p~n", [self(), Peer]),
ok = fd_httpd_client_man:enroll(),
State = #s{socket = Socket},
loop(Parent, Debug, State);
{error, closed} ->
ok = io:format("~p Retiring: Listen socket closed.~n", [self()]),
ok = tell("~p Retiring: Listen socket closed.~n", [self()]),
exit(normal)
end.
@@ -135,24 +135,35 @@ 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
tell(error, "~p QHL parse error: ~tp", [?LINE, Error]),
tell(error, "~p bad request:~n~ts", [?LINE, Received]),
fd_http_utils:http_err(Socket, 400),
fd_httpd_utils:http_err(Socket, 400),
gen_tcp:shutdown(Socket, read_write),
exit(normal)
end;
{tcp_closed, Socket} ->
ok = io:format("~p Socket closed, retiring.~n", [self()]),
ok = tell("~p Socket closed, retiring.~n", [self()]),
exit(normal);
{system, From, Request} ->
sys:handle_system_msg(Request, From, Parent, ?MODULE, Debug, State);
Unexpected ->
ok = io:format("~p Unexpected message: ~tp", [self(), Unexpected]),
ok = tell("~p Unexpected message: ~tp", [self(), Unexpected]),
loop(Parent, Debug, State)
end.
@@ -232,18 +243,18 @@ handle_request(Sock, R = #request{method = M, path = P}, Received) when M =/= un
route(Sock, get, Route, Request, Received) ->
case Route of
<<"/ws/tetris">> -> ws_tetris(Sock, Request, Received);
<<"/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;
route(Sock, post, Route, Request, Received) ->
case Route of
<<"/wfcin">> -> wfcin(Sock, Request) , Received;
_ -> fd_http_utils:http_err(Sock, 404) , Received
_ -> fd_httpd_utils:http_err(Sock, 404) , Received
end;
route(Sock, _, _, _, Received) ->
fd_http_utils:http_err(Sock, 404),
fd_httpd_utils:http_err(Sock, 404),
Received.
@@ -253,13 +264,13 @@ route(Sock, _, _, _, Received) ->
Route :: binary().
route_static(Sock, Route) ->
respond_static(Sock, fd_sfc:query(Route)).
respond_static(Sock, fd_httpd_sfc:query(Route)).
-spec respond_static(Sock, MaybeEty) -> ok
when Sock :: gen_tcp:socket(),
MaybeEty :: fd_sfc:maybe_entry().
MaybeEty :: fd_httpd_sfc:maybe_entry().
respond_static(Sock, {found, Entry}) ->
% -record(e, {fs_path :: file:filename(),
@@ -268,86 +279,118 @@ respond_static(Sock, {found, Entry}) ->
% encoding :: encoding(),
% contents :: binary()}).
Headers0 =
case fd_sfc_entry:encoding(Entry) of
case fd_httpd_sfc_entry:encoding(Entry) of
gzip -> [{"content-encoding", "gzip"}];
none -> []
end,
Headers1 = [{"content-type", fd_sfc_entry:mime_type(Entry)} | Headers0],
Headers1 = [{"content-type", fd_httpd_sfc_entry:mime_type(Entry)} | Headers0],
Response = #response{headers = Headers1,
body = fd_sfc_entry:contents(Entry)},
fd_http_utils:respond(Sock, Response);
body = fd_httpd_sfc_entry:contents(Entry)},
fd_httpd_utils:respond(Sock, Response);
respond_static(Sock, not_found) ->
fd_http_utils:http_err(Sock, 404).
fd_httpd_utils:http_err(Sock, 404).
%% ------------------------------
%% tetris
%% webrtc
%% ------------------------------
-spec ws_tetris(Sock, Request, Received) -> NewReceived
when Sock :: gen_tcp:socket(),
Request :: request(),
Received :: binary(),
NewReceived :: binary().
-record(rs,
{socket :: gen_tcp:socket(),
received = <<>> :: binary(),
username = undefined :: undefined | string()}).
ws_tetris(Sock, Request, Received) ->
.
-type webrtc_state() :: #rs{}.
-spec ws_tetris2(Sock, Request, Received) -> NewReceived
when Sock :: gen_tcp:socket(),
Request :: request(),
Received :: binary(),
NewReceived :: binary().
ws_tetris2(Sock, Request, Received) ->
%tell("~p: ws_tetris request: ~tp", [?LINE, Request]),
case fd_ws:handshake(Request) of
{ok, Response} ->
fd_http_utils:respond(Sock, Response),
{ok, TetrisPid} = fd_tetris:start_link(),
ws_tetris_loop(Sock, TetrisPid, [], Received);
Error ->
tell("ws_tetris: error: ~tp", [Error]),
fd_http_utils:http_err(Sock, 400)
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.
-spec ws_tetris_loop(Sock, Tetris, Frames, Received) -> NewReceived
when Sock :: gen_tcp:socket(),
Tetris :: pid(),
Frames :: [fd_ws:frame()],
Received :: binary(),
NewReceived :: binary().
-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.
ws_tetris_loop(Sock, Tetris, Frames, Received) ->
tell("~p:ws_tetris_loop(Sock, ~p, ~p, ~p)", [?MODULE, Tetris, Frames, Received]),
%% create tetris state
case inet:setopts(Sock, [{active, once}]) of
ok ->
receive
{tcp, Sock, Bin} ->
Rcv1 = <<Received/binary, Bin/binary>>,
case fd_ws:recv(Sock, Rcv1, 3_000, Frames) of
{ok, WsMsg, NewFrames, Rcv2} ->
ok = fd_tetris:ws_msg(Tetris, WsMsg),
ws_tetris_loop(Sock, Tetris, NewFrames, Rcv2);
Error ->
error(Error)
end;
{tetris, Message} ->
ok = log(info, "~p tetris: ~p", [self(), Message]),
ok = fd_ws:send(Sock, {text, Message}),
ws_tetris_loop(Sock, Tetris, Frames, Received);
{tcp_closed, Sock} -> {error, tcp_closed};
{tcp_error, Sock, Reason} -> {error, {tcp_error, Reason}}
after 30_000 ->
{error, timeout}
end;
{error, Reason} ->
{error, {inet, Reason}}
end.
%% ------------------------------
%% echo
@@ -359,17 +402,17 @@ ws_echo(Sock, Request) ->
catch
X:Y:Z ->
tell(error, "CRASH ws_echo: ~tp:~tp:~tp", [X, Y, Z]),
fd_http_utils:http_err(Sock, 500)
fd_httpd_utils:http_err(Sock, 500)
end.
ws_echo2(Sock, Request) ->
case fd_ws:handshake(Request) of
case qhl_ws:handshake(Request) of
{ok, Response} ->
fd_http_utils:respond(Sock, Response),
fd_httpd_utils:respond(Sock, Response),
ws_echo_loop(Sock);
Error ->
tell("ws_echo: error: ~tp", [Error]),
fd_http_utils:http_err(Sock, 400)
fd_httpd_utils:http_err(Sock, 400)
end.
ws_echo_loop(Sock) ->
@@ -377,15 +420,15 @@ ws_echo_loop(Sock) ->
ws_echo_loop(Sock, Frames, Received) ->
tell("~p ws_echo_loop(Sock, ~tp, ~tp)", [self(), Frames, Received]),
case fd_ws:recv(Sock, Received, 5*fd_ws:min(), Frames) of
case qhl_ws:recv(Sock, Received, 5*qhl_ws:min(), Frames) of
{ok, Message, NewFrames, NewReceived} ->
tell("~p echo message: ~tp", [self(), Message]),
% send the same message back
ok = fd_ws:send(Sock, Message),
ok = qhl_ws:send(Sock, Message),
ws_echo_loop(Sock, NewFrames, NewReceived);
Error ->
tell(error, "ws_echo_loop: error: ~tp", [Error]),
fd_ws:send(Sock, {close, <<>>}),
qhl_ws:send(Sock, {close, <<>>}),
error(Error)
end.
@@ -405,28 +448,28 @@ wfcin(Sock, #request{enctype = json,
case wfc_read:expr(Input) of
{ok, Expr, _Rest} ->
case wfc_eval:eval(Expr, Ctx0) of
{ok, noop, Ctx1} -> {fd_http_utils:jsgud("<noop>"), Ctx1};
{ok, Sentence, Ctx1} -> {fd_http_utils:jsgud(wfc_pp:sentence(Sentence)), Ctx1};
{error, Message} -> {fd_http_utils:jsbad(Message), Ctx0}
{ok, noop, Ctx1} -> {fd_httpd_utils:jsgud("<noop>"), Ctx1};
{ok, Sentence, Ctx1} -> {fd_httpd_utils:jsgud(wfc_pp:sentence(Sentence)), Ctx1};
{error, Message} -> {fd_httpd_utils:jsbad(Message), Ctx0}
end;
{error, Message} ->
{fd_http_utils:jsbad(Message), Ctx0}
{fd_httpd_utils:jsbad(Message), Ctx0}
end
catch
error:E:S ->
ErrorMessage = unicode:characters_to_list(io_lib:format("parser crashed: ~p:~p", [E, S])),
{fd_http_utils:jsbad(ErrorMessage), Ctx0}
{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]}],
body = Body},
fd_http_utils:respond(Sock, Response);
fd_httpd_utils:respond(Sock, Response);
wfcin(Sock, Request) ->
tell("wfcin: bad request: ~tp", [Request]),
fd_http_utils:http_err(Sock, 400).
fd_httpd_utils:http_err(Sock, 400).
@@ -436,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_http_utils:new_cookie(), wfc_eval_context:default()}.
{fd_httpd_utils:new_cookie(), wfc_eval_context:default()}.
src/fd_client_man.erl → src/fd_httpd_client_man.erl
+14 -11
View File
@@ -9,8 +9,8 @@
%%% OTP should take care of for us.
%%% @end
-module(fd_client_man).
-vsn("0.1.0").
-module(fd_httpd_client_man).
-vsn("0.2.0").
-behavior(gen_server).
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
@@ -23,6 +23,8 @@
code_change/3, terminate/2]).
-include("$zx_include/zx_logger.hrl").
%%% Type and Record Definitions
@@ -92,7 +94,7 @@ echo(Message) ->
when Result :: {ok, pid()}
| {error, Reason :: term()}.
%% @private
%% This should only ever be called by fd_clients (the service-level supervisor).
%% This should only ever be called by fd_httpd_clients (the service-level supervisor).
start_link() ->
gen_server:start_link({local, ?MODULE}, ?MODULE, none, []).
@@ -104,8 +106,9 @@ start_link() ->
%% preparatory work necessary for proper function.
init(none) ->
ok = io:format("Starting.~n"),
ok = tell("Starting fd_httpd_client_man."),
State = #s{},
ok = tell("fd_httpd_client_man init state: ~tp", [State]),
{ok, State}.
@@ -130,7 +133,7 @@ handle_call({listen, PortNum}, _, State) ->
{Response, NewState} = do_listen(PortNum, State),
{reply, Response, NewState};
handle_call(Unexpected, From, State) ->
ok = io:format("~p Unexpected call from ~tp: ~tp~n", [self(), From, Unexpected]),
ok = tell("~p Unexpected call from ~tp: ~tp~n", [self(), From, Unexpected]),
{noreply, State}.
@@ -152,7 +155,7 @@ handle_cast(ignore, State) ->
NewState = do_ignore(State),
{noreply, NewState};
handle_cast(Unexpected, State) ->
ok = io:format("~p Unexpected cast: ~tp~n", [self(), Unexpected]),
ok = tell("~p Unexpected cast: ~tp~n", [self(), Unexpected]),
{noreply, State}.
@@ -168,7 +171,7 @@ handle_info({'DOWN', Mon, process, Pid, Reason}, State) ->
NewState = handle_down(Mon, Pid, Reason, State),
{noreply, NewState};
handle_info(Unexpected, State) ->
ok = io:format("~p Unexpected info: ~tp~n", [self(), Unexpected]),
ok = tell("~p Unexpected info: ~tp~n", [self(), Unexpected]),
{noreply, State}.
@@ -225,10 +228,10 @@ do_listen(PortNum, State = #s{port_num = none}) ->
{keepalive, true},
{reuseaddr, true}],
{ok, Listener} = gen_tcp:listen(PortNum, SocketOptions),
{ok, _} = fd_client:start(Listener),
{ok, _} = fd_httpd_client:start(Listener),
{ok, State#s{port_num = PortNum, listener = Listener}};
do_listen(_, State = #s{port_num = PortNum}) ->
ok = io:format("~p Already listening on ~p~n", [self(), PortNum]),
ok = tell("~p Already listening on ~p~n", [self(), PortNum]),
{{error, {listening, PortNum}}, State}.
@@ -254,7 +257,7 @@ do_enroll(Pid, State = #s{clients = Clients}) ->
case lists:member(Pid, Clients) of
false ->
Mon = monitor(process, Pid),
ok = io:format("Monitoring ~tp @ ~tp~n", [Pid, Mon]),
ok = tell("Monitoring ~tp @ ~tp~n", [Pid, Mon]),
State#s{clients = [Pid | Clients]};
true ->
State
@@ -292,6 +295,6 @@ handle_down(Mon, Pid, Reason, State = #s{clients = Clients}) ->
State#s{clients = NewClients};
false ->
Unexpected = {'DOWN', Mon, process, Pid, Reason},
ok = io:format("~p Unexpected info: ~tp~n", [self(), Unexpected]),
ok = tell("~p Unexpected info: ~tp~n", [self(), Unexpected]),
State
end.
src/fd_client_sup.erl → src/fd_httpd_client_sup.erl
+9 -9
View File
@@ -2,8 +2,8 @@
%%% front end web development lab Client Supervisor
%%%
%%% This process supervises the client socket handlers themselves. It is a peer of the
%%% fd_client_man (the manager interface to this network service component),
%%% and a child of the supervisor named fd_clients.
%%% fd_httpd_client_man (the manager interface to this network service component),
%%% and a child of the supervisor named fd_httpd_clients.
%%%
%%% Because we don't know (or care) how many client connections the server may end up
%%% handling this is a simple_one_for_one supervisor which can spawn and manage as
@@ -13,8 +13,8 @@
%%% http://erlang.org/doc/design_principles/sup_princ.html#id79244
%%% @end
-module(fd_client_sup).
-vsn("0.1.0").
-module(fd_httpd_client_sup).
-vsn("0.2.0").
-behaviour(supervisor).
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
@@ -35,9 +35,9 @@
| {shutdown, term()}
| term().
%% @private
%% Spawns the first listener at the request of the fd_client_man when
%% Spawns the first listener at the request of the fd_httpd_client_man when
%% fewd:listen/1 is called, or the next listener at the request of the
%% currently listening fd_client when a connection is made.
%% currently listening fd_httpd_client when a connection is made.
%%
%% Error conditions, supervision strategies and other important issues are
%% explained in the supervisor module docs:
@@ -61,10 +61,10 @@ start_link() ->
init(none) ->
RestartStrategy = {simple_one_for_one, 1, 60},
Client = {fd_client,
{fd_client, start_link, []},
Client = {fd_httpd_client,
{fd_httpd_client, start_link, []},
temporary,
brutal_kill,
worker,
[fd_client]},
[fd_httpd_client]},
{ok, {RestartStrategy, [Client]}}.
src/fd_clients.erl → src/fd_httpd_clients.erl
+15 -15
View File
@@ -8,8 +8,8 @@
%%% See: http://erlang.org/doc/apps/kernel/application.html
%%% @end
-module(fd_clients).
-vsn("0.1.0").
-module(fd_httpd_clients).
-vsn("0.2.0").
-behavior(supervisor).
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
@@ -32,17 +32,17 @@ start_link() ->
init(none) ->
RestartStrategy = {rest_for_one, 1, 60},
ClientMan = {fd_client_man,
{fd_client_man, start_link, []},
permanent,
5000,
worker,
[fd_client_man]},
ClientSup = {fd_client_sup,
{fd_client_sup, start_link, []},
permanent,
5000,
supervisor,
[fd_client_sup]},
Children = [ClientSup, ClientMan],
HttpClientMan = {fd_httpd_client_man,
{fd_httpd_client_man, start_link, []},
permanent,
5000,
worker,
[fd_httpd_client_man]},
HttpClientSup = {fd_httpd_client_sup,
{fd_httpd_client_sup, start_link, []},
permanent,
5000,
supervisor,
[fd_httpd_client_sup]},
Children = [HttpClientSup, HttpClientMan],
{ok, {RestartStrategy, Children}}.
src/fd_sfc.erl → src/fd_httpd_sfc.erl
+8 -7
View File
@@ -1,5 +1,6 @@
% @doc static file cache
-module(fd_sfc).
-module(fd_httpd_sfc).
-vsn("0.2.0").
-behavior(gen_server).
@@ -21,12 +22,12 @@
-include("$zx_include/zx_logger.hrl").
-type entry() :: fd_sfc_entry:entry().
-type maybe_entry() :: {found, fd_sfc_entry:entry()} | not_found.
-type entry() :: fd_httpd_sfc_entry:entry().
-type maybe_entry() :: {found, fd_httpd_sfc_entry:entry()} | not_found.
-record(s, {base_path = base_path() :: file:filename(),
cache = fd_sfc_cache:new(base_path()) :: fd_sfc_cache:cache(),
cache = fd_httpd_sfc_cache:new(base_path()) :: fd_httpd_sfc_cache:cache(),
auto_renew = 0_500 :: pos_integer()}).
%-type state() :: #s{}.
@@ -62,14 +63,14 @@ start_link() ->
%% gen_server callbacks
init(none) ->
tell("starting fd_sfc"),
tell("starting fd_httpd_sfc"),
InitState = #s{},
erlang:send_after(InitState#s.auto_renew, self(), auto_renew),
{ok, InitState}.
handle_call({query, Path}, _, State = #s{cache = Cache}) ->
Reply = fd_sfc_cache:query(Path, Cache),
Reply = fd_httpd_sfc_cache:query(Path, Cache),
{reply, Reply, State};
handle_call(Unexpected, From, State) ->
tell("~tp: unexpected call from ~tp: ~tp", [?MODULE, Unexpected, From]),
@@ -106,6 +107,6 @@ terminate(_, _) ->
%%-----------------------------------------------------------------------------
i_renew(State = #s{base_path = BasePath}) ->
NewCache = fd_sfc_cache:new(BasePath),
NewCache = fd_httpd_sfc_cache:new(BasePath),
NewState = State#s{cache = NewCache},
NewState.
src/fd_sfc_cache.erl → src/fd_httpd_sfc_cache.erl
+5 -4
View File
@@ -1,6 +1,7 @@
% @doc
% cache data management
-module(fd_sfc_cache).
-module(fd_httpd_sfc_cache).
-vsn("0.2.0").
-export_type([
cache/0
@@ -13,7 +14,7 @@
-include("$zx_include/zx_logger.hrl").
-type cache() :: #{HttpPath :: binary() := Entry :: fd_sfc_entry:entry()}.
-type cache() :: #{HttpPath :: binary() := Entry :: fd_httpd_sfc_entry:entry()}.
-spec query(HttpPath, Cache) -> Result
@@ -21,7 +22,7 @@
Cache :: cache(),
Result :: {found, Entry}
| not_found,
Entry :: fd_sfc_entry:entry().
Entry :: fd_httpd_sfc_entry:entry().
query(HttpPath, Cache) ->
case maps:find(HttpPath, Cache) of
@@ -63,7 +64,7 @@ new2(BasePath) ->
BAbsPath = unicode:characters_to_binary(AbsPath),
HttpPath = remove_prefix(BBaseDir, BAbsPath),
NewCache =
case fd_sfc_entry:new(AbsPath) of
case fd_httpd_sfc_entry:new(AbsPath) of
{found, Entry} -> maps:put(HttpPath, Entry, AccCache);
not_found -> AccCache
end,
src/fd_sfc_entry.erl → src/fd_httpd_sfc_entry.erl
+2 -1
View File
@@ -1,7 +1,8 @@
% @doc non-servery functions for static file caching
%
% this spams the filesystem, so it's not "pure" code
-module(fd_sfc_entry).
-module(fd_httpd_sfc_entry).
-vsn("0.2.0").
-export_type([
encoding/0,
src/fd_http_utils.erl → src/fd_httpd_utils.erl
+7 -3
View File
@@ -1,5 +1,6 @@
% @doc http utility functions
-module(fd_http_utils).
-module(fd_httpd_utils).
-vsn("0.2.0").
-export([
new_cookie/0,
@@ -7,7 +8,10 @@
http_err/2,
respond/2,
fmtresp/1
])
]).
-include("http.hrl").
-include("$zx_include/zx_logger.hrl").
-spec new_cookie() -> Cookie
@@ -110,6 +114,6 @@ add_headers(Hs, Body) ->
default_headers(Body) ->
BodySize = byte_size(iolist_to_binary(Body)),
#{"Server" => "fewd 0.1.0",
#{"Server" => "fewd 0.2.0",
"Date" => qhl:ridiculous_web_date(),
"Content-Length" => io_lib:format("~p", [BodySize])}.
src/fd_httpd_webrtc.erl
+174
View File
@@ -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
+9 -21
View File
@@ -12,7 +12,7 @@
%%% @end
-module(fd_sup).
-vsn("0.1.0").
-vsn("0.2.0").
-behaviour(supervisor).
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
@@ -36,29 +36,17 @@ start_link() ->
init([]) ->
RestartStrategy = {one_for_one, 1, 60},
Clients = {fd_clients,
{fd_clients, start_link, []},
WFCd = {fd_wfcd,
{fd_wfcd, start_link, []},
permanent,
5000,
supervisor,
[fd_clients]},
Chat = {fd_chat,
{fd_chat, start_link, []},
[fd_wfcd]},
Httpd = {fd_httpd,
{fd_httpd, start_link, []},
permanent,
5000,
worker,
[fd_chat]},
FileCache = {fd_sfc,
{fd_sfc, start_link, []},
permanent,
5000,
worker,
[fd_sfc]},
Cache = {fd_cache,
{fd_cache, start_link, []},
permanent,
5000,
worker,
[fd_cache]},
Children = [Clients, Chat, FileCache, Cache],
supervisor,
[fd_httpd]},
Children = [WFCd, Httpd],
{ok, {RestartStrategy, Children}}.
src/fd_tetris.erl
-88
View File
@@ -1,88 +0,0 @@
% @doc tetris
%
% manages state for a single game of tetris
%
% sends parent process messages `{tetris, String}` where String is an encoded
% JSON blob meant to be sent to the page script in /priv/static/js/ts/tetris.ts
%
% Refs:
% 1. https://www.erlang.org/docs/24/man/gen_server
-module(fd_tetris).
-behavior(gen_server).
-export([
%% caller context
start_link/0,
%% process context
%% gen_server callbacks
init/1, handle_call/3, handle_cast/2, handle_info/2,
code_change/3, terminate/2
]).
-include("$zx_include/zx_logger.hrl").
-record(s, {parent :: pid()}).
-type state() :: #s{}.
%%-----------------------------------------------------------------------------
%% caller context below this line
%%-----------------------------------------------------------------------------
-spec ws_msg(Tetris, Message) -> ok
when Tetris :: pid(),
Message :: fd_ws:ws_msg().
ws_msg(Tetris, Msg) ->
gen_server:cast(Tetris, {ws_msg, Msg}).
-spec start_link() -> {ok, pid()} | {error, term()}.
start_link() ->
gen_server:start_link(?MODULE, [self()], []).
%%-----------------------------------------------------------------------------
%% process context below this line
%%-----------------------------------------------------------------------------
%% gen_server callbacks
-spec init(Args) -> {ok, State}
when Args :: [Parent],
Parent :: pid(),
State :: state().
init([Parent]) ->
tell("~tp:~tp starting fd_tetris with parent ~p", [?MODULE, self(), Parent]),
self() ! {poop, 0},
InitState = #s{parent = Parent},
{ok, InitState}.
handle_call(Unexpected, From, State) ->
tell("~tp:~tp unexpected call from ~tp: ~tp", [?MODULE, self(), From, Unexpected]),
{noreply, State}.
handle_cast(Unexpected, State) ->
tell("~tp:~tp unexpected cast: ~tp", [?MODULE, self(), Unexpected]),
{noreply, State}.
handle_info({poop, N}, State = #s{parent = Parent}) ->
Parent ! {tetris, io_lib:format("poop~p", [N])},
erlang:send_after(1_000, self(), {poop, N+1}),
{noreply, State};
handle_info(Unexpected, State) ->
tell("~tp:~tp unexpected info: ~tp", [?MODULE, self(), Unexpected]),
{noreply, State}.
code_change(_, State, _) ->
{ok, State}.
terminate(_, _) ->
ok.
src/fd_wfcd.erl
+33
View File
@@ -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_cache.erl → src/fd_wfcd_cache.erl
+2 -1
View File
@@ -1,5 +1,6 @@
% @doc storing map #{cookie := Context}
-module(fd_cache).
-module(fd_wfcd_cache).
-vsn("0.2.0").
-behavior(gen_server).
src/fd_wsp.erl
-102
View File
@@ -1,102 +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: fd_ws:ws_msg()}'
%
% for each websocket message it gets
-module(fd_wsp).
-behavior(gen_server).
-export_type([
]).
-export([
%% caller context
handshake/0,
start_link/0,
%% 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 fd_ws:handshake(HandshakeReq) of
{ok, Response} ->
ok = fd_http_utils:respond(Sock, Response),
InitState = #s{socket = Socket},
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}) ->
handle_info(Unexpected, State) ->
tell("~tp: unexpected info: ~tp", [?MODULE, Unexpected]),
{noreply, State}.
code_change(_, State, _) ->
{ok, State}.
terminate(_, _) ->
ok.
%%-----------------------------------------------------------------------------
%% internals
%%-----------------------------------------------------------------------------
src/fewd.erl
+3 -3
View File
@@ -3,7 +3,7 @@
%%% @end
-module(fewd).
-vsn("0.1.0").
-vsn("0.2.0").
-behavior(application).
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
@@ -24,7 +24,7 @@
%% Returns an {error, Reason} tuple if it is already listening.
listen(PortNum) ->
fd_client_man:listen(PortNum).
fd_httpd_client_man:listen(PortNum).
-spec ignore() -> ok.
@@ -32,7 +32,7 @@ listen(PortNum) ->
%% Make the server stop listening if it is, or continue to do nothing if it isn't.
ignore() ->
fd_client_man:ignore().
fd_httpd_client_man:ignore().
-spec start(normal, term()) -> {ok, pid()}.
src/fd_ws.erl → src/qhl_ws.erl
+87 -8
View File
@@ -1,7 +1,8 @@
% @doc websockets
%
% ref: https://datatracker.ietf.org/doc/html/rfc6455
-module(fd_ws).
-module(qhl_ws).
-vsn("0.2.0").
-export_type([
opcode/0,
@@ -15,11 +16,12 @@
%% 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").
-include("$zx_include/zx_logger.hrl").
-define(MAX_PAYLOAD_SIZE, ((1 bsl 63) - 1)).
@@ -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(),
@@ -632,11 +715,8 @@ recv_frame_await(Frame, Sock, Received, Timeout) ->
% @end
send(Socket, {Type, Payload}) ->
log(info, "fd_ws: send(~tp, {~tp, ~tp})", [Socket, Type, Payload]),
BPayload = payload_to_binary(Payload),
log(info, "fd_ws: BPayload = ~tp", [BPayload]),
Frame = message_to_frame(Type, BPayload),
log(info, "fd_ws: Frame = ~tp", [Frame]),
send_frame(Socket, Frame).
payload_to_binary(Bin) when is_binary(Bin) -> Bin;
@@ -675,7 +755,6 @@ message_to_frame(Control, Payload)
send_frame(Sock, Frame) ->
Binary = render_frame(Frame),
log(info, "send_frame: rendered frame: ~tp", [Binary]),
gen_tcp:send(Sock, Binary).
src/wfc.erl
+1
View File
@@ -1,6 +1,7 @@
% @doc
% porcelain wfc ops
-module(wfc).
-vsn("0.2.0").
-export_type([
sentence/0
src/wfc_bm.erl
+1
View File
@@ -1,6 +1,7 @@
% @doc
% bit matrices
-module(wfc_bm).
-vsn("0.2.0").
-export_type([
bit/0,
src/wfc_eval.erl
+1
View File
@@ -1,4 +1,5 @@
-module(wfc_eval).
-vsn("0.2.0").
-export_type([
]).
src/wfc_eval_context.erl
+1
View File
@@ -1,4 +1,5 @@
-module(wfc_eval_context).
-vsn("0.2.0").
-export_type([
context/0
src/wfc_ltr.erl
+1
View File
@@ -7,6 +7,7 @@
%
% mathematically, this is a variable like "a", "b", "c", etc
-module(wfc_ltr).
-vsn("0.2.0").
-export_type([
ltr/0
src/wfc_pp.erl
+1
View File
@@ -1,4 +1,5 @@
-module(wfc_pp).
-vsn("0.2.0").
-export([
eval_result/1,
src/wfc_read.erl
+1
View File
@@ -1,4 +1,5 @@
-module(wfc_read).
-vsn("0.2.0").
-export_type([
]).
src/wfc_sentence.erl
+1
View File
@@ -6,6 +6,7 @@
%
% empty sentence is 0
-module(wfc_sentence).
-vsn("0.2.0").
-export_type([
sentence/0
src/wfc_sftt.erl
+1
View File
@@ -1,6 +1,7 @@
% @doc
% sentence-fun <-> truth table logic
-module(wfc_sftt).
-vsn("0.2.0").
-export_type([
sf/0, tt/0
src/wfc_ttfuns.erl
+1
View File
@@ -1,6 +1,7 @@
% @doc
% library of truth tables
-module(wfc_ttfuns).
-vsn("0.2.0").
-export_type([
bit/0,
src/wfc_utils.erl
+1
View File
@@ -1,5 +1,6 @@
% @doc misc utility functions
-module(wfc_utils).
-vsn("0.2.0").
-export([err/2, str/2, emsg/2]).
src/wfc_word.erl
+1
View File
@@ -13,6 +13,7 @@
%
% operations assume all inputs are valid
-module(wfc_word).
-vsn("0.2.0").
-export_type([
word/0
src/zj.erl
-694
View File
@@ -1,694 +0,0 @@
%%% @doc
%%% ZJ: The tiny JSON parser
%%%
%%% This module exports four functions and accepts no options.
%%% @end
-module(zj).
-vsn("1.1.2").
-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
+3 -3
View File
@@ -1,11 +1,11 @@
{name,"front end web development lab"}.
{type,app}.
{modules,[]}.
{author,"Peter Harpending"}.
{prefix,"fd"}.
{desc,"Front End Web Dev in Erlang stuff"}.
{author,"Peter Harpending"}.
{package_id,{"otpr","fewd",{0,1,0}}}.
{deps,[]}.
{package_id,{"otpr","fewd",{0,2,0}}}.
{deps,[{"otpr","zj",{1,1,2}}]}.
{key_name,none}.
{a_email,"peterharpending@qpq.swiss"}.
{c_email,"peterharpending@qpq.swiss"}.