44 Commits

Author SHA1 Message Date
Peter Harpending 46345da283 we now spy keyblocks for spends, need to test but probably close to working 2026-03-02 18:54:33 -08:00
Peter Harpending bc870e5f2d wip 2026-03-02 18:27:05 -08:00
Peter Harpending 4ee1825b43 grids random payload defined
ok so next step is go on the server side
- extract recipient, amount, payload,
- register search pattern
- wait for matching transaction to appear
- notify correct party
2026-02-27 11:43:33 -08:00
Peter Harpending be6aceb41a start spy process 2026-02-27 11:34:33 -08:00
pharpend 8a9f060b2d made a little progress on grids demo
i mostly have my head wrapped around the problem a lot more, and need to just
let my brain sit
2026-02-25 18:22:26 -08:00
pharpend 9adbf67ebd shed biketh 2025-12-30 11:45:25 -08:00
pharpend ee35e6cf1f HTML BIKESHED 2025-12-29 15:41:29 -08:00
pharpend 3343dcf137 basic grids demo seems to work... 2025-12-29 14:04:03 -08:00
pharpend f0d1097f1f qr demo 2025-12-29 08:49:42 -08:00
pharpend 60803b4a4e start grids qr demo 2025-12-19 17:47:31 -08:00
pharpend 139f9cb9e4 add qr as a dep 2025-12-17 17:34:08 -08:00
pharpend 8d5320e4e5 [works] cleanups, wfc service architecture
- now using zj as a dep instead of just having it locally
- put WFC into its own service tree

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

- deleted orphan "wsp" (web socket process) module
2025-12-17 16:39:00 -08:00
pharpend 57e7254f8d wip: updating version 2025-12-16 22:18:51 -08:00
pharpend e379a86020 remove references and links to broken features 2025-12-16 22:11:27 -08:00
pharpend e160701403 runs 2025-12-16 22:09:10 -08:00
pharpend cbfc496057 renaming/deleting
:wq
2025-12-12 23:21:00 -08:00
pharpend ff257ae976 wip: renaming 2025-11-19 10:57:23 -08:00
pharpend e12466d5f2 start renaming 2025-10-31 12:33:11 -07:00
Peter Harpending 4e48d6b40b [wip] websockets should have their own supervision tree
I also hate this bullshit of

- fd_client having such a stupid name
- websocket lib needs some love

basically I think this should be the approach:

renames:

- fd_clients    -> fd_http
- fd_client_man -> fd_http_client_man
- fd_client_sup -> fd_http_client_sup
- fd_client     -> fd_http_client
- fd_cache      -> fd_wfc_cache

new trees:

- tetris        -> new tree
- websockets    -> probably should fall into http supervision tree

Notes:
- fd_client_man is necessary because someone needs to own the listen socket
- rewrite fd_client as gen_server
2025-10-27 10:35:05 -07:00
Peter Harpending 1aed42598a reorg 2025-10-27 09:30:29 -07:00
Peter Harpending b55b0bd056 add titlebar 2025-10-27 09:23:59 -07:00
pharpend 7815ae3c57 tetris: poop69 2025-10-26 23:50:50 -07:00
pharpend 882a416831 memory leak problems with tetris poop 2025-10-26 19:51:57 -07:00
Peter Harpending 4bd279798c getting started with typescript 2025-10-24 13:57:37 -07:00
Peter Harpending 138c8eaaeb the shed biketh 2025-10-22 14:37:27 -07:00
Peter Harpending b3599633f9 static file caching/serving seems to work 2025-10-22 14:25:59 -07:00
Peter Harpending f3a107111f add query function 2025-10-22 13:33:08 -07:00
Peter Harpending 8b938fdd42 [wip] static file cache data structure works 2025-10-22 13:17:39 -07:00
pharpend 80945de92d [wip] chat service and static file caching
switching computers
2025-10-22 11:07:49 -07:00
pharpend 2151fff0fa wip on static cache 2025-10-21 22:38:48 -07:00
pharpend 73fc38b7ad begin static file caching 2025-10-21 22:20:24 -07:00
pharpend a0418788c5 the shed biketh 2025-10-21 22:16:58 -07:00
pharpend cb600dc0da starting chat service 2025-10-21 22:09:04 -07:00
pharpend 027c020a34 begin to add chat function 2025-10-21 21:06:35 -07:00
Peter Harpending 079c47962a websockets work 2025-10-21 17:12:59 -07:00
Peter Harpending 7ed8b12c4e painting bike shed 2025-10-21 14:55:51 -07:00
Peter Harpending 4509a328a8 fix type error 2025-10-21 13:22:37 -07:00
Peter Harpending 04970142aa painting the bike shed 2025-10-21 12:37:33 -07:00
Peter Harpending b44292a790 websockets I think are done 2025-10-21 12:28:45 -07:00
Peter Harpending 1865f03085 Almost done... have to fix send
and then of course test it

there will be no bugs, right?
2025-10-21 12:10:28 -07:00
Peter Harpending 5824aaaf36 continuing with websockets
am now working on popping messages off the frame stack
2025-10-21 11:17:27 -07:00
Peter Harpending 35dbf06a55 wip: websocket frame parsing 2025-10-20 22:07:53 -07:00
Peter Harpending 62d0710fcf committing brain-damaged websocket extensions bs
this is just retarded, i'm just going to ignore
2025-10-20 20:02:02 -07:00
Peter Harpending 9107679dfc start websocket stuff 2025-10-20 15:43:52 -07:00
64 changed files with 3597 additions and 1047 deletions
+7
View File
@@ -0,0 +1,7 @@
tsc:
cd priv/static/js &&\
tsc
watch:
cd priv/static/js &&\
tsc --watch
+13
View File
@@ -1,3 +1,16 @@
2026-02-25(PRH):
grids: instead of spying the chain for a tx, let's use dead drop
- so for "generate", need to form tx for the user to sign
- make dead drop -> have process that knows each tx and the dead drop location
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
+37 -3
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
```
+8 -3
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,[]}}]}.
+8 -1
View File
@@ -4,7 +4,7 @@
qargs = undefined :: undefined | #{Key :: binary() := Value :: binary()}, qargs = undefined :: undefined | #{Key :: binary() := Value :: binary()},
fragment = undefined :: undefined | none | binary(), fragment = undefined :: undefined | none | binary(),
version = undefined :: undefined | http10 | http11 | http20, version = undefined :: undefined | http10 | http11 | http20,
headers = undefined :: undefined | [{Key :: binary(), Value :: binary()}], headers = undefined :: undefined | #{Key :: binary() := Value :: binary()},
cookies = undefined :: undefined | #{Key :: binary() := Value :: binary()}, cookies = undefined :: undefined | #{Key :: binary() := Value :: binary()},
enctype = undefined :: undefined | none | urlencoded | json | multipart(), enctype = undefined :: undefined | none | urlencoded | json | multipart(),
size = undefined :: undefined | none | non_neg_integer(), size = undefined :: undefined | none | non_neg_integer(),
@@ -23,3 +23,10 @@
-type body() :: {partial, binary()} | {multipart, [body_part()]} | zj:value() | binary(). -type body() :: {partial, binary()} | {multipart, [body_part()]} | zj:value() | binary().
-type body_part() :: {Field :: binary(), Data :: binary()} -type body_part() :: {Field :: binary(), Data :: binary()}
| {Field :: binary(), Name :: binary(), Data :: binary()}. | {Field :: binary(), Name :: binary(), Data :: binary()}.
-type request() :: #request{}.
-type response() :: #response{}.
-type tcp_error() :: closed
| {timeout, RestData :: binary() | erlang:iovec()}
| inet:posix().
-135
View File
@@ -1,135 +0,0 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>WF Compiler Demo</title>
<link rel="stylesheet" href="./default.css">
</head>
<body>
<div class="content">
<h1 class="content-title">WFC Demo</h1>
<div class="content-body">
<textarea id="wfc-output"
disabled
></textarea>
<input autofocus id="wfc-input"></textarea>
<h2>Settings</h2>
<input type="checkbox" checked id="auto-resize-output">Auto-resize output</input> <br>
<input type="checkbox" checked id="auto-scroll" >Auto-scroll output to bottom</input>
</div>
</div>
<script>
let ielt = document.getElementById('wfc-input');
let oelt = document.getElementById('wfc-output');
let MAX_OELT_HEIGHT = 300;
function auto_resize_output() {
// if the user has manually resized their output, we do nothing
if (document.getElementById('auto-resize-output').checked) {
// resize it automagically up to 500px
if (oelt.scrollHeight < MAX_OELT_HEIGHT) {
oelt.style.height = String(oelt.scrollHeight) + 'px';
}
else {
oelt.style.height = String(MAX_OELT_HEIGHT) + 'px';
}
}
}
function auto_scroll_to_bottom() {
if (document.getElementById('auto-scroll').checked) {
// scroll to bottom
oelt.scrollTop = oelt.scrollHeight;
}
}
async function on_server_return(response) {
console.log('on_server_return:', response);
if (response.ok) {
let jsbs = await response.json();
console.log('jsbs', jsbs);
// jsbs: {ok: true, result: string} | {ok: false, error: string}
if (jsbs.ok) {
// this means got a result back from server
// put it in
oelt.value += jsbs.result;
oelt.value += '\n';
}
else {
// this is an error at the WFC level
oelt.value += jsbs.error;
oelt.value += '\n';
}
}
// this means we sent an invalid request
else {
oelt.value += 'HTTP ERROR, SEE BROWSER CONSOLE\n'
}
}
function on_some_bullshit(x) {
console.log('on_some_bullshit:', x);
oelt.value += 'NETWORK ERROR, SEE BROWSER CONSOLE\n'
}
function fetch_wfcin(user_line) {
let req_body_obj = {wfcin: user_line};
// let req_body_str = JSON.stringify(req_body_obj, undefined, 4);
let req_body_str = JSON.stringify(req_body_obj);
let req_options = {method: 'POST',
headers: {'content-type': 'application/json'},
body: req_body_str};
let response_promise = fetch('/wfcin', req_options);
response_promise.then(on_server_return, on_some_bullshit);
// this is a promise for a response
//console.log(response_promise);
}
// when user hits any key
function on_input_key(evt) {
if (evt.key === 'Enter') {
// don't do default thing
evt.preventDefault();
// grab contents
let contents = ielt.value;
// if contents are nonempty
let nonempty_contents = contents.trim().length > 0;
if (nonempty_contents) {
// put in output
// // if it's nonempty add a newline
// if (oelt.value.length > 0) {
// oelt.value += '\n';
// }
oelt.value += '> ' + contents + '\n';
oelt.hidden = false;
// query backend for result
fetch_wfcin(contents.trim());
// clear input
ielt.value = '';
// auto-resize
auto_resize_output();
auto_scroll_to_bottom();
}
}
}
function main() {
ielt.addEventListener('keydown', on_input_key);
}
main();
</script>
</body>
</html>
View File
+20
View File
@@ -0,0 +1,20 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>FIXME</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: FIXME</h1>
</div>
</body>
</html>
+9
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
*/
@@ -25,6 +25,19 @@ body {
line-height: 1.4; line-height: 1.4;
} }
/* titlebar */
#titlebar {
background: var(--lgray2);
height: 40px;
width: 100%;
}
a.tb-home{
font-size: 30px;
text-decoration: none;
font-weight: bold;
}
.content { .content {
max-width: 800px; max-width: 800px;
+71
View File
@@ -0,0 +1,71 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>Websockets echo test</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">Websockets echo test</h1>
<div class="content-body">
<textarea id="wfc-output"
disabled></textarea>
<input autofocus id="wfc-input"></input>
</div>
</div>
<script>
let ielt = document.getElementById('wfc-input');
let oelt = document.getElementById('wfc-output');
let ws = new WebSocket("/ws/echo");
// 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) {
console.log('message to server:', contents.trim());
// query backend for result
ws.send(contents.trim());
// clear input
ielt.value = '';
// add to output
oelt.value += '> ';
oelt.value += trimmed;
oelt.value += '\n';
}
}
}
function main() {
ielt.addEventListener('keydown', on_input_key);
ws.onmessage =
function (msg_evt) {
console.log('message from server:', msg_evt);
let msg_str = msg_evt.data;
oelt.value += '< ';
oelt.value += msg_str;
oelt.value += '\n';
};
}
main();
</script>
</body>
</html>
+60
View File
@@ -0,0 +1,60 @@
<!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 = "69"
disabled>
<br>
<label for="grids-p">Payload:</label>
<input type = "text"
id = "grids-p"
disabled>
<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>
+25
View File
@@ -0,0 +1,25 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>WF Compiler 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: index</h1>
<ul>
<li><a href="/echo.html">Echo</a></li>
<li><a href="/grids-basic.html">GRIDS: Basic Demo</a></li>
<li><a href="/wfc.html">WFC</a></li>
</ul>
</div>
</body>
</html>
+29
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>>;
+87
View File
@@ -0,0 +1,87 @@
"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');
let rand_data = new Uint8Array(32);
window.crypto.getRandomValues(rand_data);
let hex = rand_data.toHex().toUpperCase();
p_input.value = 'text payload ' + hex;
// 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-mkdd';
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
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,IAAI,SAAS,GAAgB,IAAI,UAAU,CAAC,EAAE,CAAC,CAAC;IAChD,MAAM,CAAC,MAAM,CAAC,eAAe,CAAC,SAAS,CAAC,CAAC;IACzC,IAAI,GAAG,GAAY,SAAS,CAAC,KAAK,EAAE,CAAC,WAAW,EAAE,CAAC;IACnD,OAAO,CAAC,KAAK,GAAG,eAAe,GAAG,GAAG,CAAC;IAEtC,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,CAAC;QACZ,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;IACjC,CAAC;SACI,CAAC;QACF,KAAK,CAAC,SAAS,GAAG,MAAM,CAAC,KAAK,CAAC,CAAC;IACpC,CAAC;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,aAAa,CAAC;IACxB,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,CAAC;QACD,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,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"}
+8
View File
@@ -0,0 +1,8 @@
/**
* FEWD common js lib functions
*
* @module
*/
export { auto_resize, auto_scroll_to_bottom };
declare function auto_resize(checkbox_element: HTMLInputElement, target_element: HTMLTextAreaElement, max_height: number): void;
declare function auto_scroll_to_bottom(checkbox_element: HTMLInputElement, target_element: HTMLTextAreaElement): void;
+24
View File
@@ -0,0 +1,24 @@
/**
* FEWD common js lib functions
*
* @module
*/
export { auto_resize, auto_scroll_to_bottom };
function auto_resize(checkbox_element, target_element, max_height) {
// if the user has manually resized their output, we do nothing
if (checkbox_element.checked) {
let target_height = target_element.scrollHeight;
// resize it automagically up to 500px
if (target_height < max_height)
target_element.style.height = String(target_height) + 'px';
else
target_element.style.height = String(max_height) + 'px';
}
}
function auto_scroll_to_bottom(checkbox_element, target_element) {
if (checkbox_element.checked) {
// scroll to bottom
target_element.scrollTop = target_element.scrollHeight;
}
}
//# sourceMappingURL=libfewd.js.map
+1
View File
@@ -0,0 +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"}
+6
View File
@@ -0,0 +1,6 @@
/**
* Tetris
*
* @module
*/
export {};
+30
View File
@@ -0,0 +1,30 @@
/**
* Tetris
*
* @module
*/
main();
async function main() {
let ws = new WebSocket("/ws/tetris");
let elt_tetris_state = document.getElementById('tetris-state');
ws.onmessage =
(e) => {
handle_evt(e, elt_tetris_state);
};
}
//-----------------------------------------------------
// Tetris
//-----------------------------------------------------
/**
* take the entire tetris state, render the html elements
*
* then fish out the element in the document, and replace it
*
* blitting basically
*/
async function handle_evt(e, oelt) {
let state_str = e.data;
oelt.value = state_str;
}
export {};
//# sourceMappingURL=tetris.js.map
+1
View File
@@ -0,0 +1 @@
{"version":3,"file":"tetris.js","sourceRoot":"","sources":["../ts/tetris.ts"],"names":[],"mappings":"AAAA;;;;GAIG;AAQH,IAAI,EAAE,CAAC;AAEP,KAAK,UACL,IAAI;IAIA,IAAI,EAAE,GAAuC,IAAI,SAAS,CAAC,YAAY,CAAC,CAAqC;IAC7G,IAAI,gBAAgB,GAAyB,QAAQ,CAAC,cAAc,CAAC,cAAc,CAAwB,CAAE;IAE7G,EAAE,CAAC,SAAS;QACR,CAAC,CAAe,EAAE,EAAE;YAChB,UAAU,CAAC,CAAC,EAAE,gBAAgB,CAAC,CAAC;QACpC,CAAC,CAAA;AACT,CAAC;AAED,uDAAuD;AACvD,SAAS;AACT,uDAAuD;AAGvD;;;;;;GAMG;AACH,KAAK,UACL,UAAU,CACL,CAAmB,EACnB,IAA0B;IAG3B,IAAI,SAAS,GAAY,CAAC,CAAC,IAAc,CAAC;IAC1C,IAAI,CAAC,KAAK,GAAG,SAAS,CAAC;AAC3B,CAAC"}
+6
View File
@@ -0,0 +1,6 @@
/**
* Home page ts/js
*
* @module
*/
export {};
+79
View File
@@ -0,0 +1,79 @@
/**
* Home page ts/js
*
* @module
*/
import * as libfewd from './libfewd.js';
//------------------------------------------------------------------
// page element stuff
//------------------------------------------------------------------
main();
function main() {
let ielt = document.getElementById('wfc-input');
let oelt = document.getElementById('wfc-output');
let cb_resize = document.getElementById('auto-resize-output');
let cb_scroll = document.getElementById('auto-scroll');
let MAX_OELT_HEIGHT = 300;
ielt.addEventListener('keydown', function (e) {
on_input_key(e, ielt, oelt, cb_resize, cb_scroll, MAX_OELT_HEIGHT);
});
}
// when user hits any key
async function on_input_key(evt, ielt, oelt, cb_resize, cb_scroll, max_height) {
if (evt.key === 'Enter') {
// don't do default thing
evt.preventDefault();
// grab contents
let contents = ielt.value;
let trimmed = contents.trim();
let nonempty = trimmed.length > 0;
// if contents are nonempty
if (nonempty) {
// clear input
ielt.value = '';
// put in output
oelt.value += '> ' + trimmed + '\n';
oelt.hidden = false;
// query backend for result
let result = await fetch_wfcin(trimmed);
if (result.ok)
oelt.value += result.result;
else
oelt.value += result.error;
oelt.value += '\n';
// auto-resize
libfewd.auto_resize(cb_resize, oelt, max_height);
libfewd.auto_scroll_to_bottom(cb_scroll, oelt);
}
}
}
function assert(condition, fail_msg) {
if (!condition)
throw new Error(fail_msg);
}
async function fetch_wfcin(user_line) {
let req_body_obj = { wfcin: user_line };
let req_body_str = JSON.stringify(req_body_obj);
let req_options = { method: 'POST',
headers: { 'content-type': 'application/json' },
body: req_body_str };
// default result = somehow neither branch of code below was run(?)
// putting this here so ts doesn't chimp out
let result = { ok: false,
error: 'IT DO BE LIKE THAT MISTA STANCIL' };
try {
let response = await fetch('/wfcin', 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=wfc.js.map
+1
View File
@@ -0,0 +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"}
+136
View File
@@ -0,0 +1,136 @@
/**
* 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;
let rand_data : Uint8Array = new Uint8Array(32);
window.crypto.getRandomValues(rand_data);
let hex : string = rand_data.toHex().toUpperCase();
p_input.value = 'text payload ' + hex;
// 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-mkdd';
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;
}
+43
View File
@@ -0,0 +1,43 @@
/**
* FEWD common js lib functions
*
* @module
*/
export {
auto_resize,
auto_scroll_to_bottom
};
function
auto_resize
(checkbox_element : HTMLInputElement,
target_element : HTMLTextAreaElement,
max_height : number)
: void
{
// if the user has manually resized their output, we do nothing
if (checkbox_element.checked) {
let target_height: number = target_element.scrollHeight;
// resize it automagically up to 500px
if (target_height < max_height)
target_element.style.height = String(target_height) + 'px';
else
target_element.style.height = String(max_height) + 'px';
}
}
function
auto_scroll_to_bottom
(checkbox_element : HTMLInputElement,
target_element : HTMLTextAreaElement)
: void
{
if (checkbox_element.checked) {
// scroll to bottom
target_element.scrollTop = target_element.scrollHeight;
}
}
+49
View File
@@ -0,0 +1,49 @@
/**
* Tetris
*
* @module
*/
export {
};
import * as libfewd from './libfewd.js';
main();
async function
main
()
: Promise<void>
{
let ws : WebSocket = new WebSocket("/ws/tetris") ;
let elt_tetris_state : HTMLTextAreaElement = document.getElementById('tetris-state') as HTMLTextAreaElement ;
ws.onmessage =
(e: MessageEvent) => {
handle_evt(e, elt_tetris_state);
}
}
//-----------------------------------------------------
// Tetris
//-----------------------------------------------------
/**
* take the entire tetris state, render the html elements
*
* then fish out the element in the document, and replace it
*
* blitting basically
*/
async function
handle_evt
(e : MessageEvent,
oelt : HTMLTextAreaElement)
: Promise<void>
{
let state_str : string = e.data as string;
oelt.value = state_str;
}
+132
View File
@@ -0,0 +1,132 @@
/**
* Home page ts/js
*
* @module
*/
import * as libfewd from './libfewd.js'
//------------------------------------------------------------------
// page element stuff
//------------------------------------------------------------------
main();
function
main
()
: void
{
let ielt : HTMLInputElement = document.getElementById('wfc-input') as HTMLInputElement ;
let oelt : HTMLTextAreaElement = document.getElementById('wfc-output') as HTMLTextAreaElement ;
let cb_resize : HTMLInputElement = document.getElementById('auto-resize-output') as HTMLInputElement ;
let cb_scroll : HTMLInputElement = document.getElementById('auto-scroll') as HTMLInputElement ;
let MAX_OELT_HEIGHT : number = 300;
ielt.addEventListener('keydown',
function(e: KeyboardEvent) {
on_input_key(e, ielt, oelt, cb_resize, cb_scroll, MAX_OELT_HEIGHT);
}
);
}
// when user hits any key
async function
on_input_key
(evt : KeyboardEvent,
ielt : HTMLInputElement,
oelt : HTMLTextAreaElement,
cb_resize : HTMLInputElement,
cb_scroll : HTMLInputElement,
max_height : number)
: Promise<void>
{
if (evt.key === 'Enter') {
// don't do default thing
evt.preventDefault();
// grab contents
let contents : string = ielt.value;
let trimmed : string = contents.trim();
let nonempty : boolean = trimmed.length > 0;
// if contents are nonempty
if (nonempty) {
// clear input
ielt.value = '';
// put in output
oelt.value += '> ' + trimmed + '\n';
oelt.hidden = false;
// query backend for result
let result : wfcout = await fetch_wfcin(trimmed);
if (result.ok)
oelt.value += result.result;
else
oelt.value += result.error;
oelt.value += '\n';
// auto-resize
libfewd.auto_resize(cb_resize, oelt, max_height);
libfewd.auto_scroll_to_bottom(cb_scroll, oelt);
}
}
}
//------------------------------------------------------------------
// wfc api
//------------------------------------------------------------------
type ok_err<t> = {ok: true, result: t}
| {ok: false, error: string};
type wfcin = {wfcin: string};
type wfcout = ok_err<string>;
function
assert
(condition : boolean,
fail_msg : string)
: void
{
if(!condition)
throw new Error(fail_msg);
}
async function
fetch_wfcin
(user_line : string)
: Promise<wfcout>
{
let req_body_obj = {wfcin: user_line};
let req_body_str = JSON.stringify(req_body_obj);
let req_options = {method: 'POST',
headers: {'content-type': 'application/json'},
body: req_body_str};
// default result = somehow neither branch of code below was run(?)
// putting this here so ts doesn't chimp out
let result: wfcout = {ok : false,
error : 'IT DO BE LIKE THAT MISTA STANCIL'};
try {
let response : Response = await fetch('/wfcin', req_options);
if (response.ok)
result = await response.json() as wfcout;
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;
}
+16
View File
@@ -0,0 +1,16 @@
{"compilerOptions" : {"target" : "es2022",
"strict" : true,
"esModuleInterop" : true,
"skipLibCheck" : true,
"forceConsistentCasingInFileNames" : true,
"noImplicitAny" : true,
"strictNullChecks" : true,
"strictPropertyInitialization" : true,
"sourceMap" : true,
"outDir" : "dist",
"declaration" : true},
"$schema" : "https://json.schemastore.org/tsconfig",
"display" : "Recommended",
"include" : ["ts/**/*"],
"exclude" : [],
"composite" : true}
+30
View File
@@ -0,0 +1,30 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>FEWD: WF Compiler 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">WFC Demo</h1>
<div class="content-body">
<textarea disabled id="wfc-output"></textarea>
<input autofocus id="wfc-input"></input>
<h2>Settings</h2>
<input type="checkbox" checked id="auto-resize-output">Auto-resize output</input> <br>
<input type="checkbox" checked id="auto-scroll" >Auto-scroll output to bottom</input>
</div>
</div>
<script type="module" src="./js/dist/wfc.js"></script>
</body>
</html>
+150
View File
@@ -0,0 +1,150 @@
% @doc grids cache
-module(fd_gridsd).
-vsn("0.2.0").
-behavior(gen_server).
-export_type([
]).
-export([
%% caller context
mkdd/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").
-type hex() :: binary().
-define(SEC, 1).
-define(MIN, 60*SEC).
-define(DEAD_DROP_TTL, 30*MIN).
-record(dd,
{created_at :: integer(),
payload :: string()}).
-type dd() :: #dd{}.
-record(s,
{drops = #{} :: #{hex() := dd()}}).
-type state() :: #s{}.
%%-----------------------------------------------------------------------------
%% caller context
%%-----------------------------------------------------------------------------
-spec mkdd(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
% make a dead drop
mkdd(NetworkId, Recipient, Amount, Payload) ->
gen_server:call(?MODULE, {mkdd, 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({mkdd, NetworkId, Recipient, Amount, Payload}, From, State) ->
case do_mkdd(NetworkId, Recipient, Amount, Payload, 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 do_mkdd(NetworkId, Recipient, Amount, Payload, State) -> Result
when NetworkId :: string(),
Recipient :: string(),
Amount :: pos_integer(),
Payload :: binary(),
State :: state(),
Result :: {ok, URL, QR_PNG, NewState}
| {error, Reason},
URL :: string(),
QR_PNG :: binary(),
NewState :: state(),
Reason :: any().
do_mkdd(NetId, Recipient, Amount, Payload, State = #s{drops = Drops}) ->
HexStr = rand_hex(),
CreatedAt = now_sec(),
TxStr = form_txstr(NetId, Recipient, Amount, Payload),
DD = #dd{created_at = CreatedAt, payload = TxStr},
URL = dd_url(HexStr),
PNG = qr:encode_png(unicode:characters_to_binary(URL)),
NewDrops = maps:put(HexStr, DD, Drops),
NewState = State#s{drops = NewDrops},
{ok, URL, PNG, NewState}.
now_sec() ->
calendar:datetime_to_gregorian_seconds(calendar:universal_time()).
-spec rand_hex() -> hex().
rand_hex() ->
unicode:characters_to_binary(hexify(rand:bytes(10))).
hexify(<<B:8, Rest/binary>>) when B < 16#10 -> ["0", integer_to_list(B, 16), hexify(Rest)];
hexify(<<B:8, Rest/binary>>) -> [integer_to_list(B, 16), hexify(Rest)];
hexify(<<>>) -> [].
dd_url(HexStr) ->
unicode:characters_to_list(["grids://", fewd:host(), "/1/d/", HexStr]).
% ref
form_txstr(_NetId, _Recipient, _Amount, _Payload) ->
"foobar".
+39
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}}.
+170 -133
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").
@@ -32,7 +32,7 @@
-record(s, {socket = none :: none | gen_tcp:socket(), -record(s, {socket = none :: none | gen_tcp:socket(),
next = none :: none | binary()}). next = <<>> :: binary()}).
%% An alias for the state record above. Aliasing state can smooth out annoyances %% An alias for the state record above. Aliasing state can smooth out annoyances
@@ -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.
@@ -128,38 +128,31 @@ listen(Parent, Debug, ListenSocket) ->
%% The service loop itself. This is the service state. The process blocks on receive %% The service loop itself. This is the service state. The process blocks on receive
%% of Erlang messages, TCP segments being received themselves as Erlang messages. %% of Erlang messages, TCP segments being received themselves as Erlang messages.
loop(Parent, Debug, State = #s{socket = Socket, next = Next}) -> loop(Parent, Debug, State = #s{socket = Socket, next = Next0}) ->
ok = inet:setopts(Socket, [{active, once}]), ok = inet:setopts(Socket, [{active, once}]),
receive receive
{tcp, Socket, Message} -> {tcp, Socket, Message} ->
tell("~p Next = ~p", [?LINE, Next]), Received = <<Next0/binary, Message/binary>>,
Received =
case Next of
none -> Message;
_ -> <<Next/binary, Message/binary>>
end,
tell("qhl_parse(Socket, ~tp)", [Received]),
case qhl:parse(Socket, Received) of case qhl:parse(Socket, Received) of
{ok, Req, NewNext} -> {ok, Req, Next1} ->
tell("qhl return: {ok, ~p, ~p}", [Req, NewNext]), Next2 = handle_request(Socket, Req, Next1),
handle_request(Socket, Req), NewState = State#s{next = Next2},
NewState = State#s{next = NewNext},
loop(Parent, Debug, NewState); loop(Parent, Debug, NewState);
Error -> Error ->
%% should trigger bad request %% should trigger bad request
io:format("~p QHL parse error: ~tp", [?LINE, Error]), tell(error, "~p QHL parse error: ~tp", [?LINE, Error]),
io:format("~p bad request:~n~ts", [?LINE, Received]), tell(error, "~p bad request:~n~ts", [?LINE, Received]),
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.
@@ -217,52 +210,151 @@ system_replace_state(StateFun, State) ->
%%% http request handling %%% http request handling
handle_request(Sock, R = #request{method = M, path = P}) when M =/= undefined, P =/= undefined -> -spec handle_request(Sock, Request, Received) -> NewReceived
tell("~p ~ts", [M, P]), when Sock :: gen_tcp:socket(),
route(Sock, M, P, R). Request :: request(),
Received :: binary(),
NewReceived :: binary().
handle_request(Sock, R = #request{method = M, path = P}, Received) when M =/= undefined, P =/= undefined ->
tell("~tp ~tp ~ts", [self(), M, P]),
route(Sock, M, P, R, Received).
route(Sock, get, Route, _Request) ->
-spec route(Sock, Method, Route, Request, Received) -> NewReceived
when Sock :: gen_tcp:socket(),
Method :: get | post,
Route :: binary(),
Request :: request(),
Received :: binary(),
NewReceived :: binary().
route(Sock, get, Route, Request, Received) ->
case Route of case Route of
<<"/">> -> home(Sock); <<"/ws/echo">> -> ws_echo(Sock, Request) , Received;
<<"/default.css">> -> default_css(Sock); <<"/">> -> route_static(Sock, <<"/index.html">>) , Received;
_ -> http_err(Sock, 404) _ -> route_static(Sock, Route) , Received
end; end;
route(Sock, post, Route, Request) -> route(Sock, post, Route, Request, Received) ->
case Route of case Route of
<<"/wfcin">> -> wfcin(Sock, Request); <<"/grids-mkdd">> -> grids_mkdd(Sock, Request) , Received;
_ -> http_err(Sock, 404) <<"/wfcin">> -> wfcin(Sock, Request) , Received;
_ -> fd_httpd_utils:http_err(Sock, 404) , Received
end; end;
route(Sock, _, _, _) -> route(Sock, _, _, _, Received) ->
http_err(Sock, 404). fd_httpd_utils:http_err(Sock, 404),
Received.
home(Sock) ->
%% fixme: cache -spec route_static(Socket, Route) -> ok
Path_IH = filename:join([zx:get_home(), "priv", "index.html"]), when Socket :: gen_tcp:socket(),
case file:read_file(Path_IH) of Route :: binary().
{ok, Body} ->
Resp = #response{headers = [{"content-type", "text/html"}], route_static(Sock, Route) ->
body = Body}, respond_static(Sock, fd_httpd_sfc:query(Route)).
respond(Sock, Resp);
Error ->
tell("error: ~p~n", [self(), Error]),
http_err(Sock, 500) -spec respond_static(Sock, MaybeEty) -> ok
when Sock :: gen_tcp:socket(),
MaybeEty :: fd_httpd_sfc:maybe_entry().
respond_static(Sock, {found, Entry}) ->
% -record(e, {fs_path :: file:filename(),
% last_modified :: file:date_time(),
% mime_type :: string(),
% encoding :: encoding(),
% contents :: binary()}).
Headers0 =
case fd_httpd_sfc_entry:encoding(Entry) of
gzip -> [{"content-encoding", "gzip"}];
none -> []
end,
Headers1 = [{"content-type", fd_httpd_sfc_entry:mime_type(Entry)} | Headers0],
Response = #response{headers = Headers1,
body = fd_httpd_sfc_entry:contents(Entry)},
fd_httpd_utils:respond(Sock, Response);
respond_static(Sock, not_found) ->
fd_httpd_utils:http_err(Sock, 404).
%% ------------------------------
%% echo
%% ------------------------------
ws_echo(Sock, Request) ->
try
ws_echo2(Sock, Request)
catch
X:Y:Z ->
tell(error, "CRASH ws_echo: ~tp:~tp:~tp", [X, Y, Z]),
fd_httpd_utils:http_err(Sock, 500)
end. end.
default_css(Sock) -> ws_echo2(Sock, Request) ->
%% fixme: cache case qhl_ws:handshake(Request) of
Path_IH = filename:join([zx:get_home(), "priv", "default.css"]), {ok, Response} ->
case file:read_file(Path_IH) of fd_httpd_utils:respond(Sock, Response),
{ok, Body} -> ws_echo_loop(Sock);
Resp = #response{headers = [{"content-type", "text/css"}],
body = Body},
respond(Sock, Resp);
Error -> Error ->
io:format("~p error: ~p~n", [self(), Error]), tell("ws_echo: error: ~tp", [Error]),
http_err(Sock, 500) fd_httpd_utils:http_err(Sock, 400)
end. end.
ws_echo_loop(Sock) ->
ws_echo_loop(Sock, [], <<>>).
ws_echo_loop(Sock, Frames, Received) ->
tell("~p ws_echo_loop(Sock, ~tp, ~tp)", [self(), Frames, Received]),
case qhl_ws:recv(Sock, Received, 5*qhl_ws:min(), Frames) of
{ok, Message, NewFrames, NewReceived} ->
tell("~p echo message: ~tp", [self(), Message]),
% send the same message back
ok = qhl_ws:send(Sock, Message),
ws_echo_loop(Sock, NewFrames, NewReceived);
Error ->
tell(error, "ws_echo_loop: error: ~tp", [Error]),
qhl_ws:send(Sock, {close, <<>>}),
error(Error)
end.
%% ------------------------------
%% grids
%% ------------------------------
grids_mkdd(Sock, #request{enctype = json,
body = B = #{"network_id" := NetId,
"recipient" := Recipient,
"amount" := Amount,
"payload" := Payload}}) ->
tell("grids_mkdd good request: ~tp", [B]),
RespObj =
case fd_gridsd:mkdd(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_mkdd(Sock, Request) ->
tell("grids_mkdd: bad request: ~tp", [Request]),
fd_httpd_utils:http_err(Sock, 400).
%% ------------------------------
%% wfc
%% ------------------------------
wfcin(Sock, #request{enctype = json, wfcin(Sock, #request{enctype = json,
cookies = Cookies, cookies = Cookies,
body = #{"wfcin" := Input}}) -> body = #{"wfcin" := Input}}) ->
@@ -274,95 +366,40 @@ 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} -> {jsgud("<noop>"), Ctx1}; {ok, noop, Ctx1} -> {fd_httpd_utils:jsgud("<noop>"), Ctx1};
{ok, Sentence, Ctx1} -> {jsgud(wfc_pp:sentence(Sentence)), Ctx1}; {ok, Sentence, Ctx1} -> {fd_httpd_utils:jsgud(wfc_pp:sentence(Sentence)), Ctx1};
{error, Message} -> {jsbad(Message), Ctx0} {error, Message} -> {fd_httpd_utils:jsbad(Message), Ctx0}
end; end;
{error, Message} -> {error, Message} ->
{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])),
{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},
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]),
http_err(Sock, 400). fd_httpd_utils:http_err(Sock, 400).
-spec ctx(Cookies) -> {Cookie, Context}
when Cookies :: #{binary() := Cookie},
Cookie :: binary(),
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(_) ->
{new_cookie(), wfc_eval_context:default()}. {fd_httpd_utils:new_cookie(), wfc_eval_context:default()}.
new_cookie() ->
binary:encode_hex(crypto:strong_rand_bytes(8)).
jsgud(X) ->
#{"ok" => true,
"result" => X}.
jsbad(X) ->
#{"ok" => false,
"error" => X}.
http_err(Sock, N) ->
Slogan = qhl:slogan(N),
Body = ["<!doctype html>"
"<html lang=\"en\">"
"<head>"
"<meta charset=\"utf-8\">"
"<title>QHL: ", integer_to_list(N), " ", Slogan, "</title>"
"</head>"
"<body>"
"<h1>"
"QHL: ", integer_to_list(N), " ", Slogan,
"</h1>"
"</body>"
"</html>"],
Resp = #response{code = N,
headers = [{"content/type", "text/html"}],
body = Body},
respond(Sock, Resp).
respond(Sock, Response) ->
gen_tcp:send(Sock, fmtresp(Response)).
fmtresp(#response{type = page, %% no idea what {data, String} is
version = http11,
code = Code,
headers = Hs,
body = Body}) ->
%% need byte size for binary
Headers = add_headers(Hs, Body),
[io_lib:format("HTTP/1.1 ~tp ~ts", [Code, qhl:slogan(Code)]), "\r\n",
[io_lib:format("~ts: ~ts\r\n", [K, V]) || {K, V} <- Headers],
"\r\n",
Body].
%% body needed just for size
add_headers(Hs, Body) ->
Defaults = default_headers(Body),
Hs2 = proplists:to_map(Hs),
proplists:from_map(maps:merge(Defaults, Hs2)).
default_headers(Body) ->
BodySize = byte_size(iolist_to_binary(Body)),
#{"Server" => "fewd 0.1.0",
"Date" => qhl:ridiculous_web_date(),
"Content-Length" => io_lib:format("~p", [BodySize])}.
@@ -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.
@@ -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]}}.
@@ -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}}.
+112
View File
@@ -0,0 +1,112 @@
% @doc static file cache
-module(fd_httpd_sfc).
-vsn("0.2.0").
-behavior(gen_server).
-export_type([
entry/0,
maybe_entry/0
]).
-export([
%% caller context
base_path/0,
renew/0, query/1,
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").
-type entry() :: fd_httpd_sfc_entry:entry().
-type maybe_entry() :: {found, fd_httpd_sfc_entry:entry()} | not_found.
-record(s, {base_path = base_path() :: file:filename(),
cache = fd_httpd_sfc_cache:new(base_path()) :: fd_httpd_sfc_cache:cache(),
auto_renew = 0_500 :: pos_integer()}).
%-type state() :: #s{}.
%%-----------------------------------------------------------------------------
%% caller context
%%-----------------------------------------------------------------------------
-spec base_path() -> file:filename().
base_path() ->
filename:join([zx:get_home(), "priv", "static"]).
-spec renew() -> ok.
renew() ->
gen_server:cast(?MODULE, renew).
-spec query(HttpPath) -> MaybeEntry
when HttpPath :: binary(),
MaybeEntry :: maybe_entry().
query(Path) ->
gen_server:call(?MODULE, {query, Path}).
start_link() ->
gen_server:start_link({local, ?MODULE}, ?MODULE, none, []).
%%-----------------------------------------------------------------------------
%% process context below this line
%%-----------------------------------------------------------------------------
%% gen_server callbacks
init(none) ->
tell("starting fd_httpd_sfc"),
InitState = #s{},
erlang:send_after(InitState#s.auto_renew, self(), auto_renew),
{ok, InitState}.
handle_call({query, Path}, _, State = #s{cache = Cache}) ->
Reply = fd_httpd_sfc_cache:query(Path, Cache),
{reply, Reply, State};
handle_call(Unexpected, From, State) ->
tell("~tp: unexpected call from ~tp: ~tp", [?MODULE, Unexpected, From]),
{noreply, State}.
handle_cast(renew, State) ->
NewState = i_renew(State),
{noreply, NewState};
handle_cast(Unexpected, State) ->
tell("~tp: unexpected cast: ~tp", [?MODULE, Unexpected]),
{noreply, State}.
handle_info(auto_renew, State = #s{auto_renew = MS}) ->
log(info, "~tp: auto_renew", [?MODULE]),
erlang:send_after(MS, self(), auto_renew),
NewState = i_renew(State),
{noreply, NewState};
handle_info(Unexpected, State) ->
tell("~tp: unexpected info: ~tp", [?MODULE, Unexpected]),
{noreply, State}.
code_change(_, State, _) ->
{ok, State}.
terminate(_, _) ->
ok.
%%-----------------------------------------------------------------------------
%% internals
%%-----------------------------------------------------------------------------
i_renew(State = #s{base_path = BasePath}) ->
NewCache = fd_httpd_sfc_cache:new(BasePath),
NewState = State#s{cache = NewCache},
NewState.
+82
View File
@@ -0,0 +1,82 @@
% @doc
% cache data management
-module(fd_httpd_sfc_cache).
-vsn("0.2.0").
-export_type([
cache/0
]).
-export([
query/2,
new/0, new/1
]).
-include("$zx_include/zx_logger.hrl").
-type cache() :: #{HttpPath :: binary() := Entry :: fd_httpd_sfc_entry:entry()}.
-spec query(HttpPath, Cache) -> Result
when HttpPath :: binary(),
Cache :: cache(),
Result :: {found, Entry}
| not_found,
Entry :: fd_httpd_sfc_entry:entry().
query(HttpPath, Cache) ->
case maps:find(HttpPath, Cache) of
{ok, Entry} -> {found, Entry};
error -> not_found
end.
-spec new() -> cache().
new() -> #{}.
-spec new(BasePath) -> cache()
when BasePath :: file:filename().
% @doc
% if you give a file path it just takes the parent dir
%
% recursively crawls through file tree and picks
%
% IO errors will be logged but will result in cache misses
new(BasePath) ->
case filelib:is_file(BasePath) of
true -> new2(BasePath);
false ->
tell("~p:new(~p): no such file or directory, returning empty cache", [?MODULE, BasePath]),
#{}
end.
new2(BasePath) ->
BaseDir =
case filelib:is_dir(BasePath) of
true -> filename:absname(BasePath);
false -> filename:absname(filename:dirname(BasePath))
end,
BBaseDir = unicode:characters_to_binary(BaseDir),
HandlePath =
fun(AbsPath, AccCache) ->
BAbsPath = unicode:characters_to_binary(AbsPath),
HttpPath = remove_prefix(BBaseDir, BAbsPath),
NewCache =
case fd_httpd_sfc_entry:new(AbsPath) of
{found, Entry} -> maps:put(HttpPath, Entry, AccCache);
not_found -> AccCache
end,
NewCache
end,
filelib:fold_files(_dir = BaseDir,
_match = ".+",
_recursive = true,
_fun = HandlePath,
_init_acc = #{}).
remove_prefix(Prefix, From) ->
Size = byte_size(Prefix),
<<Prefix:Size/bytes, Rest/bytes>> = From,
Rest.
+100
View File
@@ -0,0 +1,100 @@
% @doc non-servery functions for static file caching
%
% this spams the filesystem, so it's not "pure" code
-module(fd_httpd_sfc_entry).
-vsn("0.2.0").
-export_type([
encoding/0,
entry/0
]).
-export([
%% constructor
new/1,
%% accessors
fs_path/1, last_modified/1, mime_type/1, encoding/1, contents/1
]).
-include("$zx_include/zx_logger.hrl").
%% types
% id = not compressed
-type encoding() :: none | gzip.
-record(e, {fs_path :: file:filename(),
last_modified :: file:date_time(),
mime_type :: string(),
encoding :: encoding(),
contents :: binary()}).
-opaque entry() :: #e{}.
%% accessors
fs_path(#e{fs_path = X}) -> X.
last_modified(#e{last_modified = X}) -> X.
mime_type(#e{mime_type = X}) -> X.
encoding(#e{encoding = X}) -> X.
contents(#e{contents = X}) -> X.
%% API
-spec new(Path) -> Result
when Path :: file:filename(),
Result :: {found, entry()}
| not_found.
% @doc
% absolute file path stored in resulting record
%
% returns not_found if ANY I/O error occurs during the process. will be logged
new(Path) ->
log(info, "~tp:new(~tp)", [?MODULE, Path]),
case file:read_file(Path) of
{ok, Binary} ->
{found, new2(Path, Binary)};
Error ->
tell("~tp:new(~tp): file read error: ~tp", [?MODULE, Path, Error]),
not_found
end.
%% can assume file exists
new2(FsPath, FileBytes) ->
LastModified = filelib:last_modified(FsPath),
{Encoding, MimeType} = mimetype_compress(FsPath),
Contents =
case Encoding of
none -> FileBytes;
gzip -> zlib:gzip(FileBytes)
end,
#e{fs_path = FsPath,
last_modified = LastModified,
mime_type = MimeType,
encoding = Encoding,
contents = Contents}.
mimetype_compress(FsPath) ->
case string:casefold(filename:extension(FsPath)) of
%% only including the ones i anticipate encountering
%% plaintext formats
".css" -> {gzip, "text/css"};
".htm" -> {gzip, "text/html"};
".html" -> {gzip, "text/html"};
".js" -> {gzip, "text/javascript"};
".json" -> {gzip, "application/json"};
".map" -> {gzip, "application/json"};
".md" -> {gzip, "text/markdown"};
".ts" -> {gzip, "text/x-typescript"};
".txt" -> {gzip, "text/plain"};
%% binary formats
".gif" -> {none, "image/gif"};
".jpg" -> {none, "image/jpeg"};
".jpeg" -> {none, "image/jpeg"};
".mp4" -> {none, "video/mp4"};
".png" -> {none, "image/png"};
".webm" -> {none, "video/webm"};
".webp" -> {none, "image/webp"};
_ -> {none, "application/octet-stream"}
end.
+119
View File
@@ -0,0 +1,119 @@
% @doc http utility functions
-module(fd_httpd_utils).
-vsn("0.2.0").
-export([
new_cookie/0,
jsgud/1, jsbad/1,
http_err/2,
respond/2,
fmtresp/1
]).
-include("http.hrl").
-include("$zx_include/zx_logger.hrl").
-spec new_cookie() -> Cookie
when Cookie :: binary().
new_cookie() ->
binary:encode_hex(crypto:strong_rand_bytes(8)).
-spec jsgud(JSON) -> Encodable
when JSON :: zj:value(),
Encodable :: JSON.
jsgud(X) ->
#{"ok" => true,
"result" => X}.
-spec jsbad(JSON) -> JSBad
when JSON :: zj:value(),
JSBad :: zj:value().
jsbad(X) ->
#{"ok" => false,
"error" => X}.
-spec http_err(Socket, ErrorCode) -> ok
when Socket :: gen_tcp:socket(),
ErrorCode :: integer().
http_err(Sock, N) ->
Slogan = qhl:slogan(N),
Body = ["<!doctype html>"
"<html lang=\"en\">"
"<head>"
"<meta charset=\"utf-8\">"
"<title>QHL: ", integer_to_list(N), " ", Slogan, "</title>"
"</head>"
"<body>"
"<h1>"
"QHL: ", integer_to_list(N), " ", Slogan,
"</h1>"
"</body>"
"</html>"],
Resp = #response{code = N,
headers = [{"content/type", "text/html"}],
body = Body},
respond(Sock, Resp).
-spec respond(Sock, Response) -> ok
when Sock :: gen_tcp:socket(),
Response :: response().
respond(Sock, Response = #response{code = Code}) ->
tell("~tp ~tp ~ts", [self(), Code, qhl:slogan(Code)]),
gen_tcp:send(Sock, fmtresp(Response)).
-spec fmtresp(Response) -> Formatted
when Response :: response(),
Formatted :: iolist().
fmtresp(#response{type = page, %% no idea what {data, String} is
version = http11,
code = Code,
headers = Hs,
body = Body}) ->
%% need byte size for binary
Headers = add_headers(Hs, Body),
[io_lib:format("HTTP/1.1 ~tp ~ts", [Code, qhl:slogan(Code)]), "\r\n",
[io_lib:format("~ts: ~ts\r\n", [K, V]) || {K, V} <- Headers],
"\r\n",
Body].
-spec add_headers(Existing, Body) -> Hdrs
when Existing :: [{iolist(), iolist()}],
Body :: iolist(),
Hdrs :: [{iolist(), iolist()}].
%% body needed just for size
add_headers(Hs, Body) ->
Defaults = default_headers(Body),
Hs2 = proplists:to_map(Hs),
proplists:from_map(maps:merge(Defaults, Hs2)).
-spec default_headers(Body) -> HdrsMap
when Body :: iolist(),
HdrsMap :: #{iolist() := iolist()}.
default_headers(Body) ->
BodySize = byte_size(iolist_to_binary(Body)),
#{"Server" => "fewd 0.2.0",
"Date" => qhl:ridiculous_web_date(),
"Content-Length" => io_lib:format("~p", [BodySize])}.
+84
View File
@@ -0,0 +1,84 @@
% @doc hz helper functions
-module(fd_hz).
-export_type([
]).
-export([
txs_current/0,
txs_since_height/1,
txs_minus/1,
txs_from_to/2,
current_height/0,
txs_of_height/1,
mhs_of_height/1,
txs_of_mh/1,
filter_spends/1,
filter_spend/1,
spend_info/1,
test/0
]).
-spec test() -> no_return().
test() ->
io:format("~tp~n", [hz:gen_current()]),
io:format("~tp~n", [hz:kb_current()]),
ok.
txs_current() ->
H = current_height(),
txs_of_height(H).
txs_since_height(H) ->
txs_from_to(H, current_height()).
txs_minus(N) ->
H = current_height(),
L = H - N,
txs_from_to(L, H).
txs_from_to(Min, Max) when Min =< Max ->
lists:append([txs_of_height(H) || H <- lists:seq(Min, Max)]);
txs_from_to(Min, Max) when Min > Max ->
[].
current_height() ->
{ok, H} = hz:kb_current_height(),
H.
txs_of_height(Height) ->
lists:append([txs_of_mh(MH) || MH <- mhs_of_height(Height)]).
-spec mhs_of_height(Height :: pos_integer()) -> term().
mhs_of_height(Height) ->
{ok, #{"micro_blocks" := MHs}} = hz:gen_by_height(Height),
MHs.
txs_of_mh(MH) ->
{ok, TXs} = hz:mb_txs(MH),
TXs.
filter_spends(TXs) ->
lists:filtermap(fun filter_spend/1, TXs).
filter_spend(#{"tx" := TX = #{"type" := "SpendTx"}}) -> {true, spend_info(TX)};
filter_spend(_) -> false.
spend_info(#{"type" := "SpendTx",
"recipient_id" := Recipient,
"amount" := Amount,
"payload" := Payload}) ->
{sp, Recipient, Amount, Payload}.
+213
View File
@@ -0,0 +1,213 @@
% @doc spy: knows constraints {recipient, amount, payload}
%
% spies the chain for transactions that satisfy that constraint
%
-module(fd_spy).
-vsn("0.2.0").
% MVP: register search patterns
% simply print to console when one of them is found
-behavior(gen_server).
-export_type([
]).
-export([
%% caller context
reg/3,
%% api
start_link/0,
%% process context
init/1, handle_call/3, handle_cast/2, handle_info/2,
code_change/3, terminate/2
]).
% recipient is a string
-type pubkey32() :: <<_:256>>.
-record(sp,
{recipient :: pubkey32(),
amount :: pos_integer(),
payload :: binary()}).
-type search_pattern() :: #sp{}.
-record(s,
{last_height_seen = none :: none | integer(),
searching_for = [] :: [search_pattern()]}).
-type state() :: #s{}.
-include("$zx_include/zx_logger.hrl").
%%-----------------------------------------------------------------------------
%% caller context
%%-----------------------------------------------------------------------------
-spec reg(Recipient, Amount, Payload) -> ok | {error, Reason}
when Recipient :: pubkey32(),
Amount :: pos_integer(),
Payload :: binary(),
Reason :: any().
reg(R, A, P) when is_binary(R), byte_size(R) =:= 32,
is_integer(A), A >= 0,
is_binary(P) ->
gen_server:call(?MODULE, {reg, R, A, P}).
%% gen_server callbacks
start_link() ->
gen_server:start_link({local, ?MODULE}, ?MODULE, none, []).
%%-----------------------------------------------------------------------------
%% process context below this line
%%-----------------------------------------------------------------------------
%% gen_server callbacks
-spec init(none) -> {ok, state()}.
init(none) ->
tell("starting fd_spy"),
hz:chain_nodes(fewd:chain_nodes()),
erlang:send_after(1000, self(), check_chain),
InitState = #s{},
{ok, InitState}.
-spec handle_call(Msg, From, State) -> Result
when Msg :: any(),
From :: {pid(), reference()},
State :: state(),
Result :: {reply, Reply, NewState}
| {noreply, NewState},
Reply :: any(),
NewState :: state().
handle_call({reg, Recipient, Amount, Payload}, _From, State) ->
{Reply, NewState} = do_reg(Recipient, Amount, Payload, State),
{reply, Reply, NewState};
handle_call(Unexpected, From, State) ->
tell("~tp: unexpected call from ~tp: ~tp", [?MODULE, Unexpected, From]),
{noreply, State}.
handle_cast(Unexpected, State) ->
tell("~tp: unexpected cast: ~tp", [?MODULE, Unexpected]),
{noreply, State}.
handle_info(check_chain, State) ->
NewState = do_check_chain(State),
erlang:send_after(1000, self(), check_chain),
{noreply, NewState};
handle_info(Unexpected, State) ->
tell("~tp: unexpected info: ~tp", [?MODULE, Unexpected]),
{noreply, State}.
code_change(_, State, _) ->
{ok, State}.
terminate(_, _) ->
ok.
%%-----------------------------------------------------------------------------
%% internals
%%-----------------------------------------------------------------------------
do_check_chain(State = #s{last_height_seen = none}) ->
case hz:kb_current_height() of
{ok, Max} ->
hh(Max-1, Max, State);
Error ->
tell("~tp hz error: ~tp", [?MODULE, Error]),
State
end;
do_check_chain(State = #s{last_height_seen = Min}) ->
case hz:kb_current_height() of
{ok, Max} ->
hh(Min, Max, State);
Error ->
tell("~tp hz error: ~tp", [?MODULE, Error]),
State
end.
% handle height
hh(PrevHeight, NewHeight, State) when PrevHeight < NewHeight ->
tell("~tp cool: PrevHeight=~tp, NewHeight=~tp", [?MODULE, PrevHeight, NewHeight]),
Spends = fd_hz:filter_spends(fd_hz:txs_from_to(PrevHeight + 1, NewHeight)),
tell("~tp spends: ~tp", [?MODULE, Spends]),
NewState = State#s{last_height_seen = NewHeight},
NewState;
hh(PrevHeight, NewHeight, State) when PrevHeight >= NewHeight ->
log(info, "~tp lame: PrevHeight=~tp, NewHeight=~tp", [?MODULE, PrevHeight, NewHeight]),
State.
-spec do_reg(Recipient, Amount, Payload, State) -> {Reply, NewState}
when Recipient :: pubkey32(),
Amount :: pos_integer(),
Payload :: binary(),
State :: state(),
Reply :: ok
| {error, Reason},
Reason :: any(),
NewState :: state().
do_reg(Recipient, Amount, Payload, State) ->
case already_registered(Recipient, Payload, State) of
true -> {error, already_registered};
false -> really_register(Recipient, Amount, Payload, State)
end.
-spec already_registered(Recipient, Payload, State) -> boolean()
when Recipient :: pubkey32(),
Payload :: binary(),
State :: state().
already_registered(Recipient, Payload, _State = #s{searching_for = SPs}) ->
ar(Recipient, Payload, SPs).
ar(Recipient, Payload, [#sp{recipient=Recipient, payload=Payload} | _]) ->
true;
ar(Recipient, Payload, [_ | Rest]) ->
ar(Recipient, Payload, Rest);
ar(_, _, []) ->
false.
-spec really_register(Recipient, Amount, Payload, State) -> {Reply, NewState}
when Recipient :: pubkey32(),
Amount :: pos_integer(),
Payload :: binary(),
State :: state(),
Reply :: ok
| {error, Reason},
Reason :: any(),
NewState :: state().
really_register(R, A, P, State = #s{searching_for = SPs}) ->
NewSearchPattern = #sp{recipient = R,
amount = A,
payload = P},
tell("~tp: really_register(~tp,~tp,~tp)", [?MODULE, R, A, P]),
NewSearchPatterns = [NewSearchPattern | SPs],
NewState = State#s{searching_for = NewSearchPatterns},
{reply, ok, NewState}.
+23 -11
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,17 +36,29 @@ start_link() ->
init([]) -> init([]) ->
RestartStrategy = {one_for_one, 1, 60}, RestartStrategy = {one_for_one, 1, 60},
Clients = {fd_clients, Spy = {fd_spy,
{fd_clients, start_link, []}, {fd_spy, start_link, []},
permanent,
5000,
supervisor,
[fd_clients]},
Cache = {fd_cache,
{fd_cache, start_link, []},
permanent, permanent,
5000, 5000,
worker, worker,
[fd_cache]}, [fd_spy]},
Children = [Clients, Cache], GridsD = {fd_gridsd,
{fd_gridsd, start_link, []},
permanent,
5000,
worker,
[fd_gridsd]},
WFCd = {fd_wfcd,
{fd_wfcd, start_link, []},
permanent,
5000,
supervisor,
[fd_wfcd]},
Httpd = {fd_httpd,
{fd_httpd, start_link, []},
permanent,
5000,
supervisor,
[fd_httpd]},
Children = [Spy, GridsD, WFCd, Httpd],
{ok, {RestartStrategy, Children}}. {ok, {RestartStrategy, Children}}.
+33
View File
@@ -0,0 +1,33 @@
-module(fd_wfcd).
-vsn("0.2.0").
-behaviour(supervisor).
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
-license("BSD-2-Clause-FreeBSD").
-export([start_link/0]).
-export([init/1]).
-spec start_link() -> {ok, pid()}.
%% @private
%% This supervisor's own start function.
start_link() ->
supervisor:start_link({local, ?MODULE}, ?MODULE, []).
-spec init([]) -> {ok, {supervisor:sup_flags(), [supervisor:child_spec()]}}.
%% @private
%% The OTP init/1 function.
init([]) ->
RestartStrategy = {one_for_one, 1, 60},
Cache = {fd_wfcd_cache,
{fd_wfcd_cache, start_link, []},
permanent,
5000,
worker,
[fd_wfcd_cache]},
Children = [Cache],
{ok, {RestartStrategy, Children}}.
+2 -1
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).
+26 -3
View File
@@ -3,18 +3,40 @@
%%% @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([chain_nodes/0, url/0, host/0, 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").
%% for testing: use mainnet
%chain_nodes() ->
% [{"tsuriai.jp", 3013}].
chain_nodes() ->
[{"tsuriai.jp", 4013}].
url() -> "http://" ++ host().
host() -> "localhost:8000".
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 +46,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 +54,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 +64,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
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.
+3 -24
View File
@@ -49,62 +49,52 @@ parse(Socket, Received) ->
%% socket. %% socket.
parse(Socket, Received, M = #request{method = undefined}) -> parse(Socket, Received, M = #request{method = undefined}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_method(Socket, Received) of case read_method(Socket, Received) of
{ok, Method, Rest} -> parse(Socket, Rest, M#request{method = Method}); {ok, Method, Rest} -> parse(Socket, Rest, M#request{method = Method});
Error -> Error Error -> Error
end; end;
parse(Socket, Received, M = #request{path = undefined}) -> parse(Socket, Received, M = #request{path = undefined}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_path(Socket, Received) of case read_path(Socket, Received) of
{ok, Path, Rest} -> parse(Socket, Rest, M#request{path = Path}); {ok, Path, Rest} -> parse(Socket, Rest, M#request{path = Path});
Error -> Error Error -> Error
end; end;
parse(Socket, Received, M = #request{qargs = undefined}) -> parse(Socket, Received, M = #request{qargs = undefined}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_qargs(Socket, Received) of case read_qargs(Socket, Received) of
{ok, Qargs, Rest} -> parse(Socket, Rest, M#request{qargs = Qargs}); {ok, Qargs, Rest} -> parse(Socket, Rest, M#request{qargs = Qargs});
Error -> Error Error -> Error
end; end;
parse(Socket, Received, M = #request{fragment = undefined}) -> parse(Socket, Received, M = #request{fragment = undefined}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_fragment(Socket, Received) of case read_fragment(Socket, Received) of
{ok, Fragment, Rest} -> parse(Socket, Rest, M#request{fragment = Fragment}); {ok, Fragment, Rest} -> parse(Socket, Rest, M#request{fragment = Fragment});
Error -> Error Error -> Error
end; end;
parse(Socket, Received, M = #request{version = undefined}) -> parse(Socket, Received, M = #request{version = undefined}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_version(Socket, Received) of case read_version(Socket, Received) of
{ok, Version, Rest} -> parse(Socket, Rest, M#request{version = Version}); {ok, Version, Rest} -> parse(Socket, Rest, M#request{version = Version});
Error -> Error Error -> Error
end; end;
parse(Socket, Received, M = #request{headers = undefined}) -> parse(Socket, Received, M = #request{headers = undefined}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_headers(Socket, Received) of case read_headers(Socket, Received) of
{ok, Headers, Rest} -> parse(Socket, Rest, M#request{headers = Headers}); {ok, Headers, Rest} -> parse(Socket, Rest, M#request{headers = Headers});
Error -> Error Error -> Error
end; end;
parse(Socket, Received, M = #request{enctype = undefined}) -> parse(Socket, Received, M = #request{enctype = undefined}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_enctype(M) of case read_enctype(M) of
{ok, Enctype} -> parse(Socket, Received, M#request{enctype = Enctype}); {ok, Enctype} -> parse(Socket, Received, M#request{enctype = Enctype});
Error -> Error Error -> Error
end; end;
parse(Socket, Received, M = #request{cookies = undefined}) -> parse(Socket, Received, M = #request{cookies = undefined}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_cookies(M) of case read_cookies(M) of
{ok, Cookies} -> parse(Socket, Received, M#request{cookies = Cookies}); {ok, Cookies} -> parse(Socket, Received, M#request{cookies = Cookies});
Error -> Error Error -> Error
end; end;
parse(Socket, Received, M = #request{size = undefined}) -> parse(Socket, Received, M = #request{size = undefined}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_size(M) of case read_size(M) of
{ok, 0} -> {ok, M#request{size = 0}, none}; {ok, 0} -> {ok, M#request{size = 0}, none};
{ok, Size} -> parse(Socket, Received, M#request{size = Size}); {ok, Size} -> parse(Socket, Received, M#request{size = Size});
Error -> Error Error -> Error
end; end;
parse(Socket, Received, M = #request{method = get, body = undefined, size = Size}) -> parse(Socket, Received, M = #request{method = get, body = undefined, size = Size}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_body(Received, Size) of case read_body(Received, Size) of
{ok, Body} -> {ok, M#request{body = Body}, none}; {ok, Body} -> {ok, M#request{body = Body}, none};
{ok, Body, Next} -> {ok, M#request{body = Body}, Next}; {ok, Body, Next} -> {ok, M#request{body = Body}, Next};
@@ -117,7 +107,6 @@ parse(Socket,
method = post, method = post,
enctype = urlencoded, enctype = urlencoded,
size = Size}) -> size = Size}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_body(Received, Size) of case read_body(Received, Size) of
{ok, Body} -> {ok, Body} ->
{ok, M#request{body = parts_to_map(posted(Body))}, none}; {ok, M#request{body = parts_to_map(posted(Body))}, none};
@@ -141,7 +130,6 @@ parse(Socket,
method = post, method = post,
enctype = {multipart, Boundary}, enctype = {multipart, Boundary},
size = Size}) -> size = Size}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_multipart(Socket, Received, Boundary, Size) of case read_multipart(Socket, Received, Boundary, Size) of
{ok, Parts} -> {ok, M#request{body = parts_to_map(Parts)}, none}; {ok, Parts} -> {ok, M#request{body = parts_to_map(Parts)}, none};
{ok, Parts, Next} -> {ok, M#request{body = parts_to_map(Parts)}, Next}; {ok, Parts, Next} -> {ok, M#request{body = parts_to_map(Parts)}, Next};
@@ -153,12 +141,10 @@ parse(Socket,
method = post, method = post,
enctype = json, enctype = json,
size = Size}) -> size = Size}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_body(Received, Size) of case read_body(Received, Size) of
{ok, Body} -> read_json(M#request{body = Body}, none); {ok, Body} -> read_json(M#request{body = Body}, none);
{ok, Body, Next} -> read_json(M#request{body = Body}, Next); {ok, Body, Next} -> read_json(M#request{body = Body}, Next);
{incomplete, Body} -> {incomplete, Body} ->
io:format("~p {incomplete, ~p}~n", [?LINE, Body]),
case accumulate(Socket, M#request{body = Body}) of case accumulate(Socket, M#request{body = Body}) of
{ok, NewM = #request{body = NewBody}} -> {ok, NewM = #request{body = NewBody}} ->
read_json(NewM#request{body = NewBody}, none); read_json(NewM#request{body = NewBody}, none);
@@ -528,7 +514,6 @@ read_size(#request{method = options}) ->
read_body(Received, Size) -> read_body(Received, Size) ->
io:format("~p read_body(~p, ~p)~n", [?LINE, Received, Size]),
case Received of case Received of
<<Bin:Size/binary>> -> <<Bin:Size/binary>> ->
{ok, Bin}; {ok, Bin};
@@ -826,11 +811,9 @@ accumulate(Socket, M = #request{size = Size, body = Body}) ->
end. end.
accumulate(Socket, Remaining, Received) when Remaining > 0 -> accumulate(Socket, Remaining, Received) when Remaining > 0 ->
io:format("~p accumulate(~p, ~p, ~p)~n", [?LINE, Socket, Remaining, Received]),
ok = inet:setopts(Socket, [{active, once}]), ok = inet:setopts(Socket, [{active, once}]),
receive receive
{tcp, Socket, Bin} -> {tcp, Socket, Bin} ->
io:format("~p~n", [?LINE]),
Size = byte_size(Bin), Size = byte_size(Bin),
if if
Size == Remaining -> Size == Remaining ->
@@ -845,15 +828,11 @@ accumulate(Socket, Remaining, Received) when Remaining > 0 ->
{ok, NewReceived, Next} {ok, NewReceived, Next}
end; end;
{tcp_closed, Socket} -> {tcp_closed, Socket} ->
io:format("~p~n", [?LINE]),
{error, tcp_closed}; {error, tcp_closed};
{tcp_error, Socket, Reason} -> {tcp_error, Socket, Reason} ->
io:format("~p~n", [?LINE]), {error, {tcp_error, Reason}}
{error, {tcp_error, Reason}}; %X ->
X -> after 3_000 ->
io:format("~p raseevd: ~p~n", [?LINE, X])
after 10_000 ->
io:format("~p~n", [?LINE]),
{error, timeout} {error, timeout}
end; end;
accumulate(_, 0, Received) -> accumulate(_, 0, Received) ->
+808
View File
@@ -0,0 +1,808 @@
% @doc websockets
%
% ref: https://datatracker.ietf.org/doc/html/rfc6455
-module(qhl_ws).
-vsn("0.2.0").
-export_type([
opcode/0,
frame/0,
ws_msg/0
]).
-export([
%% time units
ms/0, sec/0, min/0, hr/0, day/0,
%% porcelain
handshake/1,
recv/3, recv/4,
send/2
]).
-include("http.hrl").
-define(MAX_PAYLOAD_SIZE, ((1 bsl 63) - 1)).
%% Frames
%% https://datatracker.ietf.org/doc/html/rfc6455#section-5.2
-type opcode() :: continuation
| text
| binary
| close
| ping
| pong.
-record(frame,
{fin = none :: none | boolean(),
rsv = none :: none | <<_:3>>,
opcode = none :: none | opcode(),
mask = none :: none | boolean(),
payload_length = none :: none | non_neg_integer(),
masking_key = none :: none | <<>> | <<_:32>>,
payload = none :: none | binary()}).
-type frame() :: #frame{}.
%% porcelain messages
-type ws_msg() :: {text, Payload :: iodata()}
| {binary, Payload :: iodata()}
| {close, Payload :: iodata()}
| {ping, Payload :: iodata()}
| {pong, Payload :: iodata()}.
%% time units
ms() -> 1.
sec() -> 1_000.
min() -> 60*sec().
hr() -> 60*min().
day() -> 24*hr().
-spec handshake(Req) -> Result
when Req :: request(),
Result :: {ok, DraftResponse}
| {error, Reason},
DraftResponse :: response(),
Reason :: any().
% @doc
% This mostly just validates that all the 't's have been dotted and 'i's have
% been crossed.
%
% given an HTTP request:
%
% - if it is NOT a valid websocket handshake request, error
% - if it IS a valid websocket handshake request, form an initial candidate
% response record with the following fields:
%
% code = 101
% slogan = "Switching Protocols"
% headers = [{"Sec-WebSocket-Accept", ChallengeResponse},
% {"Connection", "Upgrade"},
% {"Upgrade", "websocket"}].
%
% YOU are responsible for dealing with any cookie logic, authentication logic,
% validating the Origin field, implementing cross-site-request-forgery, adding
% the retarded web date, rendering the response, sending it over the socket,
% etc.
%
% The returned ClientExtensions is the result of joining the
% <<"sec-websocket-extensions">> fields with ", "
%
% quoth section 9.1: https://datatracker.ietf.org/doc/html/rfc6455#section-9.1
%
% > Note that like other HTTP header fields, this header field MAY be
% > split or combined across multiple lines. Ergo, the following are
% > equivalent:
% >
% > Sec-WebSocket-Extensions: foo
% > Sec-WebSocket-Extensions: bar; baz=2
% >
% > is exactly equivalent to
% >
% > Sec-WebSocket-Extensions: foo, bar; baz=2
%
% Nobody actually uses extensions, so how you choose to parse this is on you.
handshake(R = #request{method = get, headers = Hs}) ->
%% downcase the headers because have to match on them
handshake2(R#request{headers = casefold_headers(Hs)});
handshake(_) ->
{error, bad_method}.
-spec casefold_headers(Headers) -> DowncaseHeaders
when Headers :: #{Key := Value},
Key :: binary(),
Value :: binary(),
DowncaseHeaders :: Headers.
% @private
% casefold all the keys in the header because they're case insensitive
casefold_headers(Headers) ->
Downcase =
fun({K, V}) ->
NewKey = unicode:characters_to_binary(string:casefold(K)),
{NewKey, V}
end,
maps:from_list(lists:map(Downcase, maps:to_list(Headers))).
-spec handshake2(DowncaseReq) -> Result
when DowncaseReq :: request(),
Result :: {ok, DraftResponse}
| {error, Reason},
DraftResponse :: response(),
Reason :: any().
% @private
% we may assume (WMA) method=get and headers have all been downcased
handshake2(#request{headers = DowncaseHeaders}) ->
% headers MUST contain fields:
% sec-websocket-key: _ % arbitrary
% sec-websocket-version: 13 % must be EXACTLY 13
% connection: Upgrade % must include the token "Upgrade"
% upgrade: websocket % must include the token "websocket"
MaybeResponseToken = validate_headers(DowncaseHeaders),
case MaybeResponseToken of
{ok, ResponseToken} ->
DraftResponse =
#response{code = 101,
slogan = "Switching Protocols",
headers = [{"Sec-WebSocket-Accept", ResponseToken},
{"Connection", "Upgrade"},
{"Upgrade", "websocket"}]},
{ok, DraftResponse};
Error ->
Error
end.
-spec validate_headers(HeadersMap) -> Result
when HeadersMap :: #{Key :: binary() := Val :: binary()},
Result :: {ok, ResponseToken}
| {error, Reason},
ResponseToken :: binary(),
Reason :: any().
% @private
% validate:
% Upgrade: websocket
% Connection: Upgrade
% Sec-WebSocket-Version: 13
validate_headers(#{<<"sec-websocket-key">> := ChallengeToken,
<<"sec-websocket-version">> := WS_Vsn,
<<"connection">> := Connection,
<<"upgrade">> := Upgrade}) ->
BadUpgrade = bad_upgrade(Upgrade),
BadConnection = bad_connection(Connection),
BadVersion = bad_version(WS_Vsn),
if
BadUpgrade -> {error, {bad_upgrade, Upgrade}};
BadConnection -> {error, {bad_connection, Connection}};
BadVersion -> {error, {bad_version, WS_Vsn}};
true -> {ok, response_token(ChallengeToken)}
end;
validate_headers(_) ->
{error, bad_request}.
-spec bad_upgrade(binary()) -> true | false.
% @private string must include "websocket" as a token
bad_upgrade(Str) ->
case string:find(Str, "websocket") of
nomatch -> true;
_ -> false
end.
-spec bad_connection(binary()) -> true | false.
% @private string must include "Upgrade" as a token
bad_connection(Str) ->
case string:find(Str, "Upgrade") of
nomatch -> true;
_ -> false
end.
-spec bad_version(binary()) -> true | false.
% @private version must be EXACTLY <<"13">>
bad_version(<<"13">>) -> false;
bad_version(_) -> true.
-spec response_token(binary()) -> binary().
% @doc
% Quoth the RFC:
%
% > Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
% >
% > For this header field, the server has to take the value (as present
% > in the header field, e.g., the base64-encoded [RFC4648] version minus
% > any leading and trailing whitespace) and concatenate this with the
% > Globally Unique Identifier (GUID, [RFC4122]) "258EAFA5-E914-47DA-
% > 95CA-C5AB0DC85B11" in string form, which is unlikely to be used by
% > network endpoints that do not understand the WebSocket Protocol. A
% > SHA-1 hash (160 bits) [FIPS.180-3], base64-encoded (see Section 4 of
% > [RFC4648]), of this concatenation is then returned in the server's
% > handshake.
% >
% > Concretely, if as in the example above, the |Sec-WebSocket-Key|
% > header field had the value "dGhlIHNhbXBsZSBub25jZQ==", the server
% > would concatenate the string "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
% > to form the string "dGhlIHNhbXBsZSBub25jZQ==258EAFA5-E914-47DA-95CA-
% > C5AB0DC85B11". The server would then take the SHA-1 hash of this,
% > giving the value 0xb3 0x7a 0x4f 0x2c 0xc0 0x62 0x4f 0x16 0x90 0xf6
% > 0x46 0x06 0xcf 0x38 0x59 0x45 0xb2 0xbe 0xc4 0xea. This value is
% > then base64-encoded (see Section 4 of [RFC4648]), to give the value
% > "s3pPLMBiTxaQ9kYGzzhZRbK+xOo=". This value would then be echoed in
% > the |Sec-WebSocket-Accept| header field.
response_token(ChallengeToken) when is_binary(ChallengeToken) ->
MagicString = <<"258EAFA5-E914-47DA-95CA-C5AB0DC85B11">>,
ConcatString = <<ChallengeToken/binary, MagicString/binary>>,
Sha1 = crypto:hash(sha, ConcatString),
base64:encode(Sha1).
-spec recv(Socket, Received, TimeoutMS) -> Result
when Socket :: gen_tcp:socket(),
Received :: binary(),
TimeoutMS :: non_neg_integer(),
Result :: {ok, Message, Frames, Remainder}
| {error, Reason},
Message :: ws_msg(),
Frames :: [frame()],
Remainder :: binary(),
Reason :: any().
% @doc
% Equivalent to recv(Socket, Received, [])
recv(Sock, Recv, TimeoutMS) ->
recv(Sock, Recv, TimeoutMS, []).
-spec recv(Socket, Received, TimeoutMS, Frames) -> Result
when Socket :: gen_tcp:socket(),
Received :: binary(),
TimeoutMS :: non_neg_integer(),
Frames :: [frame()],
Result :: {ok, Message, NewFrames, Remainder}
| {error, Reason},
Message :: ws_msg(),
NewFrames :: Frames,
Remainder :: binary(),
Reason :: any().
% @doc
% Pull a message off the socket
recv(Sock, Received, Timeout, Frames) ->
case maybe_pop_msg(Frames) of
{ok, Message, NewFrames} ->
{ok, Message, NewFrames, Received};
incomplete ->
case recv_frame(#frame{}, Sock, Received, Timeout) of
{ok, Frame, NewReceived} ->
NewFrames = [Frame | Frames],
recv(Sock, NewReceived, Timeout, NewFrames);
Error ->
Error
end;
Error ->
Error
end.
-spec maybe_pop_msg(Frames) -> Result
when Frames :: [frame()],
Result :: {ok, Message, NewFrames}
| incomplete
| {error, Reason},
Message :: ws_msg(),
NewFrames :: Frames,
Reason :: any().
% @private
% try to parse the stack of frames into a single message
%
% ignores RSV bits
% @end
maybe_pop_msg([]) ->
incomplete;
% case 1: control frames
% note that maybe_control_msg checks that the fin bit is true
%
% meaning if the client sends a malicious control frame with fin=false, that
% error will be caught in maybe_control_msg
maybe_pop_msg([Frame = #frame{opcode = ControlOpcode} | Frames])
when (ControlOpcode =:= close)
orelse (ControlOpcode =:= ping)
orelse (ControlOpcode =:= pong) ->
case maybe_control_msg(Frame) of
{ok, Msg} -> {ok, Msg, Frames};
Error -> Error
end;
% case 2: messages
% finished message in a single frame, just pull here
maybe_pop_msg([Frame = #frame{fin = true,
opcode = DataOpcode,
mask = Mask,
masking_key = Key,
payload = Payload}
| Rest])
when DataOpcode =:= text; DataOpcode =:= binary ->
case maybe_unmask(Frame, Mask, Key, Payload) of
{ok, Unmasked} ->
Message = {DataOpcode, Unmasked},
{ok, Message, Rest};
Error ->
Error
end;
% end of a long message
maybe_pop_msg(Frames = [#frame{fin = true,
opcode = continuation} | _]) ->
maybe_long_data_msg(Frames);
% unfinished message, say we need more
maybe_pop_msg([#frame{fin = false,
opcode = continuation}
| _]) ->
incomplete;
% wtf... this case should be impossible
maybe_pop_msg([Frame | _]) ->
{error, {wtf_frame, Frame}}.
-spec maybe_long_data_msg(Frames) -> Result
when Frames :: [frame()],
Result :: {ok, Message, NewFrames}
| {error, Reason},
Message :: ws_msg(),
NewFrames :: Frames,
Reason :: any().
% @private
% assumes:
% 1. top of stack is a finished frame
% 2. top opcode is continuation
% 3. the stack corresponds to a linear sequence of frames all corresponding to
% one message, until we get to the leading frame of the message, which must
% have opcode text|binary
%
% the reason we can make this assumption is because anterior in the call
% chain is recv/3, which eagerly consumes control messages
%
% meaning if we encounter a control frame in the middle here, we can assume
% there is some sort of bug
%
% TODO: I am NOT enforcing that the data message consumes the entire stack of
% frames. Given that the context here is eager consumption, this might be a
% point of enforcement. Need to think about this.
% @end
maybe_long_data_msg(Frames) ->
mldm(Frames, Frames, <<>>).
% general case: decode the payload in this frame
mldm(OrigFrames, [Frame | Rest], Acc) ->
Opcode = Frame#frame.opcode,
Mask = Frame#frame.mask,
Key = Frame#frame.masking_key,
Payload = Frame#frame.payload,
case maybe_unmask(Frame, Mask, Key, Payload) of
{ok, Unmasked} ->
NewAcc = <<Unmasked/binary, Acc/binary>>,
case Opcode of
continuation -> mldm(OrigFrames, Rest, NewAcc);
text -> {ok, {text, NewAcc}, Rest};
binary -> {ok, {binary, NewAcc}, Rest};
_ -> {error, {illegal_data_frame, Frame, OrigFrames, Acc}}
end;
Error ->
Error
end;
% out of frames
mldm(OrigFrames, [], Acc) ->
{error, {no_start_frame, Acc, OrigFrames}}.
-spec maybe_control_msg(Frame) -> Result
when Frame :: frame(),
Result :: {ok, Message}
| {error, Reason},
Message :: ws_msg(),
Reason :: any().
% @private
% assume the frame is a control frame, validate it, and unmask the payload
%
% TODO: this doesn't enforce that messages from the client HAVE to be masked,
% which strictly speaking is part of the protocol.
maybe_control_msg(F = #frame{fin = true,
opcode = Opcode,
mask = Mask,
payload_length = Len,
masking_key = Key,
payload = Payload})
when ((Opcode =:= close) orelse (Opcode =:= ping) orelse (Opcode =:= pong))
andalso (Len =< 125) ->
case maybe_unmask(F, Mask, Key, Payload) of
{ok, UnmaskedPayload} ->
Msg = {Opcode, UnmaskedPayload},
{ok, Msg};
Error ->
Error
end;
maybe_control_msg(F) ->
{error, {illegal_frame, F}}.
-spec maybe_unmask(Frame, Mask, Key, Payload) -> Result
when Frame :: frame(),
Mask :: boolean(),
Key :: <<>> | <<_:32>>,
Payload :: binary(),
Result :: {ok, Unmasked}
| {error, Reason},
Unmasked :: binary(),
Reason :: any().
% @private
% unmask the payload
% @end
% eliminate invalid pairs of {mask, masking_key}
maybe_unmask(_, true, <<Key:4/bytes>>, Payload) -> {ok, mask_unmask(Key, Payload)};
maybe_unmask(_, false, <<>>, Payload) -> {ok, Payload};
maybe_unmask(F, true, <<>>, _) -> {error, {illegal_frame, F}};
maybe_unmask(F, false, <<_:4/bytes>>, _) -> {error, {illegal_frame, F}}.
%% invertible
%% see: https://datatracker.ietf.org/doc/html/rfc6455#section-5.3
mask_unmask(Key = <<_:4/bytes>>, Payload) ->
mu(Key, Key, Payload, <<>>).
% essentially this is a modular zipWith xor of the masking key with the payload
mu(Key, <<KeyByte:8, KeyRest/binary>>, <<PayloadByte:8, PayloadRest/binary>>, Acc) ->
NewByte = KeyByte bxor PayloadByte,
NewAcc = <<Acc/binary, NewByte:8>>,
mu(Key, KeyRest, PayloadRest, NewAcc);
% this is the case where we need to refresh the active key
mu(Key, <<>>, Payload, Acc) ->
mu(Key, Key, Payload, Acc);
% done
mu(_, _, <<>>, Acc) ->
Acc.
-spec recv_frame(Parsed, Socket, Received, TimeoutMS) -> Result
when Parsed :: frame(),
Socket :: gen_tcp:socket(),
Received :: bitstring(),
TimeoutMS :: non_neg_integer(),
Result :: {ok, frame(), Remainder}
| {error, Reason},
Remainder :: bitstring(),
Reason :: any().
% @private
% parse a single frame off the socket
% @end
%% frame: 1 bit
recv_frame(Frame = #frame{fin = none}, Sock, <<FinBit:1, Rest/bits>>, Timeout) ->
NewFin =
case FinBit of
0 -> false;
1 -> true
end,
NewFrame = Frame#frame{fin = NewFin},
recv_frame(NewFrame, Sock, Rest, Timeout);
recv_frame(Frame = #frame{fin = none}, Sock, Received = <<>>, Timeout) ->
recv_frame_await(Frame, Sock, Received, Timeout);
%% rsv: 3 bits
recv_frame(Frame = #frame{rsv = none}, Sock, <<RSV:3/bits, Rest/bits>>, Timeout) ->
NewFrame = Frame#frame{rsv = RSV},
recv_frame(NewFrame, Sock, Rest, Timeout);
recv_frame(Frame = #frame{rsv = none}, Sock, Received, Timeout) ->
recv_frame_await(Frame, Sock, Received, Timeout);
%% opcode: 4 bits
recv_frame(Frame = #frame{opcode = none}, Sock, <<OpcodeInt:4, Rest/bits>>, Timeout) ->
Opcode =
case OpcodeInt of
0 -> continuation;
1 -> text;
2 -> binary;
8 -> close;
9 -> ping;
10 -> pong;
_ -> bad_opcode
end,
case Opcode of
bad_opcode ->
{error, {bad_opcode, OpcodeInt}};
_ ->
NewFrame = Frame#frame{opcode = Opcode},
recv_frame(NewFrame, Sock, Rest, Timeout)
end;
recv_frame(Frame = #frame{opcode = none}, Sock, Received, Timeout) ->
recv_frame_await(Frame, Sock, Received, Timeout);
%% mask: 1 bit
recv_frame(Frame = #frame{mask = none}, Sock, <<MaskBit:1, Rest/bits>>, Timeout) ->
NewMask =
case MaskBit of
0 -> false;
1 -> true
end,
NewFrame = Frame#frame{mask = NewMask},
recv_frame(NewFrame, Sock, Rest, Timeout);
recv_frame(Frame = #frame{mask = none}, Sock, Received = <<>>, Timeout) ->
recv_frame_await(Frame, Sock, Received, Timeout);
%% payload length: variable (yay)
% first case: short length 0..125
recv_frame(Frame = #frame{payload_length = none}, Sock, <<Len:7, Rest/bits>>, Timeout) when Len =< 125 ->
NewFrame = Frame#frame{payload_length = Len},
recv_frame(NewFrame, Sock, Rest, Timeout);
% second case: 126 -> 2 bytes to follow
recv_frame(Frame = #frame{payload_length = none}, Sock, <<126:7, Len:16, Rest/bits>>, Timeout) ->
NewFrame = Frame#frame{payload_length = Len},
recv_frame(NewFrame, Sock, Rest, Timeout);
% third case: 127 -> 8 bytes to follow
% bytes must start with a 0 bit
recv_frame(_Frame = #frame{payload_length = none}, _Sock, <<127:7, 1:1, _/bits>>, _Timeout) ->
{error, {illegal_frame, "payload length >= 1 bsl 63"}};
% 127, next is a legal length, continue
recv_frame(Frame = #frame{payload_length = none}, Sock, <<127:7, Len:64, Rest/bits>>, Timeout) ->
NewFrame = Frame#frame{payload_length = Len},
recv_frame(NewFrame, Sock, Rest, Timeout);
% otherwise wait
recv_frame(Frame = #frame{payload_length = none}, Sock, Received, Timeout) ->
recv_frame_await(Frame, Sock, Received, Timeout);
%% masking key: 0 or 4 bits
% not expecting a masking key, fill in that field here
recv_frame(Frame = #frame{mask = false, masking_key = none}, Sock, Received, Timeout) ->
NewFrame = Frame#frame{masking_key = <<>>},
recv_frame(NewFrame, Sock, Received, Timeout);
% expecting one
recv_frame(Frame = #frame{mask = true, masking_key = none}, Sock, <<Key:4/bytes, Rest/bits>>, Timeout) ->
NewFrame = Frame#frame{masking_key = Key},
recv_frame(NewFrame, Sock, Rest, Timeout);
% not found
recv_frame(Frame = #frame{mask = true, masking_key = none}, Sock, Received, Timeout) ->
recv_frame_await(Frame, Sock, Received, Timeout);
%% payload
recv_frame(Frame = #frame{payload_length = Len, payload = none}, Sock, Received, Timeout) when is_integer(Len) ->
case Received of
% we have enough bytes
<<Payload:Len/bytes, Rest/bits>> ->
FinalFrame = Frame#frame{payload = Payload},
{ok, FinalFrame, Rest};
% we do not have enough bytes
_ ->
recv_frame_await(Frame, Sock, Received, Timeout)
end.
%% factoring this out into a function to reduce repetition
recv_frame_await(Frame, Sock, Received, Timeout) ->
case inet:setopts(Sock, [{active, once}]) of
ok ->
receive
{tcp, Sock, Bin} -> recv_frame(Frame, Sock, <<Received/bits, Bin/binary>>, Timeout);
{tcp_closed, Sock} -> {error, tcp_closed};
{tcp_error, Sock, Reason} -> {error, {tcp_error, Reason}}
after Timeout ->
{error, timeout}
end;
{error, Reason} ->
{error, {inet, Reason}}
end.
-spec send(Socket, Message) -> Result
when Socket :: gen_tcp:socket(),
Message :: ws_msg(),
Result :: ok
| {error, Reason},
Reason :: any().
% @doc
% send message to client over Socket. handles frame nonsense
%
% max payload size is 2^63 - 1 bytes
% @end
send(Socket, {Type, Payload}) ->
BPayload = payload_to_binary(Payload),
Frame = message_to_frame(Type, BPayload),
send_frame(Socket, Frame).
payload_to_binary(Bin) when is_binary(Bin) -> Bin;
payload_to_binary(X) -> unicode:characters_to_binary(X).
% data messages
message_to_frame(Data, Payload)
when ((Data =:= text) orelse (Data =:= binary)),
is_binary(Payload),
(byte_size(Payload) =< ?MAX_PAYLOAD_SIZE) ->
#frame{fin = true,
opcode = Data,
payload_length = byte_size(Payload),
payload = Payload};
message_to_frame(Control, Payload)
when ((Control =:= close) orelse (Control =:= ping) orelse (Control =:= pong)),
is_binary(Payload),
(byte_size(Payload) =< 125) ->
#frame{fin = true,
opcode = Control,
payload_length = byte_size(Payload),
payload = Payload}.
-spec send_frame(Sock, Frame) -> Result
when Sock :: gen_tcp:socket(),
Frame :: frame(),
Result :: ok
| {error, Reason},
Reason :: tcp_error().
% @private
% send a frame on the socket
% @end
send_frame(Sock, Frame) ->
Binary = render_frame(Frame),
gen_tcp:send(Sock, Binary).
-spec render_frame(Frame) -> Binary
when Frame :: frame(),
Binary :: binary().
% @private
% render a frame
%
% All fields in a `#frame{}` record have default values of `none`.
%
% ```erlang
% -record(frame,
% {fin = none :: none | boolean(),
% rsv = none :: none | <<_:3>>,
% opcode = none :: none | opcode(),
% mask = none :: none | boolean(),
% payload_length = none :: none | non_neg_integer(),
% masking_key = none :: none | <<>> | <<_:32>>,
% payload = none :: none | binary()}).
% ```
%
% Given a value of `none`, some of these fields are inferred, some cannot be
% inferred.
%
% Inference cases:
%
% ```
% rsv = none -> <<0:3>>
% mask = none -> false
% masking_key = none -> <<>>
% payload_length = none -> byte_size(Payload)
% ```
%
% Non-inference:
%
% ```
% fin
% opcode
% payload
% ```
% @end
render_frame(#frame{fin = Fin,
rsv = RSV,
opcode = Opcode,
mask = Mask,
payload_length = Len,
masking_key = MaskingKey,
payload = Payload}) ->
BFin =
case Fin of
true -> <<1:1>>;
false -> <<0:1>>
end,
BRSV =
case RSV of
none -> <<0:3>>;
<<_:3>> -> RSV;
_ -> error({illegal_rsv, RSV})
end,
BOpcode =
case Opcode of
continuation -> << 0:4>>;
text -> << 1:4>>;
binary -> << 2:4>>;
close -> << 8:4>>;
ping -> << 9:4>>;
pong -> <<10:4>>
end,
BoolMask =
case Mask of
none -> false;
false -> false;
true -> true
end,
BMask =
case BoolMask of
true -> <<1:1>>;
false -> <<0:1>>
end,
IntPayloadLength =
case Len of
none -> byte_size(Payload);
_ -> Len
end,
BPayloadLength = render_payload_length(IntPayloadLength),
BMaskingKey =
case {BoolMask, MaskingKey} of
{false, none} -> <<>>;
{false, <<>>} -> <<>>;
{true, <<BKey:4/bytes>>} -> BKey;
{false, _} -> error({not_masking_but_have_masking_key, {Mask, MaskingKey}});
{true, _} -> error({illegal_masking_key, MaskingKey})
end,
% failure case here is same as error case just above, so no need to worry
% about cryptic "illegal frame" message
%
% masking = unmasking, so `maybe_unmask` is a bit of a misnomer
{ok, BPayload} = maybe_unmask(#frame{}, BoolMask, BMaskingKey, Payload),
<<BFin/bits,
BRSV/bits,
BOpcode/bits,
BMask/bits,
BPayloadLength/bits,
BMaskingKey/binary,
BPayload/binary>>.
-spec render_payload_length(non_neg_integer()) -> binary().
% @private
% > Payload length: 7 bits, 7+16 bits, or 7+64 bits
% >
% > The length of the "Payload data", in bytes: if 0-125, that is the
% > payload length. If 126, the following 2 bytes interpreted as a
% > 16-bit unsigned integer are the payload length. If 127, the
% > following 8 bytes interpreted as a 64-bit unsigned integer (the
% > most significant bit MUST be 0) are the payload length. Multibyte
% > length quantities are expressed in network byte order. Note that
% > in all cases, the minimal number of bytes MUST be used to encode
% > the length, for example, the length of a 124-byte-long string
% > can't be encoded as the sequence 126, 0, 124. The payload length
% > is the length of the "Extension data" + the length of the
% > "Application data". The length of the "Extension data" may be
% > zero, in which case the payload length is the length of the
% > "Application data".
render_payload_length(Len) when 0 =< Len, Len =< 125 ->
<<Len:7>>;
render_payload_length(Len) when 126 =< Len, Len =< 2#1111_1111_1111_1111 ->
<<126:7, Len:16>>;
render_payload_length(Len) when (1 bsl 16) =< Len, Len =< ?MAX_PAYLOAD_SIZE ->
<<127:7, Len:64>>.
+1
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
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
View File
@@ -1,4 +1,5 @@
-module(wfc_eval). -module(wfc_eval).
-vsn("0.2.0").
-export_type([ -export_type([
]). ]).
+1
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
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
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
View File
@@ -1,4 +1,5 @@
-module(wfc_read). -module(wfc_read).
-vsn("0.2.0").
-export_type([ -export_type([
]). ]).
+1
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
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
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
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
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
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}.
+14 -3
View File
@@ -1,11 +1,22 @@
{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,8,3}},
{deps,[]}. {"otpr","sophia",{9,0,0}},
{"otpr","gmserialization",{0,1,3}},
{"otpr","eblake2",{1,0,1}},
{"otpr","base58",{0,1,1}},
{"otpr","gmbytecode",{3,4,1}},
{"otpr","base58",{0,1,1}},
{"otpr","eblake2",{1,0,1}},
{"otpr","ec_utils",{1,0,0}},
{"otpr","zj",{1,1,2}},
{"otpr","getopt",{1,0,2}},
{"otpr","qr",{0,1,0}}]}.
{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"}.