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
TODONE
- 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
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,[]},
{included_applications,[]},
{applications,[stdlib,kernel]},
{vsn,"0.1.0"},
{modules,[fd_client,fd_client_man,fd_client_sup,fd_clients,
fd_sup,fewd]},
{vsn,"0.2.0"},
{modules,[fd_httpd,fd_httpd_client,fd_httpd_client_man,
fd_httpd_client_sup,fd_httpd_clients,fd_httpd_sfc,
fd_httpd_sfc_cache,fd_httpd_sfc_entry,fd_httpd_utils,
fd_sup,fd_wfcd,fd_wfcd_cache,fewd,qhl,qhl_ws,wfc,
wfc_bm,wfc_eval,wfc_eval_context,wfc_ltr,wfc_pp,
wfc_read,wfc_sentence,wfc_sftt,wfc_ttfuns,wfc_utils,
wfc_word,zj]},
{mod,{fewd,[]}}]}.
+8 -1
View File
@@ -4,7 +4,7 @@
qargs = undefined :: undefined | #{Key :: binary() := Value :: binary()},
fragment = undefined :: undefined | none | binary(),
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()},
enctype = undefined :: undefined | none | urlencoded | json | multipart(),
size = undefined :: undefined | none | non_neg_integer(),
@@ -23,3 +23,10 @@
-type body() :: {partial, binary()} | {multipart, [body_part()]} | zj:value() | binary().
-type body_part() :: {Field :: 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;
}
/* titlebar */
#titlebar {
background: var(--lgray2);
height: 40px;
width: 100%;
}
a.tb-home{
font-size: 30px;
text-decoration: none;
font-weight: bold;
}
.content {
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
%%% @end
-module(fd_client).
-vsn("0.1.0").
-module(fd_httpd_client).
-vsn("0.2.0").
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
-license("BSD-2-Clause-FreeBSD").
@@ -32,7 +32,7 @@
-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
@@ -52,11 +52,11 @@
| {shutdown, term()}
| term().
%% @private
%% How the fd_client_man or a prior fd_client kicks things off.
%% This is called in the context of fd_client_man or the prior fd_client.
%% How the fd_httpd_client_man or a prior fd_httpd_client kicks things off.
%% This is called in the context of fd_httpd_client_man or the prior fd_httpd_client.
start(ListenSocket) ->
fd_client_sup:start_acceptor(ListenSocket).
fd_httpd_client_sup:start_acceptor(ListenSocket).
-spec start_link(ListenSocket) -> Result
@@ -67,7 +67,7 @@ start(ListenSocket) ->
| {shutdown, term()}
| term().
%% @private
%% This is called by the fd_client_sup. While start/1 is called to iniate a startup
%% This is called by the fd_httpd_client_sup. While start/1 is called to iniate a startup
%% (essentially requesting a new worker be started by the supervisor), this is
%% actually called in the context of the supervisor.
@@ -86,7 +86,7 @@ start_link(ListenSocket) ->
%% call to listen/3.
init(Parent, ListenSocket) ->
ok = io:format("~p Listening.~n", [self()]),
ok = tell("~p Listening.~n", [self()]),
Debug = sys:debug_options([]),
ok = proc_lib:init_ack(Parent, {ok, self()}),
listen(Parent, Debug, ListenSocket).
@@ -98,7 +98,7 @@ init(Parent, ListenSocket) ->
ListenSocket :: gen_tcp:socket().
%% @private
%% This function waits for a TCP connection. The owner of the socket is still
%% the fd_client_man (so it can still close it on a call to fd_client_man:ignore/0),
%% the fd_httpd_client_man (so it can still close it on a call to fd_httpd_client_man:ignore/0),
%% but the only one calling gen_tcp:accept/1 on it is this process. Closing the socket
%% is one way a manager process can gracefully unblock child workers that are blocking
%% on a network accept.
@@ -110,12 +110,12 @@ listen(Parent, Debug, ListenSocket) ->
{ok, Socket} ->
{ok, _} = start(ListenSocket),
{ok, Peer} = inet:peername(Socket),
ok = io:format("~p Connection accepted from: ~p~n", [self(), Peer]),
ok = fd_client_man:enroll(),
ok = tell("~p Connection accepted from: ~p~n", [self(), Peer]),
ok = fd_httpd_client_man:enroll(),
State = #s{socket = Socket},
loop(Parent, Debug, State);
{error, closed} ->
ok = io:format("~p Retiring: Listen socket closed.~n", [self()]),
ok = tell("~p Retiring: Listen socket closed.~n", [self()]),
exit(normal)
end.
@@ -128,38 +128,31 @@ listen(Parent, Debug, ListenSocket) ->
%% 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.
loop(Parent, Debug, State = #s{socket = Socket, next = Next}) ->
loop(Parent, Debug, State = #s{socket = Socket, next = Next0}) ->
ok = inet:setopts(Socket, [{active, once}]),
receive
{tcp, Socket, Message} ->
tell("~p Next = ~p", [?LINE, Next]),
Received =
case Next of
none -> Message;
_ -> <<Next/binary, Message/binary>>
end,
tell("qhl_parse(Socket, ~tp)", [Received]),
Received = <<Next0/binary, Message/binary>>,
case qhl:parse(Socket, Received) of
{ok, Req, NewNext} ->
tell("qhl return: {ok, ~p, ~p}", [Req, NewNext]),
handle_request(Socket, Req),
NewState = State#s{next = NewNext},
{ok, Req, Next1} ->
Next2 = handle_request(Socket, Req, Next1),
NewState = State#s{next = Next2},
loop(Parent, Debug, NewState);
Error ->
%% should trigger bad request
io:format("~p QHL parse error: ~tp", [?LINE, Error]),
io:format("~p bad request:~n~ts", [?LINE, Received]),
http_err(Socket, 400),
tell(error, "~p QHL parse error: ~tp", [?LINE, Error]),
tell(error, "~p bad request:~n~ts", [?LINE, Received]),
fd_httpd_utils:http_err(Socket, 400),
gen_tcp:shutdown(Socket, read_write),
exit(normal)
end;
{tcp_closed, Socket} ->
ok = io:format("~p Socket closed, retiring.~n", [self()]),
ok = tell("~p Socket closed, retiring.~n", [self()]),
exit(normal);
{system, From, Request} ->
sys:handle_system_msg(Request, From, Parent, ?MODULE, Debug, State);
Unexpected ->
ok = io:format("~p Unexpected message: ~tp", [self(), Unexpected]),
ok = tell("~p Unexpected message: ~tp", [self(), Unexpected]),
loop(Parent, Debug, State)
end.
@@ -217,52 +210,151 @@ system_replace_state(StateFun, State) ->
%%% http request handling
handle_request(Sock, R = #request{method = M, path = P}) when M =/= undefined, P =/= undefined ->
tell("~p ~ts", [M, P]),
route(Sock, M, P, R).
-spec handle_request(Sock, Request, Received) -> NewReceived
when Sock :: gen_tcp:socket(),
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
<<"/">> -> home(Sock);
<<"/default.css">> -> default_css(Sock);
_ -> http_err(Sock, 404)
<<"/ws/echo">> -> ws_echo(Sock, Request) , Received;
<<"/">> -> route_static(Sock, <<"/index.html">>) , Received;
_ -> route_static(Sock, Route) , Received
end;
route(Sock, post, Route, Request) ->
route(Sock, post, Route, Request, Received) ->
case Route of
<<"/wfcin">> -> wfcin(Sock, Request);
_ -> http_err(Sock, 404)
<<"/grids-mkdd">> -> grids_mkdd(Sock, Request) , Received;
<<"/wfcin">> -> wfcin(Sock, Request) , Received;
_ -> fd_httpd_utils:http_err(Sock, 404) , Received
end;
route(Sock, _, _, _) ->
http_err(Sock, 404).
route(Sock, _, _, _, Received) ->
fd_httpd_utils:http_err(Sock, 404),
Received.
home(Sock) ->
%% fixme: cache
Path_IH = filename:join([zx:get_home(), "priv", "index.html"]),
case file:read_file(Path_IH) of
{ok, Body} ->
Resp = #response{headers = [{"content-type", "text/html"}],
body = Body},
respond(Sock, Resp);
Error ->
tell("error: ~p~n", [self(), Error]),
http_err(Sock, 500)
-spec route_static(Socket, Route) -> ok
when Socket :: gen_tcp:socket(),
Route :: binary().
route_static(Sock, Route) ->
respond_static(Sock, fd_httpd_sfc:query(Route)).
-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.
default_css(Sock) ->
%% fixme: cache
Path_IH = filename:join([zx:get_home(), "priv", "default.css"]),
case file:read_file(Path_IH) of
{ok, Body} ->
Resp = #response{headers = [{"content-type", "text/css"}],
body = Body},
respond(Sock, Resp);
ws_echo2(Sock, Request) ->
case qhl_ws:handshake(Request) of
{ok, Response} ->
fd_httpd_utils:respond(Sock, Response),
ws_echo_loop(Sock);
Error ->
io:format("~p error: ~p~n", [self(), Error]),
http_err(Sock, 500)
tell("ws_echo: error: ~tp", [Error]),
fd_httpd_utils:http_err(Sock, 400)
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,
cookies = Cookies,
body = #{"wfcin" := Input}}) ->
@@ -274,95 +366,40 @@ wfcin(Sock, #request{enctype = json,
case wfc_read:expr(Input) of
{ok, Expr, _Rest} ->
case wfc_eval:eval(Expr, Ctx0) of
{ok, noop, Ctx1} -> {jsgud("<noop>"), Ctx1};
{ok, Sentence, Ctx1} -> {jsgud(wfc_pp:sentence(Sentence)), Ctx1};
{error, Message} -> {jsbad(Message), Ctx0}
{ok, noop, Ctx1} -> {fd_httpd_utils:jsgud("<noop>"), Ctx1};
{ok, Sentence, Ctx1} -> {fd_httpd_utils:jsgud(wfc_pp:sentence(Sentence)), Ctx1};
{error, Message} -> {fd_httpd_utils:jsbad(Message), Ctx0}
end;
{error, Message} ->
{jsbad(Message), Ctx0}
{fd_httpd_utils:jsbad(Message), Ctx0}
end
catch
error:E:S ->
ErrorMessage = unicode:characters_to_list(io_lib:format("parser crashed: ~p:~p", [E, S])),
{jsbad(ErrorMessage), Ctx0}
{fd_httpd_utils:jsbad(ErrorMessage), Ctx0}
end,
% update cache with new context
ok = fd_cache:set(Cookie, NewCtx),
ok = fd_wfcd_cache:set(Cookie, NewCtx),
Body = zj:encode(RespObj),
Response = #response{headers = [{"content-type", "application/json"},
{"set-cookie", ["wfc=", Cookie]}],
body = Body},
respond(Sock, Response);
fd_httpd_utils:respond(Sock, Response);
wfcin(Sock, 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}) ->
case fd_cache:query(Cookie) of
case fd_wfcd_cache:query(Cookie) of
{ok, Context} -> {Cookie, Context};
error -> {Cookie, wfc_eval_context:default()}
end;
ctx(_) ->
{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])}.
{fd_httpd_utils:new_cookie(), wfc_eval_context:default()}.
@@ -9,8 +9,8 @@
%%% OTP should take care of for us.
%%% @end
-module(fd_client_man).
-vsn("0.1.0").
-module(fd_httpd_client_man).
-vsn("0.2.0").
-behavior(gen_server).
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
@@ -23,6 +23,8 @@
code_change/3, terminate/2]).
-include("$zx_include/zx_logger.hrl").
%%% Type and Record Definitions
@@ -92,7 +94,7 @@ echo(Message) ->
when Result :: {ok, pid()}
| {error, Reason :: term()}.
%% @private
%% This should only ever be called by fd_clients (the service-level supervisor).
%% This should only ever be called by fd_httpd_clients (the service-level supervisor).
start_link() ->
gen_server:start_link({local, ?MODULE}, ?MODULE, none, []).
@@ -104,8 +106,9 @@ start_link() ->
%% preparatory work necessary for proper function.
init(none) ->
ok = io:format("Starting.~n"),
ok = tell("Starting fd_httpd_client_man."),
State = #s{},
ok = tell("fd_httpd_client_man init state: ~tp", [State]),
{ok, State}.
@@ -130,7 +133,7 @@ handle_call({listen, PortNum}, _, State) ->
{Response, NewState} = do_listen(PortNum, State),
{reply, Response, NewState};
handle_call(Unexpected, From, State) ->
ok = io:format("~p Unexpected call from ~tp: ~tp~n", [self(), From, Unexpected]),
ok = tell("~p Unexpected call from ~tp: ~tp~n", [self(), From, Unexpected]),
{noreply, State}.
@@ -152,7 +155,7 @@ handle_cast(ignore, State) ->
NewState = do_ignore(State),
{noreply, NewState};
handle_cast(Unexpected, State) ->
ok = io:format("~p Unexpected cast: ~tp~n", [self(), Unexpected]),
ok = tell("~p Unexpected cast: ~tp~n", [self(), Unexpected]),
{noreply, State}.
@@ -168,7 +171,7 @@ handle_info({'DOWN', Mon, process, Pid, Reason}, State) ->
NewState = handle_down(Mon, Pid, Reason, State),
{noreply, NewState};
handle_info(Unexpected, State) ->
ok = io:format("~p Unexpected info: ~tp~n", [self(), Unexpected]),
ok = tell("~p Unexpected info: ~tp~n", [self(), Unexpected]),
{noreply, State}.
@@ -225,10 +228,10 @@ do_listen(PortNum, State = #s{port_num = none}) ->
{keepalive, true},
{reuseaddr, true}],
{ok, Listener} = gen_tcp:listen(PortNum, SocketOptions),
{ok, _} = fd_client:start(Listener),
{ok, _} = fd_httpd_client:start(Listener),
{ok, State#s{port_num = PortNum, listener = Listener}};
do_listen(_, State = #s{port_num = PortNum}) ->
ok = io:format("~p Already listening on ~p~n", [self(), PortNum]),
ok = tell("~p Already listening on ~p~n", [self(), PortNum]),
{{error, {listening, PortNum}}, State}.
@@ -254,7 +257,7 @@ do_enroll(Pid, State = #s{clients = Clients}) ->
case lists:member(Pid, Clients) of
false ->
Mon = monitor(process, Pid),
ok = io:format("Monitoring ~tp @ ~tp~n", [Pid, Mon]),
ok = tell("Monitoring ~tp @ ~tp~n", [Pid, Mon]),
State#s{clients = [Pid | Clients]};
true ->
State
@@ -292,6 +295,6 @@ handle_down(Mon, Pid, Reason, State = #s{clients = Clients}) ->
State#s{clients = NewClients};
false ->
Unexpected = {'DOWN', Mon, process, Pid, Reason},
ok = io:format("~p Unexpected info: ~tp~n", [self(), Unexpected]),
ok = tell("~p Unexpected info: ~tp~n", [self(), Unexpected]),
State
end.
@@ -2,8 +2,8 @@
%%% front end web development lab Client Supervisor
%%%
%%% This process supervises the client socket handlers themselves. It is a peer of the
%%% fd_client_man (the manager interface to this network service component),
%%% and a child of the supervisor named fd_clients.
%%% fd_httpd_client_man (the manager interface to this network service component),
%%% and a child of the supervisor named fd_httpd_clients.
%%%
%%% Because we don't know (or care) how many client connections the server may end up
%%% handling this is a simple_one_for_one supervisor which can spawn and manage as
@@ -13,8 +13,8 @@
%%% http://erlang.org/doc/design_principles/sup_princ.html#id79244
%%% @end
-module(fd_client_sup).
-vsn("0.1.0").
-module(fd_httpd_client_sup).
-vsn("0.2.0").
-behaviour(supervisor).
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
@@ -35,9 +35,9 @@
| {shutdown, term()}
| term().
%% @private
%% Spawns the first listener at the request of the fd_client_man when
%% Spawns the first listener at the request of the fd_httpd_client_man when
%% fewd:listen/1 is called, or the next listener at the request of the
%% currently listening fd_client when a connection is made.
%% currently listening fd_httpd_client when a connection is made.
%%
%% Error conditions, supervision strategies and other important issues are
%% explained in the supervisor module docs:
@@ -61,10 +61,10 @@ start_link() ->
init(none) ->
RestartStrategy = {simple_one_for_one, 1, 60},
Client = {fd_client,
{fd_client, start_link, []},
Client = {fd_httpd_client,
{fd_httpd_client, start_link, []},
temporary,
brutal_kill,
worker,
[fd_client]},
[fd_httpd_client]},
{ok, {RestartStrategy, [Client]}}.
+15 -15
View File
@@ -8,8 +8,8 @@
%%% See: http://erlang.org/doc/apps/kernel/application.html
%%% @end
-module(fd_clients).
-vsn("0.1.0").
-module(fd_httpd_clients).
-vsn("0.2.0").
-behavior(supervisor).
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
@@ -32,17 +32,17 @@ start_link() ->
init(none) ->
RestartStrategy = {rest_for_one, 1, 60},
ClientMan = {fd_client_man,
{fd_client_man, start_link, []},
permanent,
5000,
worker,
[fd_client_man]},
ClientSup = {fd_client_sup,
{fd_client_sup, start_link, []},
permanent,
5000,
supervisor,
[fd_client_sup]},
Children = [ClientSup, ClientMan],
HttpClientMan = {fd_httpd_client_man,
{fd_httpd_client_man, start_link, []},
permanent,
5000,
worker,
[fd_httpd_client_man]},
HttpClientSup = {fd_httpd_client_sup,
{fd_httpd_client_sup, start_link, []},
permanent,
5000,
supervisor,
[fd_httpd_client_sup]},
Children = [HttpClientSup, HttpClientMan],
{ok, {RestartStrategy, Children}}.
+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
-module(fd_sup).
-vsn("0.1.0").
-vsn("0.2.0").
-behaviour(supervisor).
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
@@ -36,17 +36,29 @@ start_link() ->
init([]) ->
RestartStrategy = {one_for_one, 1, 60},
Clients = {fd_clients,
{fd_clients, start_link, []},
permanent,
5000,
supervisor,
[fd_clients]},
Cache = {fd_cache,
{fd_cache, start_link, []},
Spy = {fd_spy,
{fd_spy, start_link, []},
permanent,
5000,
worker,
[fd_cache]},
Children = [Clients, Cache],
[fd_spy]},
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}}.
+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}
-module(fd_cache).
-module(fd_wfcd_cache).
-vsn("0.2.0").
-behavior(gen_server).
+26 -3
View File
@@ -3,18 +3,40 @@
%%% @end
-module(fewd).
-vsn("0.1.0").
-vsn("0.2.0").
-behavior(application).
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
-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([start/2, stop/1]).
-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
when PortNum :: inet:port_num(),
Result :: ok
@@ -24,7 +46,7 @@
%% Returns an {error, Reason} tuple if it is already listening.
listen(PortNum) ->
fd_client_man:listen(PortNum).
fd_httpd_client_man:listen(PortNum).
-spec ignore() -> ok.
@@ -32,7 +54,7 @@ listen(PortNum) ->
%% Make the server stop listening if it is, or continue to do nothing if it isn't.
ignore() ->
fd_client_man:ignore().
fd_httpd_client_man:ignore().
-spec start(normal, term()) -> {ok, pid()}.
@@ -42,6 +64,7 @@ ignore() ->
%% See: http://erlang.org/doc/apps/kernel/application.html
start(normal, _Args) ->
ok = application:ensure_started(hakuzaru),
Result = fd_sup:start_link(),
ok = listen(8000),
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.
+4 -25
View File
@@ -49,62 +49,52 @@ parse(Socket, Received) ->
%% socket.
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
{ok, Method, Rest} -> parse(Socket, Rest, M#request{method = Method});
Error -> Error
end;
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
{ok, Path, Rest} -> parse(Socket, Rest, M#request{path = Path});
Error -> Error
end;
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
{ok, Qargs, Rest} -> parse(Socket, Rest, M#request{qargs = Qargs});
Error -> Error
end;
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
{ok, Fragment, Rest} -> parse(Socket, Rest, M#request{fragment = Fragment});
Error -> Error
end;
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
{ok, Version, Rest} -> parse(Socket, Rest, M#request{version = Version});
Error -> Error
end;
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
{ok, Headers, Rest} -> parse(Socket, Rest, M#request{headers = Headers});
Error -> Error
end;
parse(Socket, Received, M = #request{enctype = undefined}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_enctype(M) of
{ok, Enctype} -> parse(Socket, Received, M#request{enctype = Enctype});
Error -> Error
end;
parse(Socket, Received, M = #request{cookies = undefined}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_cookies(M) of
{ok, Cookies} -> parse(Socket, Received, M#request{cookies = Cookies});
Error -> Error
end;
parse(Socket, Received, M = #request{size = undefined}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_size(M) of
{ok, 0} -> {ok, M#request{size = 0}, none};
{ok, Size} -> parse(Socket, Received, M#request{size = Size});
Error -> Error
end;
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
{ok, Body} -> {ok, M#request{body = Body}, none};
{ok, Body, Next} -> {ok, M#request{body = Body}, Next};
@@ -117,7 +107,6 @@ parse(Socket,
method = post,
enctype = urlencoded,
size = Size}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_body(Received, Size) of
{ok, Body} ->
{ok, M#request{body = parts_to_map(posted(Body))}, none};
@@ -141,7 +130,6 @@ parse(Socket,
method = post,
enctype = {multipart, Boundary},
size = Size}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_multipart(Socket, Received, Boundary, Size) of
{ok, Parts} -> {ok, M#request{body = parts_to_map(Parts)}, none};
{ok, Parts, Next} -> {ok, M#request{body = parts_to_map(Parts)}, Next};
@@ -153,12 +141,10 @@ parse(Socket,
method = post,
enctype = json,
size = Size}) ->
io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]),
case read_body(Received, Size) of
{ok, Body} -> read_json(M#request{body = Body}, none);
{ok, Body, Next} -> read_json(M#request{body = Body}, Next);
{incomplete, Body} ->
io:format("~p {incomplete, ~p}~n", [?LINE, Body]),
case accumulate(Socket, M#request{body = Body}) of
{ok, NewM = #request{body = NewBody}} ->
read_json(NewM#request{body = NewBody}, none);
@@ -528,7 +514,6 @@ read_size(#request{method = options}) ->
read_body(Received, Size) ->
io:format("~p read_body(~p, ~p)~n", [?LINE, Received, Size]),
case Received of
<<Bin:Size/binary>> ->
{ok, Bin};
@@ -826,11 +811,9 @@ accumulate(Socket, M = #request{size = Size, body = Body}) ->
end.
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}]),
receive
{tcp, Socket, Bin} ->
io:format("~p~n", [?LINE]),
Size = byte_size(Bin),
if
Size == Remaining ->
@@ -845,16 +828,12 @@ accumulate(Socket, Remaining, Received) when Remaining > 0 ->
{ok, NewReceived, Next}
end;
{tcp_closed, Socket} ->
io:format("~p~n", [?LINE]),
{error, tcp_closed};
{tcp_error, Socket, Reason} ->
io:format("~p~n", [?LINE]),
{error, {tcp_error, Reason}};
X ->
io:format("~p raseevd: ~p~n", [?LINE, X])
after 10_000 ->
io:format("~p~n", [?LINE]),
{error, timeout}
{error, {tcp_error, Reason}}
%X ->
after 3_000 ->
{error, timeout}
end;
accumulate(_, 0, Received) ->
{ok, 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
% porcelain wfc ops
-module(wfc).
-vsn("0.2.0").
-export_type([
sentence/0
+1
View File
@@ -1,6 +1,7 @@
% @doc
% bit matrices
-module(wfc_bm).
-vsn("0.2.0").
-export_type([
bit/0,
+1
View File
@@ -1,4 +1,5 @@
-module(wfc_eval).
-vsn("0.2.0").
-export_type([
]).
+1
View File
@@ -1,4 +1,5 @@
-module(wfc_eval_context).
-vsn("0.2.0").
-export_type([
context/0
+1
View File
@@ -7,6 +7,7 @@
%
% mathematically, this is a variable like "a", "b", "c", etc
-module(wfc_ltr).
-vsn("0.2.0").
-export_type([
ltr/0
+1
View File
@@ -1,4 +1,5 @@
-module(wfc_pp).
-vsn("0.2.0").
-export([
eval_result/1,
+1
View File
@@ -1,4 +1,5 @@
-module(wfc_read).
-vsn("0.2.0").
-export_type([
]).
+1
View File
@@ -6,6 +6,7 @@
%
% empty sentence is 0
-module(wfc_sentence).
-vsn("0.2.0").
-export_type([
sentence/0
+1
View File
@@ -1,6 +1,7 @@
% @doc
% sentence-fun <-> truth table logic
-module(wfc_sftt).
-vsn("0.2.0").
-export_type([
sf/0, tt/0
+1
View File
@@ -1,6 +1,7 @@
% @doc
% library of truth tables
-module(wfc_ttfuns).
-vsn("0.2.0").
-export_type([
bit/0,
+1
View File
@@ -1,5 +1,6 @@
% @doc misc utility functions
-module(wfc_utils).
-vsn("0.2.0").
-export([err/2, str/2, emsg/2]).
+1
View File
@@ -13,6 +13,7 @@
%
% operations assume all inputs are valid
-module(wfc_word).
-vsn("0.2.0").
-export_type([
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"}.
{type,app}.
{modules,[]}.
{author,"Peter Harpending"}.
{prefix,"fd"}.
{desc,"Front End Web Dev in Erlang stuff"}.
{author,"Peter Harpending"}.
{package_id,{"otpr","fewd",{0,1,0}}}.
{deps,[]}.
{package_id,{"otpr","fewd",{0,2,0}}}.
{deps,[{"otpr","hakuzaru",{0,8,3}},
{"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}.
{a_email,"peterharpending@qpq.swiss"}.
{c_email,"peterharpending@qpq.swiss"}.