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

Compare commits

merge into: pharpend:master
Branches Tags
pharpend:master
pharpend:f-qrdemo
pharpend:develop
pharpend:staging
pharpend:0.1.0
...
pull from: pharpend:f-qrdemo
Branches Tags
pharpend:f-qrdemo
pharpend:develop
pharpend:staging
pharpend:master
pharpend:0.1.0

13 Commits
master ... f-qrdemo

Author SHA1 Message Date
Peter Harpending
9adbf67ebd shed biketh 2025-12-30 11:45:25 -08:00
Peter Harpending
ee35e6cf1f HTML BIKESHED 2025-12-29 15:41:29 -08:00
Peter Harpending
3343dcf137 basic grids demo seems to work... 2025-12-29 14:04:03 -08:00
Peter Harpending
f0d1097f1f qr demo 2025-12-29 08:49:42 -08:00
Peter Harpending
60803b4a4e start grids qr demo 2025-12-19 17:47:31 -08:00
Peter Harpending
139f9cb9e4 add qr as a dep 2025-12-17 17:34:08 -08:00
Peter Harpending
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
Peter Harpending
57e7254f8d wip: updating version 2025-12-16 22:18:51 -08:00
Peter Harpending
e379a86020 remove references and links to broken features 2025-12-16 22:11:27 -08:00
Peter Harpending
e160701403 runs 2025-12-16 22:09:10 -08:00
Peter Harpending
cbfc496057 renaming/deleting 
:wq
 2025-12-12 23:21:00 -08:00
Peter Harpending
ff257ae976 wip: renaming 2025-11-19 10:57:23 -08:00
Peter Harpending
e12466d5f2 start renaming 2025-10-31 12:33:11 -07:00
50 changed files with 1417 additions and 1654 deletions
Show Stats Expand all files Collapse all files

7
NOTES.txt
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 VIDEO 1 - 2025-09-16
TODONE TODONE
- add qhl as dep - add qhl as dep

40
README.md
View File

@ -1,9 +1,43 @@
# fewd = front end web dev fewd = front end web dev
=====================================================================
this is me (PRH) trying to learn some front end web dev because pixels are this is me (PRH) trying to learn some front end web dev because pixels are
important despite my wishes. important despite my wishes.
# notes Building/Running
---------------------------------------------------------------------
## goal queue ### Prereqs
1. [Install Erlang and ZX](https://git.qpq.swiss/QPQ-AG/research-megadoc/wiki/Installing-Erlang-and-zx)
2. **DEV ONLY**: `apt install node-typescript` (Devuan Excalibur)
This is needed if you want to **edit** the `.ts` files found in
`/priv/static/js/ts/*.ts`. The built JS files are under version control and can
be found in `/priv/static/js/dist/`
### Building/Running HTTP Server
If you are only changing the Erlang or simply just want to run the program
without developing it, then just run
```
zxh runlocal
```
### Building TS->JS
**This is only necessary if you edited the `.ts` files and want to transpile
them over to JS.**
This requires you installed `tsc` as above.
```
make tsc
```
If you're doing development you may want
```
make watch
```

11
ebin/fewd.app
View File

@ -3,7 +3,12 @@
{registered,[]}, {registered,[]},
{included_applications,[]}, {included_applications,[]},
{applications,[stdlib,kernel]}, {applications,[stdlib,kernel]},
{vsn,"0.1.0"}, {vsn,"0.2.0"},
{modules,[fd_client,fd_client_man,fd_client_sup,fd_clients, {modules,[fd_httpd,fd_httpd_client,fd_httpd_client_man,
fd_sup,fewd]}, 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,[]}}]}. {mod,{fewd,[]}}]}.

0
priv/skel/css.css Normal file
View File

8
priv/static/tetris.html → priv/skel/html.html
View File

@ -2,9 +2,8 @@
<html lang="en"> <html lang="en">
<head> <head>
<meta charset="utf-8"> <meta charset="utf-8">
<title>Tetris with Websockets</title> <title>FIXME</title>
<link rel="stylesheet" href="/css/default.css"> <link rel="stylesheet" href="/css/default.css">
<link rel="stylesheet" href="/css/tetris.css">
</head> </head>
<body> <body>
<div id="titlebar"> <div id="titlebar">
@ -14,11 +13,8 @@
</div> </div>
<div class="content"> <div class="content">
<h1 class="content-title">Tetris</h1> <h1 class="content-title">FEWD: FIXME</h1>
<textarea id="tetris-state"></textarea>
</div> </div>
<script type="module" src="./js/dist/tetris.js"></script>
</body> </body>
</html> </html>

9
priv/skel/ts.ts Normal file
View File

@ -0,0 +1,9 @@
/**
* Title: Title
* Description: Description
* Author: Peter Harpending <peterharpending@qpq.swiss>
* Date: YYYY-MM-DD
* Last-Updated: YYYY-MM-DD
*
* @module
*/

106
priv/static/chat.html
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>

59
priv/static/grids-basic.html Normal file
View File

@ -0,0 +1,59 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>Basic GRIDS 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: GRIDS DEMO</h1>
<h2>Making a Spend</h2>
<label for="grids-n">Network ID:</label>
<input type = "text"
id = "grids-n"
value = "groot.testnet"
disabled>
<br>
<label for="grids-r">Recipient:</label>
<input type = "text"
id = "grids-r"
value = "ak_n6aVQ6PkBdVdv7kRRcfnzDVmBsH6hqEwVWSB6UAEb3kkjrPMe"
disabled>
<br>
<label for="grids-a">Amount (P):</label>
<input type = "number"
id = "grids-a"
value = "6000000">
<br>
<label for="grids-p">Payload:</label>
<input type = "text"
id = "grids-p"
value = "test payload">
<br>
<input type = "button"
id = "grids-submit"
value = "Generate">
<br>
<textarea disabled id="grids-url" hidden></textarea>
<br>
<img id="grids-png" hidden>
</div>
<script src="/js/dist/grids-basic.js"></script>
</body>
</html>

3
priv/static/index.html
View File

@ -16,9 +16,8 @@
<h1 class="content-title">FEWD: index</h1> <h1 class="content-title">FEWD: index</h1>
<ul> <ul>
<li><a href="/chat.html">Chatroom</a></li>
<li><a href="/echo.html">Echo</a></li> <li><a href="/echo.html">Echo</a></li>
<li><a href="/tetris.html">Tetris</a></li> <li><a href="/grids-basic.html">GRIDS: Basic Demo</a></li>
<li><a href="/wfc.html">WFC</a></li> <li><a href="/wfc.html">WFC</a></li>
</ul> </ul>
</div> </div>

29
priv/static/js/dist/grids-basic.d.ts vendored Normal file
View File

@ -0,0 +1,29 @@
/**
* Title: GRIDS Basic Page Script
* Description: Page Script for /grids-basic.html
* Author: Peter Harpending <peterharpending@qpq.swiss>
* Date: 2025-12-29
* Last-Updated: 2025-12-29
*
* @module
*/
/**
* Runs on page load
*/
declare function main(): Promise<void>;
declare function on_submit(n_input: HTMLInputElement, r_input: HTMLInputElement, a_input: HTMLInputElement, p_input: HTMLInputElement, grids_url_elt: HTMLTextAreaElement, grids_png_elt: HTMLImageElement): Promise<void>;
type Safe<t> = {
ok: true;
result: t;
} | {
ok: false;
error: string;
};
type GridsResult = {
url: string;
png_base64: string;
};
/**
* gets the grids url
*/
declare function grids_request(net_id: string, recipient: string, amount: number, payload: string): Promise<Safe<GridsResult>>;

83
priv/static/js/dist/grids-basic.js vendored Normal file
View File

@ -0,0 +1,83 @@
"use strict";
/**
* Title: GRIDS Basic Page Script
* Description: Page Script for /grids-basic.html
* Author: Peter Harpending <peterharpending@qpq.swiss>
* Date: 2025-12-29
* Last-Updated: 2025-12-29
*
* @module
*/
main();
/**
* Runs on page load
*/
async function main() {
let n_input = document.getElementById('grids-n');
let r_input = document.getElementById('grids-r');
let a_input = document.getElementById('grids-a');
let p_input = document.getElementById('grids-p');
let submit_btn = document.getElementById('grids-submit');
let grids_url_elt = document.getElementById('grids-url');
let grids_png_elt = document.getElementById('grids-png');
// Page initialization
submit_btn.addEventListener('click', async function (e) {
await on_submit(n_input, r_input, a_input, p_input, grids_url_elt, grids_png_elt);
});
// enable buttons
submit_btn.disabled = false;
}
async function on_submit(n_input, r_input, a_input, p_input, grids_url_elt, grids_png_elt) {
// pull out values
let network_id = n_input.value;
let recipient = r_input.value;
let amount = parseInt(a_input.value);
let payload = p_input.value;
let result = await grids_request(network_id, recipient, amount, payload);
// show url field and png
if (result.ok) {
let url = result.result.url;
let png_base64 = result.result.png_base64;
let src_prefix = 'data:image/png;base64,';
let src = src_prefix + png_base64;
grids_url_elt.innerText = url;
grids_png_elt.src = src;
grids_url_elt.hidden = false;
grids_png_elt.hidden = false;
}
else {
alert('ERROR: ' + result.error);
}
}
/**
* gets the grids url
*/
async function grids_request(net_id, recipient, amount, payload) {
// format for network transmission
let obj = { 'network_id': net_id,
'recipient': recipient,
'amount': amount,
'payload': payload };
let obj_text = JSON.stringify(obj, undefined, 4);
let url = '/grids-spend';
let req_options = { method: 'POST',
headers: { 'content-type': 'application/json' },
body: obj_text };
let result = { ok: false,
error: 'IT DO BE LIKE THAT MISTA STANCIL' };
try {
let response = await fetch(url, req_options);
if (response.ok)
result = await response.json();
else {
console.log('bad http response:', response);
result = { ok: false, error: 'BAD HTTP RESPONSE' };
}
}
catch (x) {
console.log('network error:', x);
result = { ok: false, error: 'NETWORK ERROR' };
}
return result;
}
//# sourceMappingURL=grids-basic.js.map

1
priv/static/js/dist/grids-basic.js.map vendored Normal file
View File

@ -0,0 +1 @@
{"version":3,"file":"grids-basic.js","sourceRoot":"","sources":["../ts/grids-basic.ts"],"names":[],"mappings":";AAAA;;;;;;;;GAQG;AAEH,IAAI,EAAE,CAAC;AAGP;;GAEG;AACH,KAAK,UACL,IAAI;IAGA,IAAI,OAAO,GAAM,QAAQ,CAAC,cAAc,CAAC,SAAS,CAA0B,CAAC;IAC7E,IAAI,OAAO,GAAM,QAAQ,CAAC,cAAc,CAAC,SAAS,CAA0B,CAAC;IAC7E,IAAI,OAAO,GAAM,QAAQ,CAAC,cAAc,CAAC,SAAS,CAA0B,CAAC;IAC7E,IAAI,OAAO,GAAM,QAAQ,CAAC,cAAc,CAAC,SAAS,CAA0B,CAAC;IAC7E,IAAI,UAAU,GAAG,QAAQ,CAAC,cAAc,CAAC,cAAc,CAAqB,CAAC;IAE7E,IAAI,aAAa,GAAG,QAAQ,CAAC,cAAc,CAAC,WAAW,CAAwB,CAAC;IAChF,IAAI,aAAa,GAAG,QAAQ,CAAC,cAAc,CAAC,WAAW,CAAqB,CAAC;IAE7E,sBAAsB;IACtB,UAAU,CAAC,gBAAgB,CACvB,OAAO,EACP,KAAK,WAAU,CAAC;QACZ,MAAM,SAAS,CAAC,OAAO,EAAE,OAAO,EAAE,OAAO,EAAE,OAAO,EAAE,aAAa,EAAE,aAAa,CAAC,CAAA;IACrF,CAAC,CACJ,CAAC;IAEF,iBAAiB;IACjB,UAAU,CAAC,QAAQ,GAAG,KAAK,CAAC;AAChC,CAAC;AAED,KAAK,UACL,SAAS,CACJ,OAAgC,EAChC,OAAgC,EAChC,OAAgC,EAChC,OAAgC,EAChC,aAAmC,EACnC,aAAgC;IAGjC,kBAAkB;IAClB,IAAI,UAAU,GAAY,OAAO,CAAC,KAAK,CAAC;IACxC,IAAI,SAAS,GAAa,OAAO,CAAC,KAAK,CAAC;IACxC,IAAI,MAAM,GAAgB,QAAQ,CAAC,OAAO,CAAC,KAAK,CAAC,CAAC;IAClD,IAAI,OAAO,GAAe,OAAO,CAAC,KAAK,CAAC;IAExC,IAAI,MAAM,GAAsB,MAAM,aAAa,CAAC,UAAU,EAAE,SAAS,EAAE,MAAM,EAAE,OAAO,CAAC,CAAC;IAE5F,yBAAyB;IACzB,IAAI,MAAM,CAAC,EAAE,EAAE;QACX,IAAI,GAAG,GAAmB,MAAM,CAAC,MAAM,CAAC,GAAG,CAAC;QAC5C,IAAI,UAAU,GAAY,MAAM,CAAC,MAAM,CAAC,UAAU,CAAC;QAEnD,IAAI,UAAU,GAAY,wBAAwB,CAAA;QAElD,IAAI,GAAG,GAAG,UAAU,GAAG,UAAU,CAAC;QAElC,aAAa,CAAC,SAAS,GAAG,GAAG,CAAC;QAC9B,aAAa,CAAC,GAAG,GAAS,GAAG,CAAC;QAE9B,aAAa,CAAC,MAAM,GAAG,KAAK,CAAC;QAC7B,aAAa,CAAC,MAAM,GAAG,KAAK,CAAC;KAChC;SACI;QACD,KAAK,CAAC,SAAS,GAAG,MAAM,CAAC,KAAK,CAAC,CAAC;KACnC;AACL,CAAC;AASD;;GAEG;AACH,KAAK,UACL,aAAa,CACR,MAAkB,EAClB,SAAkB,EAClB,MAAkB,EAClB,OAAkB;IAGnB,kCAAkC;IAClC,IAAI,GAAG,GAAiB,EAAC,YAAY,EAAG,MAAM;QACrB,WAAW,EAAI,SAAS;QACxB,QAAQ,EAAO,MAAM;QACrB,SAAS,EAAM,OAAO,EAAC,CAAC;IACjD,IAAI,QAAQ,GAAY,IAAI,CAAC,SAAS,CAAC,GAAG,EAAE,SAAS,EAAE,CAAC,CAAC,CAAC;IAG1D,IAAI,GAAG,GAAG,cAAc,CAAC;IACzB,IAAI,WAAW,GAAI,EAAC,MAAM,EAAG,MAAM;QACf,OAAO,EAAE,EAAC,cAAc,EAAE,kBAAkB,EAAC;QAC7C,IAAI,EAAK,QAAQ,EAAC,CAAC;IAGvC,IAAI,MAAM,GACF,EAAC,EAAE,EAAM,KAAK;QACb,KAAK,EAAG,kCAAkC,EAAC,CAAC;IAErD,IAAI;QACA,IAAI,QAAQ,GAAc,MAAM,KAAK,CAAC,GAAG,EAAE,WAAW,CAAC,CAAC;QACxD,IAAI,QAAQ,CAAC,EAAE;YACX,MAAM,GAAG,MAAM,QAAQ,CAAC,IAAI,EAAuB,CAAC;aACnD;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"}

2
priv/static/js/dist/libfewd.js.map vendored
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"}

2
priv/static/js/dist/wfc.js.map vendored
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"}

131
priv/static/js/ts/grids-basic.ts Normal file
View File

@ -0,0 +1,131 @@
/**
* Title: GRIDS Basic Page Script
* Description: Page Script for /grids-basic.html
* Author: Peter Harpending <peterharpending@qpq.swiss>
* Date: 2025-12-29
* Last-Updated: 2025-12-29
*
* @module
*/
main();
/**
* Runs on page load
*/
async function
main
()
{
let n_input = document.getElementById('grids-n') as HTMLInputElement;
let r_input = document.getElementById('grids-r') as HTMLInputElement;
let a_input = document.getElementById('grids-a') as HTMLInputElement;
let p_input = document.getElementById('grids-p') as HTMLInputElement;
let submit_btn = document.getElementById('grids-submit') as HTMLInputElement;
let grids_url_elt = document.getElementById('grids-url') as HTMLTextAreaElement;
let grids_png_elt = document.getElementById('grids-png') as HTMLImageElement;
// Page initialization
submit_btn.addEventListener(
'click',
async function(e) {
await on_submit(n_input, r_input, a_input, p_input, grids_url_elt, grids_png_elt)
}
);
// enable buttons
submit_btn.disabled = false;
}
async function
on_submit
(n_input : HTMLInputElement,
r_input : HTMLInputElement,
a_input : HTMLInputElement,
p_input : HTMLInputElement,
grids_url_elt : HTMLTextAreaElement,
grids_png_elt : HTMLImageElement)
: Promise<void>
{
// pull out values
let network_id : string = n_input.value;
let recipient : string = r_input.value;
let amount : number = parseInt(a_input.value);
let payload : string = p_input.value;
let result: Safe<GridsResult> = await grids_request(network_id, recipient, amount, payload);
// show url field and png
if (result.ok) {
let url : string = result.result.url;
let png_base64 : string = result.result.png_base64;
let src_prefix : string = 'data:image/png;base64,'
let src = src_prefix + png_base64;
grids_url_elt.innerText = url;
grids_png_elt.src = src;
grids_url_elt.hidden = false;
grids_png_elt.hidden = false;
}
else {
alert('ERROR: ' + result.error);
}
}
type Safe<t> = {ok: true, result: t}
| {ok: false, error: string};
type GridsResult = {url : string,
png_base64: string};
/**
* gets the grids url
*/
async function
grids_request
(net_id : string,
recipient : string,
amount : number,
payload : string)
: Promise<Safe<GridsResult>>
{
// format for network transmission
let obj : object = {'network_id' : net_id,
'recipient' : recipient,
'amount' : amount,
'payload' : payload};
let obj_text : string = JSON.stringify(obj, undefined, 4);
let url = '/grids-spend';
let req_options = {method: 'POST',
headers: {'content-type': 'application/json'},
body: obj_text};
let result: Safe<GridsResult> =
{ok : false,
error : 'IT DO BE LIKE THAT MISTA STANCIL'};
try {
let response : Response = await fetch(url, req_options);
if (response.ok)
result = await response.json() as Safe<GridsResult>;
else {
console.log('bad http response:', response);
result = {ok: false, error: 'BAD HTTP RESPONSE'};
}
}
catch (x: any) {
console.log('network error:', x);
result = {ok: false, error: 'NETWORK ERROR'};
}
return result;
}

105
src/et_piece.erl
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}.

79
src/et_well.erl
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).

262
src/fd_chat.erl
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.

170
src/fd_gridsd.erl Normal file
View File

@ -0,0 +1,170 @@
% @doc grids cache
-module(fd_gridsd).
-vsn("0.2.0").
-behavior(gen_server).
-export_type([
]).
-export([
%% caller context
mk_spend/4,
%% api
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").
%% for craig's autism
-record(sp,
{recipient :: string(),
amount :: non_neg_integer(),
payload :: binary()}).
-type search_pattern() :: #sp{}.
-type sp() :: search_pattern().
-record(s,
{looking_for = [] :: [{sp(), NotifyWhenSeen :: pid()}]}).
-type state() :: #s{}.
%%-----------------------------------------------------------------------------
%% caller context
%%-----------------------------------------------------------------------------
-spec mk_spend(NetworkId, Recipient, Amount, Payload) -> Result
when NetworkId :: string(),
Recipient :: string(),
Amount :: non_neg_integer(),
Payload :: binary(),
Result :: {ok, URL, QR_PNG}
| {error, string()},
URL :: string(),
QR_PNG :: binary().
% @doc
% Very important: amount MUST be an integer >= 0
mk_spend(NetworkId, Recipient, Amount, Payload) ->
gen_server:call(?MODULE, {mk_spend, NetworkId, Recipient, Amount, Payload}).
%% gen_server callbacks
start_link() ->
gen_server:start_link({local, ?MODULE}, ?MODULE, none, []).
%%-----------------------------------------------------------------------------
%% process context below this line
%%-----------------------------------------------------------------------------
%% gen_server callbacks
init(none) ->
tell("starting fd_gridsd"),
InitState = #s{},
{ok, InitState}.
handle_call({mk_spend, NetworkId, Recipient, Amount, Payload}, From, State) ->
case i_mk_spend(NetworkId, Recipient, Amount, Payload, From, State) of
{ok, URL, PNG, NewState} -> {reply, {ok, URL, PNG}, NewState};
Error -> {reply, Error, State}
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(Unexpected, State) ->
tell("~tp: unexpected info: ~tp", [?MODULE, Unexpected]),
{noreply, State}.
code_change(_, State, _) ->
{ok, State}.
terminate(_, _) ->
ok.
%%-----------------------------------------------------------------------------
%% internals
%%-----------------------------------------------------------------------------
-spec i_mk_spend(NetworkId, Recipient, Amount, Payload, From, State) -> Result
when NetworkId :: string(),
Recipient :: string(),
Amount :: non_neg_integer(),
Payload :: binary(),
From :: {pid(), reference()},
State :: state(),
Result :: {ok, URL, QR_PNG, NewState}
| {error, string()},
URL :: string(),
QR_PNG :: binary(),
NewState :: state().
i_mk_spend(NetworkId, Recipient, Amount, Payload, {FromPID, _}, State)
when is_integer(Amount), Amount >= 0,
is_binary(Payload) ->
URL = gmgrids:encode({spend, NetworkId, Recipient},
[{amount, Amount},
{payload, Payload}]),
URLBin = unicode:characters_to_binary(URL),
PNG = qr:encode_png(URLBin),
case i_register(Recipient, Amount, Payload, FromPID, State) of
{ok, NewState} -> {ok, URL, PNG, NewState};
Error -> Error
end;
i_mk_spend(_, _, Amount, _, _, _) when (not is_integer(Amount)) ->
{error, "non_integer_amount"};
i_mk_spend(_, _, Amount, _, _, _) when Amount < 0 ->
{error, "negative_amount"};
i_mk_spend(_, _, _, _, _, _) ->
{error, "bad_payload"}.
i_register(Recipient, Amount, Payload, FromPID, State = #s{looking_for = Patterns}) ->
SP = i_sp(Recipient, Amount, Payload),
case i_lookup(SP, State) of
not_found ->
NewPattern = {SP, FromPID},
NewPatterns = [NewPattern | Patterns],
NewState = State#s{looking_for = NewPatterns},
{ok, NewState};
{found, _} ->
{error, already_registered}
end.
%% future proofing
i_sp(Recipient, Amount, Payload) ->
{sp, Recipient, Amount, Payload}.
-spec i_lookup(SearchPattern, State) -> Result
when SearchPattern :: sp(),
State :: state(),
Result :: {found, NotifyPID :: pid()}
| not_found.
% @private look up search pattern and see if we're looking for it
i_lookup(SearchPattern, State) ->
#s{looking_for = Patterns} = State,
case lists:keyfind(SearchPattern, 1, Patterns) of
false -> not_found;
{_, Notify} -> {found, Notify}
end.

39
src/fd_httpd.erl Normal file
View File

@ -0,0 +1,39 @@
-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},
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 = [FileCache, Clients],
{ok, {RestartStrategy, Children}}.

189
src/fd_client.erl → src/fd_httpd_client.erl
View File

@ -13,8 +13,8 @@
%%% http://erlang.org/doc/design_principles/spec_proc.html %%% http://erlang.org/doc/design_principles/spec_proc.html
%%% @end %%% @end
-module(fd_client). -module(fd_httpd_client).
-vsn("0.1.0"). -vsn("0.2.0").
-author("Peter Harpending <peterharpending@qpq.swiss>"). -author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>"). -copyright("Peter Harpending <peterharpending@qpq.swiss>").
-license("BSD-2-Clause-FreeBSD"). -license("BSD-2-Clause-FreeBSD").
@ -52,11 +52,11 @@
| {shutdown, term()} | {shutdown, term()}
| term(). | term().
%% @private %% @private
%% How the fd_client_man or a prior fd_client kicks things off. %% How the fd_httpd_client_man or a prior fd_httpd_client kicks things off.
%% This is called in the context of fd_client_man or the prior fd_client. %% This is called in the context of fd_httpd_client_man or the prior fd_httpd_client.
start(ListenSocket) -> start(ListenSocket) ->
fd_client_sup:start_acceptor(ListenSocket). fd_httpd_client_sup:start_acceptor(ListenSocket).
-spec start_link(ListenSocket) -> Result -spec start_link(ListenSocket) -> Result
@ -67,7 +67,7 @@ start(ListenSocket) ->
| {shutdown, term()} | {shutdown, term()}
| term(). | term().
%% @private %% @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 %% (essentially requesting a new worker be started by the supervisor), this is
%% actually called in the context of the supervisor. %% actually called in the context of the supervisor.
@ -86,7 +86,7 @@ start_link(ListenSocket) ->
%% call to listen/3. %% call to listen/3.
init(Parent, ListenSocket) -> init(Parent, ListenSocket) ->
ok = io:format("~p Listening.~n", [self()]), ok = tell("~p Listening.~n", [self()]),
Debug = sys:debug_options([]), Debug = sys:debug_options([]),
ok = proc_lib:init_ack(Parent, {ok, self()}), ok = proc_lib:init_ack(Parent, {ok, self()}),
listen(Parent, Debug, ListenSocket). listen(Parent, Debug, ListenSocket).
@ -98,7 +98,7 @@ init(Parent, ListenSocket) ->
ListenSocket :: gen_tcp:socket(). ListenSocket :: gen_tcp:socket().
%% @private %% @private
%% This function waits for a TCP connection. The owner of the socket is still %% 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 %% 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 %% is one way a manager process can gracefully unblock child workers that are blocking
%% on a network accept. %% on a network accept.
@ -110,12 +110,12 @@ listen(Parent, Debug, ListenSocket) ->
{ok, Socket} -> {ok, Socket} ->
{ok, _} = start(ListenSocket), {ok, _} = start(ListenSocket),
{ok, Peer} = inet:peername(Socket), {ok, Peer} = inet:peername(Socket),
ok = io:format("~p Connection accepted from: ~p~n", [self(), Peer]), ok = tell("~p Connection accepted from: ~p~n", [self(), Peer]),
ok = fd_client_man:enroll(), ok = fd_httpd_client_man:enroll(),
State = #s{socket = Socket}, State = #s{socket = Socket},
loop(Parent, Debug, State); loop(Parent, Debug, State);
{error, closed} -> {error, closed} ->
ok = io:format("~p Retiring: Listen socket closed.~n", [self()]), ok = tell("~p Retiring: Listen socket closed.~n", [self()]),
exit(normal) exit(normal)
end. end.
@ -142,17 +142,17 @@ loop(Parent, Debug, State = #s{socket = Socket, next = Next0}) ->
%% should trigger bad request %% should trigger bad request
tell(error, "~p QHL parse error: ~tp", [?LINE, Error]), tell(error, "~p QHL parse error: ~tp", [?LINE, Error]),
tell(error, "~p bad request:~n~ts", [?LINE, Received]), 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), gen_tcp:shutdown(Socket, read_write),
exit(normal) exit(normal)
end; end;
{tcp_closed, Socket} -> {tcp_closed, Socket} ->
ok = io:format("~p Socket closed, retiring.~n", [self()]), ok = tell("~p Socket closed, retiring.~n", [self()]),
exit(normal); exit(normal);
{system, From, Request} -> {system, From, Request} ->
sys:handle_system_msg(Request, From, Parent, ?MODULE, Debug, State); sys:handle_system_msg(Request, From, Parent, ?MODULE, Debug, State);
Unexpected -> Unexpected ->
ok = io:format("~p Unexpected message: ~tp", [self(), Unexpected]), ok = tell("~p Unexpected message: ~tp", [self(), Unexpected]),
loop(Parent, Debug, State) loop(Parent, Debug, State)
end. end.
@ -232,18 +232,18 @@ handle_request(Sock, R = #request{method = M, path = P}, Received) when M =/= un
route(Sock, get, Route, Request, Received) -> route(Sock, get, Route, Request, Received) ->
case Route of case Route of
<<"/ws/tetris">> -> ws_tetris(Sock, Request, Received);
<<"/ws/echo">> -> ws_echo(Sock, Request) , Received; <<"/ws/echo">> -> ws_echo(Sock, Request) , Received;
<<"/">> -> route_static(Sock, <<"/index.html">>) , Received; <<"/">> -> route_static(Sock, <<"/index.html">>) , Received;
_ -> route_static(Sock, Route) , Received _ -> route_static(Sock, Route) , Received
end; end;
route(Sock, post, Route, Request, Received) -> route(Sock, post, Route, Request, Received) ->
case Route of case Route of
<<"/grids-spend">> -> grids_spend(Sock, Request) , Received;
<<"/wfcin">> -> wfcin(Sock, Request) , Received; <<"/wfcin">> -> wfcin(Sock, Request) , Received;
_ -> fd_http_utils:http_err(Sock, 404) , Received _ -> fd_httpd_utils:http_err(Sock, 404) , Received
end; end;
route(Sock, _, _, _, Received) -> route(Sock, _, _, _, Received) ->
fd_http_utils:http_err(Sock, 404), fd_httpd_utils:http_err(Sock, 404),
Received. Received.
@ -253,13 +253,13 @@ route(Sock, _, _, _, Received) ->
Route :: binary(). Route :: binary().
route_static(Sock, Route) -> 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 -spec respond_static(Sock, MaybeEty) -> ok
when Sock :: gen_tcp:socket(), when Sock :: gen_tcp:socket(),
MaybeEty :: fd_sfc:maybe_entry(). MaybeEty :: fd_httpd_sfc:maybe_entry().
respond_static(Sock, {found, Entry}) -> respond_static(Sock, {found, Entry}) ->
% -record(e, {fs_path :: file:filename(), % -record(e, {fs_path :: file:filename(),
@ -268,87 +268,18 @@ respond_static(Sock, {found, Entry}) ->
% encoding :: encoding(), % encoding :: encoding(),
% contents :: binary()}). % contents :: binary()}).
Headers0 = Headers0 =
case fd_sfc_entry:encoding(Entry) of case fd_httpd_sfc_entry:encoding(Entry) of
gzip -> [{"content-encoding", "gzip"}]; gzip -> [{"content-encoding", "gzip"}];
none -> [] none -> []
end, 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, Response = #response{headers = Headers1,
body = fd_sfc_entry:contents(Entry)}, body = fd_httpd_sfc_entry:contents(Entry)},
fd_http_utils:respond(Sock, Response); fd_httpd_utils:respond(Sock, Response);
respond_static(Sock, not_found) -> respond_static(Sock, not_found) ->
fd_http_utils:http_err(Sock, 404). fd_httpd_utils:http_err(Sock, 404).
%% ------------------------------
%% tetris
%% ------------------------------
-spec ws_tetris(Sock, Request, Received) -> NewReceived
when Sock :: gen_tcp:socket(),
Request :: request(),
Received :: binary(),
NewReceived :: binary().
ws_tetris(Sock, Request, Received) ->
.
-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)
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().
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 %% echo
%% ------------------------------ %% ------------------------------
@ -359,17 +290,17 @@ ws_echo(Sock, Request) ->
catch catch
X:Y:Z -> X:Y:Z ->
tell(error, "CRASH ws_echo: ~tp:~tp:~tp", [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. end.
ws_echo2(Sock, Request) -> ws_echo2(Sock, Request) ->
case fd_ws:handshake(Request) of case qhl_ws:handshake(Request) of
{ok, Response} -> {ok, Response} ->
fd_http_utils:respond(Sock, Response), fd_httpd_utils:respond(Sock, Response),
ws_echo_loop(Sock); ws_echo_loop(Sock);
Error -> Error ->
tell("ws_echo: error: ~tp", [Error]), tell("ws_echo: error: ~tp", [Error]),
fd_http_utils:http_err(Sock, 400) fd_httpd_utils:http_err(Sock, 400)
end. end.
ws_echo_loop(Sock) -> ws_echo_loop(Sock) ->
@ -377,18 +308,48 @@ ws_echo_loop(Sock) ->
ws_echo_loop(Sock, Frames, Received) -> ws_echo_loop(Sock, Frames, Received) ->
tell("~p ws_echo_loop(Sock, ~tp, ~tp)", [self(), 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} -> {ok, Message, NewFrames, NewReceived} ->
tell("~p echo message: ~tp", [self(), Message]), tell("~p echo message: ~tp", [self(), Message]),
% send the same message back % send the same message back
ok = fd_ws:send(Sock, Message), ok = qhl_ws:send(Sock, Message),
ws_echo_loop(Sock, NewFrames, NewReceived); ws_echo_loop(Sock, NewFrames, NewReceived);
Error -> Error ->
tell(error, "ws_echo_loop: error: ~tp", [Error]), tell(error, "ws_echo_loop: error: ~tp", [Error]),
fd_ws:send(Sock, {close, <<>>}), qhl_ws:send(Sock, {close, <<>>}),
error(Error) error(Error)
end. end.
%% ------------------------------
%% grids
%% ------------------------------
grids_spend(Sock, #request{enctype = json,
body = B = #{"network_id" := NetId,
"recipient" := Recipient,
"amount" := Amount,
"payload" := Payload}}) ->
tell("grids_spend good request: ~tp", [B]),
RespObj =
case fd_gridsd:mk_spend(NetId, Recipient, Amount, unicode:characters_to_binary(Payload)) of
{ok, URL, PNG} ->
#{"ok" => true,
"result" => #{"url" => URL,
"png_base64" => unicode:characters_to_list(base64:encode(PNG))}};
{error, String} ->
#{"ok" => false,
"error" => String}
end,
Body = zj:encode(RespObj),
% update cache with new context
Response = #response{headers = [{"content-type", "application/json"}],
body = Body},
fd_httpd_utils:respond(Sock, Response);
grids_spend(Sock, Request) ->
tell("grids_spend: bad request: ~tp", [Request]),
fd_httpd_utils:http_err(Sock, 400).
%% ------------------------------ %% ------------------------------
%% wfc %% wfc
@ -405,28 +366,28 @@ wfcin(Sock, #request{enctype = json,
case wfc_read:expr(Input) of case wfc_read:expr(Input) of
{ok, Expr, _Rest} -> {ok, Expr, _Rest} ->
case wfc_eval:eval(Expr, Ctx0) of case wfc_eval:eval(Expr, Ctx0) of
{ok, noop, Ctx1} -> {fd_http_utils:jsgud("<noop>"), Ctx1}; {ok, noop, Ctx1} -> {fd_httpd_utils:jsgud("<noop>"), Ctx1};
{ok, Sentence, Ctx1} -> {fd_http_utils:jsgud(wfc_pp:sentence(Sentence)), Ctx1}; {ok, Sentence, Ctx1} -> {fd_httpd_utils:jsgud(wfc_pp:sentence(Sentence)), Ctx1};
{error, Message} -> {fd_http_utils:jsbad(Message), Ctx0} {error, Message} -> {fd_httpd_utils:jsbad(Message), Ctx0}
end; end;
{error, Message} -> {error, Message} ->
{fd_http_utils:jsbad(Message), Ctx0} {fd_httpd_utils:jsbad(Message), Ctx0}
end end
catch catch
error:E:S -> error:E:S ->
ErrorMessage = unicode:characters_to_list(io_lib:format("parser crashed: ~p:~p", [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, end,
% update cache with new context % update cache with new context
ok = fd_cache:set(Cookie, NewCtx), ok = fd_wfcd_cache:set(Cookie, NewCtx),
Body = zj:encode(RespObj), Body = zj:encode(RespObj),
Response = #response{headers = [{"content-type", "application/json"}, Response = #response{headers = [{"content-type", "application/json"},
{"set-cookie", ["wfc=", Cookie]}], {"set-cookie", ["wfc=", Cookie]}],
body = Body}, body = Body},
fd_http_utils:respond(Sock, Response); fd_httpd_utils:respond(Sock, Response);
wfcin(Sock, Request) -> wfcin(Sock, Request) ->
tell("wfcin: bad request: ~tp", [Request]), tell("wfcin: bad request: ~tp", [Request]),
fd_http_utils:http_err(Sock, 400). fd_httpd_utils:http_err(Sock, 400).
@ -436,17 +397,9 @@ wfcin(Sock, Request) ->
Context :: wfc_eval_context:context(). Context :: wfc_eval_context:context().
ctx(#{<<"wfc">> := Cookie}) -> ctx(#{<<"wfc">> := Cookie}) ->
case fd_cache:query(Cookie) of case fd_wfcd_cache:query(Cookie) of
{ok, Context} -> {Cookie, Context}; {ok, Context} -> {Cookie, Context};
error -> {Cookie, wfc_eval_context:default()} error -> {Cookie, wfc_eval_context:default()}
end; end;
ctx(_) -> ctx(_) ->
{fd_http_utils:new_cookie(), wfc_eval_context:default()}. {fd_httpd_utils:new_cookie(), wfc_eval_context:default()}.

25
src/fd_client_man.erl → src/fd_httpd_client_man.erl
View File

@ -9,8 +9,8 @@
%%% OTP should take care of for us. %%% OTP should take care of for us.
%%% @end %%% @end
-module(fd_client_man). -module(fd_httpd_client_man).
-vsn("0.1.0"). -vsn("0.2.0").
-behavior(gen_server). -behavior(gen_server).
-author("Peter Harpending <peterharpending@qpq.swiss>"). -author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>"). -copyright("Peter Harpending <peterharpending@qpq.swiss>").
@ -23,6 +23,8 @@
code_change/3, terminate/2]). code_change/3, terminate/2]).
-include("$zx_include/zx_logger.hrl").
%%% Type and Record Definitions %%% Type and Record Definitions
@ -92,7 +94,7 @@ echo(Message) ->
when Result :: {ok, pid()} when Result :: {ok, pid()}
| {error, Reason :: term()}. | {error, Reason :: term()}.
%% @private %% @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() -> start_link() ->
gen_server:start_link({local, ?MODULE}, ?MODULE, none, []). gen_server:start_link({local, ?MODULE}, ?MODULE, none, []).
@ -104,8 +106,9 @@ start_link() ->
%% preparatory work necessary for proper function. %% preparatory work necessary for proper function.
init(none) -> init(none) ->
ok = io:format("Starting.~n"), ok = tell("Starting fd_httpd_client_man."),
State = #s{}, State = #s{},
ok = tell("fd_httpd_client_man init state: ~tp", [State]),
{ok, State}. {ok, State}.
@ -130,7 +133,7 @@ handle_call({listen, PortNum}, _, State) ->
{Response, NewState} = do_listen(PortNum, State), {Response, NewState} = do_listen(PortNum, State),
{reply, Response, NewState}; {reply, Response, NewState};
handle_call(Unexpected, From, State) -> 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}. {noreply, State}.
@ -152,7 +155,7 @@ handle_cast(ignore, State) ->
NewState = do_ignore(State), NewState = do_ignore(State),
{noreply, NewState}; {noreply, NewState};
handle_cast(Unexpected, State) -> 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}. {noreply, State}.
@ -168,7 +171,7 @@ handle_info({'DOWN', Mon, process, Pid, Reason}, State) ->
NewState = handle_down(Mon, Pid, Reason, State), NewState = handle_down(Mon, Pid, Reason, State),
{noreply, NewState}; {noreply, NewState};
handle_info(Unexpected, State) -> 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}. {noreply, State}.
@ -225,10 +228,10 @@ do_listen(PortNum, State = #s{port_num = none}) ->
{keepalive, true}, {keepalive, true},
{reuseaddr, true}], {reuseaddr, true}],
{ok, Listener} = gen_tcp:listen(PortNum, SocketOptions), {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}}; {ok, State#s{port_num = PortNum, listener = Listener}};
do_listen(_, State = #s{port_num = PortNum}) -> 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}. {{error, {listening, PortNum}}, State}.
@ -254,7 +257,7 @@ do_enroll(Pid, State = #s{clients = Clients}) ->
case lists:member(Pid, Clients) of case lists:member(Pid, Clients) of
false -> false ->
Mon = monitor(process, Pid), 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]}; State#s{clients = [Pid | Clients]};
true -> true ->
State State
@ -292,6 +295,6 @@ handle_down(Mon, Pid, Reason, State = #s{clients = Clients}) ->
State#s{clients = NewClients}; State#s{clients = NewClients};
false -> false ->
Unexpected = {'DOWN', Mon, process, Pid, Reason}, 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 State
end. end.

18
src/fd_client_sup.erl → src/fd_httpd_client_sup.erl
View File

@ -2,8 +2,8 @@
%%% front end web development lab Client Supervisor %%% front end web development lab Client Supervisor
%%% %%%
%%% This process supervises the client socket handlers themselves. It is a peer of the %%% 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), %%% fd_httpd_client_man (the manager interface to this network service component),
%%% and a child of the supervisor named fd_clients. %%% 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 %%% 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 %%% 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 %%% http://erlang.org/doc/design_principles/sup_princ.html#id79244
%%% @end %%% @end
-module(fd_client_sup). -module(fd_httpd_client_sup).
-vsn("0.1.0"). -vsn("0.2.0").
-behaviour(supervisor). -behaviour(supervisor).
-author("Peter Harpending <peterharpending@qpq.swiss>"). -author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>"). -copyright("Peter Harpending <peterharpending@qpq.swiss>").
@ -35,9 +35,9 @@
| {shutdown, term()} | {shutdown, term()}
| term(). | term().
%% @private %% @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 %% 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 %% Error conditions, supervision strategies and other important issues are
%% explained in the supervisor module docs: %% explained in the supervisor module docs:
@ -61,10 +61,10 @@ start_link() ->
init(none) -> init(none) ->
RestartStrategy = {simple_one_for_one, 1, 60}, RestartStrategy = {simple_one_for_one, 1, 60},
Client = {fd_client, Client = {fd_httpd_client,
{fd_client, start_link, []}, {fd_httpd_client, start_link, []},
temporary, temporary,
brutal_kill, brutal_kill,
worker, worker,
[fd_client]}, [fd_httpd_client]},
{ok, {RestartStrategy, [Client]}}. {ok, {RestartStrategy, [Client]}}.

30
src/fd_clients.erl → src/fd_httpd_clients.erl
View File

@ -8,8 +8,8 @@
%%% See: http://erlang.org/doc/apps/kernel/application.html %%% See: http://erlang.org/doc/apps/kernel/application.html
%%% @end %%% @end
-module(fd_clients). -module(fd_httpd_clients).
-vsn("0.1.0"). -vsn("0.2.0").
-behavior(supervisor). -behavior(supervisor).
-author("Peter Harpending <peterharpending@qpq.swiss>"). -author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>"). -copyright("Peter Harpending <peterharpending@qpq.swiss>").
@ -32,17 +32,17 @@ start_link() ->
init(none) -> init(none) ->
RestartStrategy = {rest_for_one, 1, 60}, RestartStrategy = {rest_for_one, 1, 60},
ClientMan = {fd_client_man, HttpClientMan = {fd_httpd_client_man,
{fd_client_man, start_link, []}, {fd_httpd_client_man, start_link, []},
permanent, permanent,
5000, 5000,
worker, worker,
[fd_client_man]}, [fd_httpd_client_man]},
ClientSup = {fd_client_sup, HttpClientSup = {fd_httpd_client_sup,
{fd_client_sup, start_link, []}, {fd_httpd_client_sup, start_link, []},
permanent, permanent,
5000, 5000,
supervisor, supervisor,
[fd_client_sup]}, [fd_httpd_client_sup]},
Children = [ClientSup, ClientMan], Children = [HttpClientSup, HttpClientMan],
{ok, {RestartStrategy, Children}}. {ok, {RestartStrategy, Children}}.

15
src/fd_sfc.erl → src/fd_httpd_sfc.erl
View File

@ -1,5 +1,6 @@
% @doc static file cache % @doc static file cache
-module(fd_sfc). -module(fd_httpd_sfc).
-vsn("0.2.0").
-behavior(gen_server). -behavior(gen_server).
@ -21,12 +22,12 @@
-include("$zx_include/zx_logger.hrl"). -include("$zx_include/zx_logger.hrl").
-type entry() :: fd_sfc_entry:entry(). -type entry() :: fd_httpd_sfc_entry:entry().
-type maybe_entry() :: {found, fd_sfc_entry:entry()} | not_found. -type maybe_entry() :: {found, fd_httpd_sfc_entry:entry()} | not_found.
-record(s, {base_path = base_path() :: file:filename(), -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()}). auto_renew = 0_500 :: pos_integer()}).
%-type state() :: #s{}. %-type state() :: #s{}.
@ -62,14 +63,14 @@ start_link() ->
%% gen_server callbacks %% gen_server callbacks
init(none) -> init(none) ->
tell("starting fd_sfc"), tell("starting fd_httpd_sfc"),
InitState = #s{}, InitState = #s{},
erlang:send_after(InitState#s.auto_renew, self(), auto_renew), erlang:send_after(InitState#s.auto_renew, self(), auto_renew),
{ok, InitState}. {ok, InitState}.
handle_call({query, Path}, _, State = #s{cache = Cache}) -> 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}; {reply, Reply, State};
handle_call(Unexpected, From, State) -> handle_call(Unexpected, From, State) ->
tell("~tp: unexpected call from ~tp: ~tp", [?MODULE, Unexpected, From]), tell("~tp: unexpected call from ~tp: ~tp", [?MODULE, Unexpected, From]),
@ -106,6 +107,6 @@ terminate(_, _) ->
%%----------------------------------------------------------------------------- %%-----------------------------------------------------------------------------
i_renew(State = #s{base_path = BasePath}) -> 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 = State#s{cache = NewCache},
NewState. NewState.

9
src/fd_sfc_cache.erl → src/fd_httpd_sfc_cache.erl
View File

@ -1,6 +1,7 @@
% @doc % @doc
% cache data management % cache data management
-module(fd_sfc_cache). -module(fd_httpd_sfc_cache).
-vsn("0.2.0").
-export_type([ -export_type([
cache/0 cache/0
@ -13,7 +14,7 @@
-include("$zx_include/zx_logger.hrl"). -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 -spec query(HttpPath, Cache) -> Result
@ -21,7 +22,7 @@
Cache :: cache(), Cache :: cache(),
Result :: {found, Entry} Result :: {found, Entry}
| not_found, | not_found,
Entry :: fd_sfc_entry:entry(). Entry :: fd_httpd_sfc_entry:entry().
query(HttpPath, Cache) -> query(HttpPath, Cache) ->
case maps:find(HttpPath, Cache) of case maps:find(HttpPath, Cache) of
@ -63,7 +64,7 @@ new2(BasePath) ->
BAbsPath = unicode:characters_to_binary(AbsPath), BAbsPath = unicode:characters_to_binary(AbsPath),
HttpPath = remove_prefix(BBaseDir, BAbsPath), HttpPath = remove_prefix(BBaseDir, BAbsPath),
NewCache = NewCache =
case fd_sfc_entry:new(AbsPath) of case fd_httpd_sfc_entry:new(AbsPath) of
{found, Entry} -> maps:put(HttpPath, Entry, AccCache); {found, Entry} -> maps:put(HttpPath, Entry, AccCache);
not_found -> AccCache not_found -> AccCache
end, end,

3
src/fd_sfc_entry.erl → src/fd_httpd_sfc_entry.erl
View File

@ -1,7 +1,8 @@
% @doc non-servery functions for static file caching % @doc non-servery functions for static file caching
% %
% this spams the filesystem, so it's not "pure" code % 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([ -export_type([
encoding/0, encoding/0,

10
src/fd_http_utils.erl → src/fd_httpd_utils.erl
View File

@ -1,5 +1,6 @@
% @doc http utility functions % @doc http utility functions
-module(fd_http_utils). -module(fd_httpd_utils).
-vsn("0.2.0").
-export([ -export([
new_cookie/0, new_cookie/0,
@ -7,7 +8,10 @@
http_err/2, http_err/2,
respond/2, respond/2,
fmtresp/1 fmtresp/1
]) ]).
-include("http.hrl").
-include("$zx_include/zx_logger.hrl").
-spec new_cookie() -> Cookie -spec new_cookie() -> Cookie
@ -110,6 +114,6 @@ add_headers(Hs, Body) ->
default_headers(Body) -> default_headers(Body) ->
BodySize = byte_size(iolist_to_binary(Body)), BodySize = byte_size(iolist_to_binary(Body)),
#{"Server" => "fewd 0.1.0", #{"Server" => "fewd 0.2.0",
"Date" => qhl:ridiculous_web_date(), "Date" => qhl:ridiculous_web_date(),
"Content-Length" => io_lib:format("~p", [BodySize])}. "Content-Length" => io_lib:format("~p", [BodySize])}.

36
src/fd_sup.erl
View File

@ -12,7 +12,7 @@
%%% @end %%% @end
-module(fd_sup). -module(fd_sup).
-vsn("0.1.0"). -vsn("0.2.0").
-behaviour(supervisor). -behaviour(supervisor).
-author("Peter Harpending <peterharpending@qpq.swiss>"). -author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>"). -copyright("Peter Harpending <peterharpending@qpq.swiss>").
@ -36,29 +36,23 @@ start_link() ->
init([]) -> init([]) ->
RestartStrategy = {one_for_one, 1, 60}, RestartStrategy = {one_for_one, 1, 60},
Clients = {fd_clients, GridsD = {fd_gridsd,
{fd_clients, start_link, []}, {fd_gridsd, start_link, []},
permanent,
5000,
worker,
[fd_gridsd]},
WFCd = {fd_wfcd,
{fd_wfcd, start_link, []},
permanent, permanent,
5000, 5000,
supervisor, supervisor,
[fd_clients]}, [fd_wfcd]},
Chat = {fd_chat, Httpd = {fd_httpd,
{fd_chat, start_link, []}, {fd_httpd, start_link, []},
permanent, permanent,
5000, 5000,
worker, supervisor,
[fd_chat]}, [fd_httpd]},
FileCache = {fd_sfc, Children = [GridsD, WFCd, Httpd],
{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],
{ok, {RestartStrategy, Children}}. {ok, {RestartStrategy, Children}}.

88
src/fd_tetris.erl
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.

33
src/fd_wfcd.erl Normal file
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}}.

3
src/fd_cache.erl → src/fd_wfcd_cache.erl
View File

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

102
src/fd_wsp.erl
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
%%-----------------------------------------------------------------------------

21
src/fewd.erl
View File

@ -3,18 +3,32 @@
%%% @end %%% @end
-module(fewd). -module(fewd).
-vsn("0.1.0"). -vsn("0.2.0").
-behavior(application). -behavior(application).
-author("Peter Harpending <peterharpending@qpq.swiss>"). -author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>"). -copyright("Peter Harpending <peterharpending@qpq.swiss>").
-license("BSD-2-Clause-FreeBSD"). -license("BSD-2-Clause-FreeBSD").
-export([network_id/0, pubkey/0, akstr/0]).
-export([listen/1, ignore/0]). -export([listen/1, ignore/0]).
-export([start/2, stop/1]). -export([start/2, stop/1]).
-include("$zx_include/zx_logger.hrl"). -include("$zx_include/zx_logger.hrl").
network_id() -> "groot.testnet".
pubkey() -> pad32(<<"fewd demo">>).
akstr() -> gmgrids:akstr(pubkey()).
pad32(Bytes) ->
BS = byte_size(Bytes),
Spaces = << <<" ">>
|| _ <- lists:seq(BS, 31)
>>,
<<Bytes/bytes, Spaces/bytes>>.
-spec listen(PortNum) -> Result -spec listen(PortNum) -> Result
when PortNum :: inet:port_num(), when PortNum :: inet:port_num(),
Result :: ok Result :: ok
@ -24,7 +38,7 @@
%% Returns an {error, Reason} tuple if it is already listening. %% Returns an {error, Reason} tuple if it is already listening.
listen(PortNum) -> listen(PortNum) ->
fd_client_man:listen(PortNum). fd_httpd_client_man:listen(PortNum).
-spec ignore() -> ok. -spec ignore() -> ok.
@ -32,7 +46,7 @@ listen(PortNum) ->
%% Make the server stop listening if it is, or continue to do nothing if it isn't. %% Make the server stop listening if it is, or continue to do nothing if it isn't.
ignore() -> ignore() ->
fd_client_man:ignore(). fd_httpd_client_man:ignore().
-spec start(normal, term()) -> {ok, pid()}. -spec start(normal, term()) -> {ok, pid()}.
@ -42,6 +56,7 @@ ignore() ->
%% See: http://erlang.org/doc/apps/kernel/application.html %% See: http://erlang.org/doc/apps/kernel/application.html
start(normal, _Args) -> start(normal, _Args) ->
ok = application:ensure_started(hakuzaru),
Result = fd_sup:start_link(), Result = fd_sup:start_link(),
ok = listen(8000), ok = listen(8000),
Result. Result.

618
src/gmgrids.erl Normal file
View File

@ -0,0 +1,618 @@
% @doc
% GRIDS library: grids
%
% This module simply handles encoding and decoding of GRIDS URLs.
%
% For documentation on GRIDS see
%
% https://git.qpq.swiss/QPQ-AG/research-megadoc/wiki/GRIDS
% @end
-module(gmgrids).
-vsn("0.2.0").
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("2025 QPQ AG").
-license("MIT").
% TODONE:
%
% TODO:
%
% - possibly input types should be iolists. I think for
% binaries it's fine
% - change the types... don't need 3 different record types
% FIXEDME:
%
% FIXME:
-export_type([
% field types
host/0,
target/0, akstr/0, pubkey/0,
% record types
grids/0
]).
-export([
% convenience functions
%% currency granularities
p/0, kp/0, mp/0, gp/0, tp/0, pp/0,
g/0, kg/0, mg/0, gg/0, tg/0,
%% type fuckery
target_to_path/1, akstr/1, unakstr/1,
dummy_target/0,
%% convenience encoders
encode/2,
% "primitives"
%% record constructor
mk_grids/2,
%% primitive encoders
encode/1, encode/7, percent_encode/1,
%% decoder
decode/1
]).
%%-------------------------------------------------------------------
%% API: TYPES
%%-------------------------------------------------------------------
% @doc Future-proofing... later this could be inet:addr() or whatever, or maybe
% {Host, Port}. Keeping it simple for now
-type host() :: string().
% @doc ak_... string
-type akstr() :: string().
% @doc 32-byte public key
-type pubkey() :: <<_:256>>.
% @doc later might want this to be flexible, "ak_..." etc
%
% FIXME: add support for all the different api keys: ak_..., ct_..., etc
-type target() :: pubkey()
| akstr().
-record(grids,
{secure = true :: boolean(),
host :: host(),
version = 1 :: integer(),
instruction :: dead_drop | spend | transfer,
path :: string(),
amount = none :: none | {value, integer()},
payload = none :: none | {value, binary()}}).
-type grids() :: #grids{}.
%%-------------------------------------------------------------------
%% API: CONVENIENCE FUNCTIONS
%%-------------------------------------------------------------------
%% currency granularities
p() -> 1.
kp() -> 1_000.
mp() -> 1_000_000.
gp() -> 1_000_000_000.
tp() -> 1_000_000_000_000.
pp() -> 1_000_000_000_000_000.
g() -> 1_000_000_000_000_000_000.
kg() -> 1_000_000_000_000_000_000_000.
mg() -> 1_000_000_000_000_000_000_000_000.
gg() -> 1_000_000_000_000_000_000_000_000_000.
tg() -> 1_000_000_000_000_000_000_000_000_000_000.
-spec target_to_path(Target) -> Path
when Target :: target(),
Path :: string().
% @doc
% Internal function exported for convenience purposes
%
% If `Target' is an "ak_..." string, leave as-is. If it's a 32 byte public key
% encode as an ak_... string
target_to_path(Target) ->
i_ttp(iolist_to_binary(Target)).
i_ttp(ApiStr = <<"ak_", _/binary>>) -> ApiStr;
i_ttp(Pubkey = <<_:32/bytes>>) -> akstr(Pubkey);
i_ttp(BadTarget) -> error({invalid_target, BadTarget}).
%% akstr/unakstr
-spec akstr(Pubkey) -> AkStr
when Pubkey :: pubkey(),
AkStr :: akstr().
% @doc
% convert a 32-byte public key into an ak_... string
akstr(PK) ->
unicode:characters_to_list(gmser_api_encoder:encode(account_pubkey, PK)).
-spec unakstr(AkStr) -> Pubkey
when Pubkey :: pubkey(),
AkStr :: string().
% @doc
% convert an ak_... string into a 32-byte public key
unakstr(Akstr) ->
{_, PK} = gmser_api_encoder:decode(unicode:characters_to_binary(Akstr)),
PK.
-spec dummy_target() -> akstr().
% @doc Make a dummy public key. For testing purposes. NOT secure!
dummy_target() ->
akstr(rand:bytes(32)).
-spec encode(Args, Options) -> URL
when Args :: {dead_drop, Host, Path}
| {spend, NetworkId, Recipient}
| {transfer, Host, Path},
Host :: iolist(),
Path :: iolist(),
NetworkId :: iolist(),
Recipient :: target(),
Options :: [Opt],
Opt :: {secure, boolean()}
| {version, integer()}
| {amount, Amount}
| {payload, Payload},
Amount :: integer() | none | {value, integer()},
Payload :: iolist() | none | {value, iolist()},
URL :: string().
encode(Args, Opts) ->
encode(mk_grids(Args, Opts)).
%%-------------------------------------------------------------------
%% API: RECORD CONSTRUCTORS
%%-------------------------------------------------------------------
-record(o,
{secure = true :: boolean(),
version = 1 :: integer(),
amount = none :: none | {value, integer()},
payload = none :: none | {value, binary()}}).
-spec mk_grids(Args, Options) -> Grids
when Args :: {dead_drop, Host, Path}
| {spend, NetworkId, Recipient}
| {transfer, Host, Path},
Host :: iolist(),
Path :: iolist(),
NetworkId :: iolist(),
Recipient :: target(),
Options :: [Opt],
Opt :: {secure, boolean()}
| {version, integer()}
| {amount, Amount}
| {payload, Payload},
Amount :: integer() | none | {value, integer()},
Payload :: iolist() | none | {value, iolist()},
Grids :: #grids{}.
mk_grids(Args, Options) ->
#o{secure = Secure,
version = Version,
amount = MaybeAmount,
payload = MaybePayload} = i_valid_opts(Options),
{Instruction, HostStr, Path} =
case Args of
{dead_drop, H0, P0} ->
H1 = unicode:characters_to_list(H0),
P1 = unicode:characters_to_list(P0),
{dead_drop, H1, P1};
{spend, NetId0, Recip0} ->
NetId1 = unicode:characters_to_list(NetId0),
Recip1 = target_to_path(Recip0),
{spend, NetId1, Recip1};
{transfer, H0, P0} ->
H1 = unicode:characters_to_list(H0),
P1 = unicode:characters_to_list(P0),
{transfer, H1, P1}
end,
#grids{secure = Secure,
host = HostStr,
version = Version,
instruction = Instruction,
path = Path,
amount = MaybeAmount,
payload = MaybePayload}.
i_valid_opts(Options) ->
Secure =
case proplists:get_value(secure, Options, true) of
S when is_boolean(S) -> S;
W -> error({invalid_option, {secure, W}})
end,
Version =
case proplists:get_value(version, Options, 1) of
V when is_integer(V) -> V;
X -> error({invalid_option, {version, X}})
end,
Amount =
case proplists:get_value(amount, Options, none) of
none -> none;
{value, N} when is_integer(N) -> {value, N};
N when is_integer(N) -> {value, N};
Y -> error({invalid_option, {amount, Y}})
end,
Payload =
case proplists:get_value(payload, Options, none) of
none -> none;
{value, P} -> {value, iolist_to_binary(P)};
P -> {value, iolist_to_binary(P)}
end,
#o{secure = Secure,
version = Version,
amount = Amount,
payload = Payload}.
%%-------------------------------------------------------------------
%% API: ENCODING (Record -> URL)
%%-------------------------------------------------------------------
-spec encode(GRIDS) -> URL
when GRIDS :: grids(),
URL :: string().
% @doc
% Encode a grids record type
% @end
encode(#grids{secure = Secure,
host = Host,
version = Vsn,
instruction = Instruction,
path = Path,
amount = Amt,
payload = Payload}) ->
encode(Secure, Host, Vsn, Instruction, Path, Amt, Payload).
-spec encode(Secure, Host, Version, Instruction, Path, Amount, Payload) -> URL
when Secure :: boolean(),
Host :: host(),
Version :: integer(),
Instruction :: dead_drop | spend | transfer,
Path :: string(),
Amount :: none | {value, integer()},
Payload :: none | {value, binary()},
URL :: string().
% @doc
% internal encode that's more verbose
encode(Secure, Host, Version, Instruction, Path, Amount, Payload) ->
unicode:characters_to_list(
["grid", i_encode_secure(Secure),
"://", i_encode_host(Host),
"/", integer_to_list(Version),
"/", i_encode_instruction(Instruction),
"/", Path,
i_encode_qstr(Amount, Payload)]
).
i_encode_secure(true) -> "s";
i_encode_secure(false) -> "".
% future-proofing against more complicated host arguments
i_encode_host(Host) -> Host.
i_encode_instruction(dead_drop) -> "d";
i_encode_instruction(spend) -> "s";
i_encode_instruction(transfer) -> "t".
i_encode_qstr(none, none) ->
"";
i_encode_qstr({value, Amt}, none) ->
["?a=", integer_to_list(Amt)];
i_encode_qstr(none, {value, Payload}) ->
["?p=", percent_encode(Payload)];
i_encode_qstr({value, Amt}, {value, Payload}) ->
["?a=", integer_to_list(Amt),
"&p=", percent_encode(Payload)].
-spec percent_encode(Payload) -> PercentEncoded
when Payload :: binary(),
PercentEncoded :: iolist().
% @doc
% internal function to percent-encode binary payload
% exported for convenience
%
% See: https://en.wikipedia.org/wiki/Percent-encoding
percent_encode(Payload) when is_binary(Payload) ->
i_percent_encode(Payload, []).
% unreserved characters
i_percent_encode(<<C:8, Rest/binary>>, Acc)
when ($A =< C andalso C =< $Z) orelse
($a =< C andalso C =< $z) orelse
($0 =< C andalso C =< $9) orelse
(C =:= $-) orelse
(C =:= $_) orelse
(C =:= $~) orelse
(C =:= $.) ->
i_percent_encode(Rest, [Acc, C]);
i_percent_encode(<<B:8, Rest/binary>>, Acc) ->
i_percent_encode(Rest, [Acc, i_pe_byte(B)]);
i_percent_encode(<<>>, Result) ->
Result.
% single hex digit
i_pe_byte(B) when 16#00 =< B, B =< 16#0F -> ["%0", integer_to_list(B, 16)];
i_pe_byte(B) when 16#10 =< B, B =< 16#FF -> ["%", integer_to_list(B, 16)].
%%---------------------------------------------------------
%% API: DECODING
%%---------------------------------------------------------
-record(dt,
{secure = undefined :: undefined | boolean(),
host = undefined :: undefined | iolist(),
version = undefined :: undefined | integer(),
instruction = undefined :: undefined | spend | transfer | dead_drop,
path = undefined :: undefined | iolist(),
amount = undefined :: undefined | none | {value, integer()},
payload = undefined :: undefined | none | {value, binary()}}).
% -type decode_target() :: #dt{}.
-spec decode(URL) -> Result
when URL :: string(),
Result :: {ok, grids(), Remainder :: string()}
| {error, Reason},
Reason :: term().
decode(URL) ->
case i_decode(unicode:characters_to_binary(URL)) of
{ok, DT, Remainder} ->
{ok, i_decode_dt(DT), unicode:characters_to_list(Remainder)};
Error ->
Error
end.
i_decode_dt(#dt{secure = S,
host = H,
version = V,
path = P,
instruction = Instruction,
amount = A,
payload = L}) ->
HStr = unicode:characters_to_list(H),
PStr = unicode:characters_to_list(P),
#grids{secure = S,
host = HStr,
version = V,
path = PStr,
instruction = Instruction,
amount = A,
payload = L}.
i_decode(URL) ->
i_pipeline([fun i_decode_secure/2,
fun i_decode_host/2,
fun i_decode_version/2,
fun i_decode_instruction/2,
fun i_decode_path/2,
fun i_decode_qstr/2],
{ok, #dt{}, URL}).
i_pipeline([Fun | Funs], Acc) ->
case Acc of
{ok, DT, URL} -> i_pipeline(Funs, Fun(DT, URL));
Error -> Error
end;
i_pipeline([], Result) ->
Result.
i_decode_secure(DT = #dt{secure = undefined},
<<"grid://", Rest/binary>>) ->
{ok, DT#dt{secure = false}, Rest};
i_decode_secure(DT = #dt{secure = undefined},
<<"grids://", Rest/binary>>) ->
{ok, DT#dt{secure = true}, Rest};
i_decode_secure(_, URL) ->
{error, {bad_protocol, URL}}.
i_decode_host(DT = #dt{host = undefined}, URL) ->
case idh2([], URL) of
{ok, Host, Rest} -> {ok, DT#dt{host = Host}, Rest};
Error -> Error
end.
% eliminate empty hosts and hosts not followed by /
idh2([], <<$/:8, _/binary>>) -> {error, empty_host};
idh2([], <<>>) -> {error, empty_host};
idh2(Host, <<>>) -> {error, {bad_host, Host}};
idh2(Host, <<$/:8, Rest/binary>>) -> {ok, Host, Rest};
idh2(Acc, <<Char:8, Rest/binary>>) -> idh2([Acc, Char], Rest).
i_decode_version(DT = #dt{version = undefined}, URL) ->
case idv2([], URL) of
{ok, VStr, Rest} ->
Version = list_to_integer(unicode:characters_to_list(VStr)),
NewDT = DT#dt{version = Version},
{ok, NewDT, Rest};
Error ->
Error
end.
idv2([], <<$/:8, _/binary>>) -> {error, empty_host};
idv2([], <<>>) -> {error, empty_host};
idv2(Vstr, <<>>) -> {error, {bad_version, iolist_to_binary(Vstr)}};
idv2(Vstr, <<$/:8, Rest/binary>>) -> {ok, Vstr, Rest};
idv2(Acc, <<N:8, Rest/binary>>) ->
case ($0 =< N) andalso (N =< $9) of
true -> idv2([Acc, N], Rest);
false -> {error, {illegal_version_char, [N]}}
end.
i_decode_instruction(DT = #dt{instruction = undefined}, <<"s/", Rest/binary>>) ->
{ok, DT#dt{instruction = spend}, Rest};
i_decode_instruction(DT = #dt{instruction = undefined}, <<"t/", Rest/binary>>) ->
{ok, DT#dt{instruction = transfer}, Rest};
i_decode_instruction(DT = #dt{instruction = undefined}, <<"d/", Rest/binary>>) ->
{ok, DT#dt{instruction = dead_drop}, Rest};
i_decode_instruction(_ = #dt{instruction = undefined}, Bad) ->
{error, {illegal_instruction, Bad}}.
i_decode_path(DT = #dt{path = undefined}, URL) ->
{Path, Rest} = idp([], URL),
{ok, DT#dt{path = Path}, Rest}.
% consume until we get to end of string or ?
idp(Path, <<"?", Rest/binary>>) -> {Path, Rest};
idp(Path, <<>>) -> {Path, <<>>};
idp(Path, <<C:8, Rest/binary>>) -> idp([Path, C], Rest).
i_decode_qstr(DT = #dt{amount = undefined, payload = undefined}, URL) ->
case idq([], URL) of
{ok, Proplist, Remainder} ->
Amount = proplists:get_value(amount, Proplist, none),
Payload = proplists:get_value(payload, Proplist, none),
NewDT = DT#dt{amount = Amount, payload = Payload},
{ok, NewDT, Remainder};
Error ->
Error
end.
-spec idq(Proplist, URL) -> Result
when URL :: binary(),
Result :: {ok, Proplist, Remainder}
| {error, ParseError},
Proplist :: [Prop],
Prop :: {amount, {value, integer()}}
| {payload, {value, binary()}},
ParseError :: any(),
Remainder :: binary().
idq(Params, <<"a=", Rest/binary>>) ->
case i_parse_amt(none, Rest) of
{ok, Amt, NewRest} ->
NewParams = [{amount, {value, Amt}} | Params],
idq(NewParams, NewRest);
Error ->
Error
end;
idq(Params, <<"p=", Rest/binary>>) ->
case i_parse_payload(none, Rest) of
{ok, Payload, NewRest} ->
NewParams = [{payload, {value, Payload}} | Params],
idq(NewParams, NewRest);
Error ->
Error
end;
idq(Params, Rest) ->
{ok, Params, Rest}.
-spec i_parse_amt(MaybeAmount, URL) -> Result
when URL :: binary(),
Result :: {ok, MaybeAmount, Rest}
| {error, term()},
MaybeAmount :: none | {value, integer()},
Rest :: binary().
% @private context here is we have an a= and we're parsing what comes after
% that
%
% we can error on empty amounts
i_parse_amt(Acc, <<DigitChar:8, Rest/binary>>)
when $0 =< DigitChar, DigitChar =< $9 ->
DigitInt = DigitChar - $0,
NewAcc =
case Acc of
none -> {value, DigitInt};
{value, N} -> {value, N*10 + DigitInt}
end,
i_parse_amt(NewAcc, Rest);
% either end of string or non-digit char
i_parse_amt(Acc, <<"&", Rest/binary>>) ->
case Acc of
{value, Amount} -> {ok, Amount, Rest};
none -> {error, empty_amount}
end;
i_parse_amt(Acc, Rest) ->
case Acc of
{value, Amount} -> {ok, Amount, Rest};
none -> {error, empty_amount}
end.
-define(IS_HEX_CHAR(P), ((($0 =< P) andalso (P =< $9)) orelse
(($A =< P) andalso (P =< $F)))).
-spec i_parse_payload(MaybePayload, URL) -> Result
when URL :: binary(),
Result :: {ok, MaybePayload, Rest}
| {error, term()},
MaybePayload :: none | {value, binary()},
Rest :: binary().
% unreserved chars
i_parse_payload(Acc, <<C:8, Rest/binary>>)
when ($A =< C andalso C =< $Z) orelse
($a =< C andalso C =< $z) orelse
($0 =< C andalso C =< $9) orelse
(C =:= $-) orelse
(C =:= $_) orelse
(C =:= $~) orelse
(C =:= $.) ->
NewAcc =
case Acc of
none -> {value, <<C:8>>};
{value, Bytes} -> {value, <<Bytes/bytes, C:8>>}
end,
i_parse_payload(NewAcc, Rest);
% percent char
i_parse_payload(Acc, <<"%", A:8, B:8, Rest/binary>>)
when ?IS_HEX_CHAR(A), ?IS_HEX_CHAR(B) ->
AInt = list_to_integer([A], 16),
BInt = list_to_integer([B], 16),
NewByte = AInt*16 + BInt,
NewAcc =
case Acc of
none -> {value, <<NewByte:8>>};
{value, Bytes} -> {value, <<Bytes/binary, NewByte:8>>}
end,
i_parse_payload(NewAcc, Rest);
% random char
i_parse_payload(Acc, <<"&", Rest/binary>>) ->
case Acc of
none -> {error, empty_payload};
{value, Payload} -> {ok, Payload, Rest}
end;
i_parse_payload(Acc, Rest) ->
case Acc of
none -> {error, {illegal_payload, Rest}};
{value, Payload} -> {ok, Payload, Rest}
end.

8
src/fd_ws.erl → src/qhl_ws.erl
View File

@ -1,7 +1,8 @@
% @doc websockets % @doc websockets
% %
% ref: https://datatracker.ietf.org/doc/html/rfc6455 % ref: https://datatracker.ietf.org/doc/html/rfc6455
-module(fd_ws). -module(qhl_ws).
-vsn("0.2.0").
-export_type([ -export_type([
opcode/0, opcode/0,
@ -19,7 +20,6 @@
]). ]).
-include("http.hrl"). -include("http.hrl").
-include("$zx_include/zx_logger.hrl").
-define(MAX_PAYLOAD_SIZE, ((1 bsl 63) - 1)). -define(MAX_PAYLOAD_SIZE, ((1 bsl 63) - 1)).
@ -632,11 +632,8 @@ recv_frame_await(Frame, Sock, Received, Timeout) ->
% @end % @end
send(Socket, {Type, Payload}) -> send(Socket, {Type, Payload}) ->
log(info, "fd_ws: send(~tp, {~tp, ~tp})", [Socket, Type, Payload]),
BPayload = payload_to_binary(Payload), BPayload = payload_to_binary(Payload),
log(info, "fd_ws: BPayload = ~tp", [BPayload]),
Frame = message_to_frame(Type, BPayload), Frame = message_to_frame(Type, BPayload),
log(info, "fd_ws: Frame = ~tp", [Frame]),
send_frame(Socket, Frame). send_frame(Socket, Frame).
payload_to_binary(Bin) when is_binary(Bin) -> Bin; payload_to_binary(Bin) when is_binary(Bin) -> Bin;
@ -675,7 +672,6 @@ message_to_frame(Control, Payload)
send_frame(Sock, Frame) -> send_frame(Sock, Frame) ->
Binary = render_frame(Frame), Binary = render_frame(Frame),
log(info, "send_frame: rendered frame: ~tp", [Binary]),
gen_tcp:send(Sock, Binary). gen_tcp:send(Sock, Binary).

1
src/wfc.erl
View File

@ -1,6 +1,7 @@
% @doc % @doc
% porcelain wfc ops % porcelain wfc ops
-module(wfc). -module(wfc).
-vsn("0.2.0").
-export_type([ -export_type([
sentence/0 sentence/0

1
src/wfc_bm.erl
View File

@ -1,6 +1,7 @@
% @doc % @doc
% bit matrices % bit matrices
-module(wfc_bm). -module(wfc_bm).
-vsn("0.2.0").
-export_type([ -export_type([
bit/0, bit/0,

1
src/wfc_eval.erl
View File

@ -1,4 +1,5 @@
-module(wfc_eval). -module(wfc_eval).
-vsn("0.2.0").
-export_type([ -export_type([
]). ]).

1
src/wfc_eval_context.erl
View File

@ -1,4 +1,5 @@
-module(wfc_eval_context). -module(wfc_eval_context).
-vsn("0.2.0").
-export_type([ -export_type([
context/0 context/0

1
src/wfc_ltr.erl
View File

@ -7,6 +7,7 @@
% %
% mathematically, this is a variable like "a", "b", "c", etc % mathematically, this is a variable like "a", "b", "c", etc
-module(wfc_ltr). -module(wfc_ltr).
-vsn("0.2.0").
-export_type([ -export_type([
ltr/0 ltr/0

1
src/wfc_pp.erl
View File

@ -1,4 +1,5 @@
-module(wfc_pp). -module(wfc_pp).
-vsn("0.2.0").
-export([ -export([
eval_result/1, eval_result/1,

1
src/wfc_read.erl
View File

@ -1,4 +1,5 @@
-module(wfc_read). -module(wfc_read).
-vsn("0.2.0").
-export_type([ -export_type([
]). ]).

1
src/wfc_sentence.erl
View File

@ -6,6 +6,7 @@
% %
% empty sentence is 0 % empty sentence is 0
-module(wfc_sentence). -module(wfc_sentence).
-vsn("0.2.0").
-export_type([ -export_type([
sentence/0 sentence/0

1
src/wfc_sftt.erl
View File

@ -1,6 +1,7 @@
% @doc % @doc
% sentence-fun <-> truth table logic % sentence-fun <-> truth table logic
-module(wfc_sftt). -module(wfc_sftt).
-vsn("0.2.0").
-export_type([ -export_type([
sf/0, tt/0 sf/0, tt/0

1
src/wfc_ttfuns.erl
View File

@ -1,6 +1,7 @@
% @doc % @doc
% library of truth tables % library of truth tables
-module(wfc_ttfuns). -module(wfc_ttfuns).
-vsn("0.2.0").
-export_type([ -export_type([
bit/0, bit/0,

1
src/wfc_utils.erl
View File

@ -1,5 +1,6 @@
% @doc misc utility functions % @doc misc utility functions
-module(wfc_utils). -module(wfc_utils).
-vsn("0.2.0").
-export([err/2, str/2, emsg/2]). -export([err/2, str/2, emsg/2]).

1
src/wfc_word.erl
View File

@ -13,6 +13,7 @@
% %
% operations assume all inputs are valid % operations assume all inputs are valid
-module(wfc_word). -module(wfc_word).
-vsn("0.2.0").
-export_type([ -export_type([
word/0 word/0

694
src/zj.erl
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}.

11
zomp.meta
View File

@ -1,11 +1,16 @@
{name,"front end web development lab"}. {name,"front end web development lab"}.
{type,app}. {type,app}.
{modules,[]}. {modules,[]}.
{author,"Peter Harpending"}.
{prefix,"fd"}. {prefix,"fd"}.
{desc,"Front End Web Dev in Erlang stuff"}. {desc,"Front End Web Dev in Erlang stuff"}.
{author,"Peter Harpending"}. {package_id,{"otpr","fewd",{0,2,0}}}.
{package_id,{"otpr","fewd",{0,1,0}}}. {deps,[{"otpr","hakuzaru",{0,7,0}},
{deps,[]}. {"otpr","qr",{0,1,0}},
{"otpr","gmserialization",{0,1,3}},
{"otpr","eblake2",{1,0,1}},
{"otpr","base58",{0,1,1}},
{"otpr","zj",{1,1,2}}]}.
{key_name,none}. {key_name,none}.
{a_email,"peterharpending@qpq.swiss"}. {a_email,"peterharpending@qpq.swiss"}.
{c_email,"peterharpending@qpq.swiss"}. {c_email,"peterharpending@qpq.swiss"}.