Compare commits
15 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
 pharpend
|
079009a13e | ||
|
pharpend
|
484eea92e4 | ||
|
pharpend
|
08c0119ae0 | ||
|
pharpend
|
db6d244cb6 | ||
 Peter Harpending
|
4a0e221790 | ||
|
Peter Harpending
|
d348fe7cd1 | ||
|
pharpend
|
ad5df4f550 | ||
|
Peter Harpending
|
b63130a061 | ||
|
pharpend
|
b871968f8c | ||
|
pharpend
|
6028bb5850 | ||
|
pharpend
|
25a775ee96 | ||
|
Peter Harpending
|
b6436c84ee | ||
|
pharpend
|
cc95fc5829 | ||
|
pharpend
|
ce7b8a1ccd | ||
|
pharpend
|
8d5320e4e5 |
+5
-4
@@ -4,10 +4,11 @@
|
||||
{included_applications,[]},
|
||||
{applications,[stdlib,kernel]},
|
||||
{vsn,"0.2.0"},
|
||||
{modules,[fd_cache,fd_httpd,fd_httpd_client,fd_httpd_client_man,
|
||||
{modules,[fd_httpd,fd_httpd_client,fd_httpd_client_man,
|
||||
fd_httpd_client_sup,fd_httpd_clients,fd_httpd_sfc,
|
||||
fd_httpd_sfc_cache,fd_httpd_sfc_entry,fd_httpd_utils,
|
||||
fd_sup,fd_wsp,fewd,qhl,qhl_ws,wfc,wfc_bm,wfc_eval,
|
||||
wfc_eval_context,wfc_ltr,wfc_pp,wfc_read,wfc_sentence,
|
||||
wfc_sftt,wfc_ttfuns,wfc_utils,wfc_word,zj]},
|
||||
fd_sup,fd_wfcd,fd_wfcd_cache,fewd,qhl,qhl_ws,wfc,
|
||||
wfc_bm,wfc_eval,wfc_eval_context,wfc_ltr,wfc_pp,
|
||||
wfc_read,wfc_sentence,wfc_sftt,wfc_ttfuns,wfc_utils,
|
||||
wfc_word,zj]},
|
||||
{mod,{fewd,[]}}]}.
|
||||
|
||||
@@ -17,6 +17,7 @@
|
||||
|
||||
<ul>
|
||||
<li><a href="/echo.html">Echo</a></li>
|
||||
<li><a href="/webrtc.html">WebRTC</a></li>
|
||||
<li><a href="/wfc.html">WFC</a></li>
|
||||
</ul>
|
||||
</div>
|
||||
|
||||
Vendored
+1
-1
@@ -1 +1 @@
|
||||
{"version":3,"file":"libfewd.js","sourceRoot":"","sources":["../ts/libfewd.ts"],"names":[],"mappings":"AAAA;;;;GAIG;AAEH,OAAO,EACH,WAAW,EACX,qBAAqB,EACxB,CAAC;AAGF,SACA,WAAW,CACN,gBAAmC,EACnC,cAAsC,EACtC,UAAyB;IAG1B,+DAA+D;IAC/D,IAAI,gBAAgB,CAAC,OAAO,EAAE,CAAC;QAC3B,IAAI,aAAa,GAAW,cAAc,CAAC,YAAY,CAAC;QACxD,sCAAsC;QACtC,IAAI,aAAa,GAAG,UAAU;YAC1B,cAAc,CAAC,KAAK,CAAC,MAAM,GAAG,MAAM,CAAC,aAAa,CAAC,GAAG,IAAI,CAAC;;YAE3D,cAAc,CAAC,KAAK,CAAC,MAAM,GAAG,MAAM,CAAC,UAAU,CAAC,GAAG,IAAI,CAAC;IAChE,CAAC;AACL,CAAC;AAGD,SACA,qBAAqB,CAChB,gBAAmC,EACnC,cAAsC;IAGvC,IAAI,gBAAgB,CAAC,OAAO,EAAE,CAAC;QAC3B,mBAAmB;QACnB,cAAc,CAAC,SAAS,GAAG,cAAc,CAAC,YAAY,CAAC;IAC3D,CAAC;AACL,CAAC"}
|
||||
{"version":3,"file":"libfewd.js","sourceRoot":"","sources":["../ts/libfewd.ts"],"names":[],"mappings":"AAAA;;;;GAIG;AAEH,OAAO,EACH,WAAW,EACX,qBAAqB,EACxB,CAAC;AAGF,SACA,WAAW,CACN,gBAAmC,EACnC,cAAsC,EACtC,UAAyB;IAG1B,+DAA+D;IAC/D,IAAI,gBAAgB,CAAC,OAAO,EAAE;QAC1B,IAAI,aAAa,GAAW,cAAc,CAAC,YAAY,CAAC;QACxD,sCAAsC;QACtC,IAAI,aAAa,GAAG,UAAU;YAC1B,cAAc,CAAC,KAAK,CAAC,MAAM,GAAG,MAAM,CAAC,aAAa,CAAC,GAAG,IAAI,CAAC;;YAE3D,cAAc,CAAC,KAAK,CAAC,MAAM,GAAG,MAAM,CAAC,UAAU,CAAC,GAAG,IAAI,CAAC;KAC/D;AACL,CAAC;AAGD,SACA,qBAAqB,CAChB,gBAAmC,EACnC,cAAsC;IAGvC,IAAI,gBAAgB,CAAC,OAAO,EAAE;QAC1B,mBAAmB;QACnB,cAAc,CAAC,SAAS,GAAG,cAAc,CAAC,YAAY,CAAC;KAC1D;AACL,CAAC"}
|
||||
Vendored
+22
@@ -0,0 +1,22 @@
|
||||
/**
|
||||
* webrtc page script
|
||||
*
|
||||
* Author: Peter Harpending <peterharpending@qpq.swiss>
|
||||
* Date: 2026-02-04
|
||||
* Copyright: Copyright (c) 2026 QPQ AG
|
||||
*
|
||||
* Reference: https://git.qpq.swiss/QPQ-AG/research-megadoc/src/commit/c7c4592d4b21ad120145ef63334471a1a7ec1e60/paste/2026-02/grok-webrtc.html
|
||||
*
|
||||
* @module
|
||||
*/
|
||||
declare function main(): Promise<void>;
|
||||
/**
|
||||
* Try to get the user's camera
|
||||
*
|
||||
* tries to get screenshare if user camera not available for whatever reason
|
||||
*
|
||||
* chimps out if
|
||||
* - not on https
|
||||
* - user says no
|
||||
*/
|
||||
declare function getUserCamera(): Promise<MediaStream>;
|
||||
Vendored
+41
@@ -0,0 +1,41 @@
|
||||
"use strict";
|
||||
/**
|
||||
* webrtc page script
|
||||
*
|
||||
* Author: Peter Harpending <peterharpending@qpq.swiss>
|
||||
* Date: 2026-02-04
|
||||
* Copyright: Copyright (c) 2026 QPQ AG
|
||||
*
|
||||
* Reference: https://git.qpq.swiss/QPQ-AG/research-megadoc/src/commit/c7c4592d4b21ad120145ef63334471a1a7ec1e60/paste/2026-02/grok-webrtc.html
|
||||
*
|
||||
* @module
|
||||
*/
|
||||
main();
|
||||
async function main() {
|
||||
console.log('peepy');
|
||||
let video = await getUserCamera();
|
||||
console.log('poopy');
|
||||
console.log('poopu');
|
||||
let moi = document.getElementById('me');
|
||||
moi.srcObject = video;
|
||||
console.log('poopa');
|
||||
}
|
||||
/**
|
||||
* Try to get the user's camera
|
||||
*
|
||||
* tries to get screenshare if user camera not available for whatever reason
|
||||
*
|
||||
* chimps out if
|
||||
* - not on https
|
||||
* - user says no
|
||||
*/
|
||||
async function getUserCamera() {
|
||||
if (!(navigator.mediaDevices)) {
|
||||
console.error('navigator.mediaDevices is null; user not on https or something');
|
||||
}
|
||||
let availableDevices = await navigator.mediaDevices.enumerateDevices();
|
||||
console.log(availableDevices);
|
||||
return await navigator.mediaDevices.getUserMedia({ video: true, audio: false });
|
||||
// return await navigator.mediaDevices.getDisplayMedia();
|
||||
}
|
||||
//# sourceMappingURL=webrtc.js.map
|
||||
Vendored
+1
@@ -0,0 +1 @@
|
||||
{"version":3,"file":"webrtc.js","sourceRoot":"","sources":["../ts/webrtc.ts"],"names":[],"mappings":";AAAA;;;;;;;;;;GAUG;AAEH,IAAI,EAAE,CAAC;AAEP,KAAK,UACL,IAAI;IAIA,OAAO,CAAC,GAAG,CAAC,OAAO,CAAC,CAAC;IACrB,IAAI,KAAK,GAAsB,MAAM,aAAa,EAAE,CAAC;IACrD,OAAO,CAAC,GAAG,CAAC,OAAO,CAAC,CAAC;IACrB,OAAO,CAAC,GAAG,CAAC,OAAO,CAAC,CAAC;IACrB,IAAI,GAAG,GAAG,QAAQ,CAAC,cAAc,CAAC,IAAI,CAAqB,CAAC;IAC5D,GAAG,CAAC,SAAS,GAAG,KAAK,CAAC;IACtB,OAAO,CAAC,GAAG,CAAC,OAAO,CAAC,CAAC;AACzB,CAAC;AAGD;;;;;;;;GAQG;AACH,KAAK,UACL,aAAa;IAIT,IAAI,CAAC,CAAC,SAAS,CAAC,YAAY,CAAC,EAAE;QAC3B,OAAO,CAAC,KAAK,CAAC,gEAAgE,CAAC,CAAC;KACnF;IAED,IAAI,gBAAgB,GAChB,MAAM,SAAS,CAAC,YAAY,CAAC,gBAAgB,EAAE,CAAC;IACpD,OAAO,CAAC,GAAG,CAAC,gBAAgB,CAAC,CAAC;IAE9B,OAAO,MAAM,SAAS,CAAC,YAAY,CAAC,YAAY,CAAC,EAAC,KAAK,EAAE,IAAI,EAAE,KAAK,EAAE,KAAK,EAAC,CAAC,CAAC;IAC9E,yDAAyD;AAC7D,CAAC"}
|
||||
Vendored
+1
-1
@@ -1 +1 @@
|
||||
{"version":3,"file":"wfc.js","sourceRoot":"","sources":["../ts/wfc.ts"],"names":[],"mappings":"AAAA;;;;GAIG;AAEH,OAAO,KAAK,OAAO,MAAM,cAAc,CAAA;AAEvC,oEAAoE;AACpE,qBAAqB;AACrB,oEAAoE;AAEpE,IAAI,EAAE,CAAC;AAEP,SACA,IAAI;IAIA,IAAI,IAAI,GAAoC,QAAQ,CAAC,cAAc,CAAC,WAAW,CAA8B,CAAK;IAClH,IAAI,IAAI,GAAoC,QAAQ,CAAC,cAAc,CAAC,YAAY,CAAgC,CAAE;IAClH,IAAI,SAAS,GAA+B,QAAQ,CAAC,cAAc,CAAC,oBAAoB,CAAqB,CAAK;IAClH,IAAI,SAAS,GAA+B,QAAQ,CAAC,cAAc,CAAC,aAAa,CAA4B,CAAK;IAClH,IAAI,eAAe,GAAyB,GAAG,CAAC;IAGhD,IAAI,CAAC,gBAAgB,CAAC,SAAS,EAC3B,UAAS,CAAgB;QACrB,YAAY,CAAC,CAAC,EAAE,IAAI,EAAE,IAAI,EAAE,SAAS,EAAE,SAAS,EAAE,eAAe,CAAC,CAAC;IACvE,CAAC,CACJ,CAAC;AACN,CAAC;AAGD,yBAAyB;AACzB,KAAK,UACL,YAAY,CACP,GAA0B,EAC1B,IAA6B,EAC7B,IAAgC,EAChC,SAA6B,EAC7B,SAA6B,EAC7B,UAAmB;IAGpB,IAAI,GAAG,CAAC,GAAG,KAAK,OAAO,EAAE,CAAC;QACtB,yBAAyB;QACzB,GAAG,CAAC,cAAc,EAAE,CAAC;QACrB,gBAAgB;QAChB,IAAI,QAAQ,GAAa,IAAI,CAAC,KAAK,CAAC;QACpC,IAAI,OAAO,GAAc,QAAQ,CAAC,IAAI,EAAE,CAAC;QACzC,IAAI,QAAQ,GAAa,OAAO,CAAC,MAAM,GAAG,CAAC,CAAC;QAC5C,2BAA2B;QAC3B,IAAI,QAAQ,EAAE,CAAC;YACX,cAAc;YACd,IAAI,CAAC,KAAK,GAAG,EAAE,CAAC;YAEhB,gBAAgB;YAChB,IAAI,CAAC,KAAK,IAAI,IAAI,GAAG,OAAO,GAAG,IAAI,CAAC;YACpC,IAAI,CAAC,MAAM,GAAG,KAAK,CAAC;YAEpB,2BAA2B;YAC3B,IAAI,MAAM,GAAY,MAAM,WAAW,CAAC,OAAO,CAAC,CAAC;YAEjD,IAAI,MAAM,CAAC,EAAE;gBACT,IAAI,CAAC,KAAK,IAAI,MAAM,CAAC,MAAM,CAAC;;gBAE5B,IAAI,CAAC,KAAK,IAAI,MAAM,CAAC,KAAK,CAAC;YAC/B,IAAI,CAAC,KAAK,IAAI,IAAI,CAAC;YAEnB,cAAc;YACd,OAAO,CAAC,WAAW,CAAC,SAAS,EAAE,IAAI,EAAE,UAAU,CAAC,CAAC;YACjD,OAAO,CAAC,qBAAqB,CAAC,SAAS,EAAE,IAAI,CAAC,CAAC;QACnD,CAAC;IACL,CAAC;AACL,CAAC;AAaD,SACA,MAAM,CACD,SAAmB,EACnB,QAAkB;IAGnB,IAAG,CAAC,SAAS;QACT,MAAM,IAAI,KAAK,CAAC,QAAQ,CAAC,CAAC;AAClC,CAAC;AAGD,KAAK,UACL,WAAW,CACN,SAAkB;IAGnB,IAAI,YAAY,GAAG,EAAC,KAAK,EAAE,SAAS,EAAC,CAAC;IACtC,IAAI,YAAY,GAAG,IAAI,CAAC,SAAS,CAAC,YAAY,CAAC,CAAC;IAEhD,IAAI,WAAW,GAAI,EAAC,MAAM,EAAG,MAAM;QACf,OAAO,EAAE,EAAC,cAAc,EAAE,kBAAkB,EAAC;QAC7C,IAAI,EAAK,YAAY,EAAC,CAAC;IAE3C,mEAAmE;IACnE,4CAA4C;IAC5C,IAAI,MAAM,GAAW,EAAC,EAAE,EAAM,KAAK;QACb,KAAK,EAAG,kCAAkC,EAAC,CAAC;IAElE,IAAI,CAAC;QACD,IAAI,QAAQ,GAAc,MAAM,KAAK,CAAC,QAAQ,EAAE,WAAW,CAAC,CAAC;QAC7D,IAAI,QAAQ,CAAC,EAAE;YACX,MAAM,GAAG,MAAM,QAAQ,CAAC,IAAI,EAAY,CAAC;aACxC,CAAC;YACF,OAAO,CAAC,GAAG,CAAC,oBAAoB,EAAE,QAAQ,CAAC,CAAC;YAC5C,MAAM,GAAG,EAAC,EAAE,EAAE,KAAK,EAAE,KAAK,EAAE,mBAAmB,EAAC,CAAC;QACrD,CAAC;IACL,CAAC;IACD,OAAO,CAAM,EAAE,CAAC;QACZ,OAAO,CAAC,GAAG,CAAC,gBAAgB,EAAE,CAAC,CAAC,CAAC;QACjC,MAAM,GAAG,EAAC,EAAE,EAAE,KAAK,EAAE,KAAK,EAAE,eAAe,EAAC,CAAC;IACjD,CAAC;IAED,OAAO,MAAM,CAAC;AAClB,CAAC"}
|
||||
{"version":3,"file":"wfc.js","sourceRoot":"","sources":["../ts/wfc.ts"],"names":[],"mappings":"AAAA;;;;GAIG;AAEH,OAAO,KAAK,OAAO,MAAM,cAAc,CAAA;AAEvC,oEAAoE;AACpE,qBAAqB;AACrB,oEAAoE;AAEpE,IAAI,EAAE,CAAC;AAEP,SACA,IAAI;IAIA,IAAI,IAAI,GAAoC,QAAQ,CAAC,cAAc,CAAC,WAAW,CAA8B,CAAK;IAClH,IAAI,IAAI,GAAoC,QAAQ,CAAC,cAAc,CAAC,YAAY,CAAgC,CAAE;IAClH,IAAI,SAAS,GAA+B,QAAQ,CAAC,cAAc,CAAC,oBAAoB,CAAqB,CAAK;IAClH,IAAI,SAAS,GAA+B,QAAQ,CAAC,cAAc,CAAC,aAAa,CAA4B,CAAK;IAClH,IAAI,eAAe,GAAyB,GAAG,CAAC;IAGhD,IAAI,CAAC,gBAAgB,CAAC,SAAS,EAC3B,UAAS,CAAgB;QACrB,YAAY,CAAC,CAAC,EAAE,IAAI,EAAE,IAAI,EAAE,SAAS,EAAE,SAAS,EAAE,eAAe,CAAC,CAAC;IACvE,CAAC,CACJ,CAAC;AACN,CAAC;AAGD,yBAAyB;AACzB,KAAK,UACL,YAAY,CACP,GAA0B,EAC1B,IAA6B,EAC7B,IAAgC,EAChC,SAA6B,EAC7B,SAA6B,EAC7B,UAAmB;IAGpB,IAAI,GAAG,CAAC,GAAG,KAAK,OAAO,EAAE;QACrB,yBAAyB;QACzB,GAAG,CAAC,cAAc,EAAE,CAAC;QACrB,gBAAgB;QAChB,IAAI,QAAQ,GAAa,IAAI,CAAC,KAAK,CAAC;QACpC,IAAI,OAAO,GAAc,QAAQ,CAAC,IAAI,EAAE,CAAC;QACzC,IAAI,QAAQ,GAAa,OAAO,CAAC,MAAM,GAAG,CAAC,CAAC;QAC5C,2BAA2B;QAC3B,IAAI,QAAQ,EAAE;YACV,cAAc;YACd,IAAI,CAAC,KAAK,GAAG,EAAE,CAAC;YAEhB,gBAAgB;YAChB,IAAI,CAAC,KAAK,IAAI,IAAI,GAAG,OAAO,GAAG,IAAI,CAAC;YACpC,IAAI,CAAC,MAAM,GAAG,KAAK,CAAC;YAEpB,2BAA2B;YAC3B,IAAI,MAAM,GAAY,MAAM,WAAW,CAAC,OAAO,CAAC,CAAC;YAEjD,IAAI,MAAM,CAAC,EAAE;gBACT,IAAI,CAAC,KAAK,IAAI,MAAM,CAAC,MAAM,CAAC;;gBAE5B,IAAI,CAAC,KAAK,IAAI,MAAM,CAAC,KAAK,CAAC;YAC/B,IAAI,CAAC,KAAK,IAAI,IAAI,CAAC;YAEnB,cAAc;YACd,OAAO,CAAC,WAAW,CAAC,SAAS,EAAE,IAAI,EAAE,UAAU,CAAC,CAAC;YACjD,OAAO,CAAC,qBAAqB,CAAC,SAAS,EAAE,IAAI,CAAC,CAAC;SAClD;KACJ;AACL,CAAC;AAaD,SACA,MAAM,CACD,SAAmB,EACnB,QAAkB;IAGnB,IAAG,CAAC,SAAS;QACT,MAAM,IAAI,KAAK,CAAC,QAAQ,CAAC,CAAC;AAClC,CAAC;AAGD,KAAK,UACL,WAAW,CACN,SAAkB;IAGnB,IAAI,YAAY,GAAG,EAAC,KAAK,EAAE,SAAS,EAAC,CAAC;IACtC,IAAI,YAAY,GAAG,IAAI,CAAC,SAAS,CAAC,YAAY,CAAC,CAAC;IAEhD,IAAI,WAAW,GAAI,EAAC,MAAM,EAAG,MAAM;QACf,OAAO,EAAE,EAAC,cAAc,EAAE,kBAAkB,EAAC;QAC7C,IAAI,EAAK,YAAY,EAAC,CAAC;IAE3C,mEAAmE;IACnE,4CAA4C;IAC5C,IAAI,MAAM,GAAW,EAAC,EAAE,EAAM,KAAK;QACb,KAAK,EAAG,kCAAkC,EAAC,CAAC;IAElE,IAAI;QACA,IAAI,QAAQ,GAAc,MAAM,KAAK,CAAC,QAAQ,EAAE,WAAW,CAAC,CAAC;QAC7D,IAAI,QAAQ,CAAC,EAAE;YACX,MAAM,GAAG,MAAM,QAAQ,CAAC,IAAI,EAAY,CAAC;aACxC;YACD,OAAO,CAAC,GAAG,CAAC,oBAAoB,EAAE,QAAQ,CAAC,CAAC;YAC5C,MAAM,GAAG,EAAC,EAAE,EAAE,KAAK,EAAE,KAAK,EAAE,mBAAmB,EAAC,CAAC;SACpD;KACJ;IACD,OAAO,CAAM,EAAE;QACX,OAAO,CAAC,GAAG,CAAC,gBAAgB,EAAE,CAAC,CAAC,CAAC;QACjC,MAAM,GAAG,EAAC,EAAE,EAAE,KAAK,EAAE,KAAK,EAAE,eAAe,EAAC,CAAC;KAChD;IAED,OAAO,MAAM,CAAC;AAClB,CAAC"}
|
||||
@@ -0,0 +1,54 @@
|
||||
/**
|
||||
* webrtc page script
|
||||
*
|
||||
* Author: Peter Harpending <peterharpending@qpq.swiss>
|
||||
* Date: 2026-02-04
|
||||
* Copyright: Copyright (c) 2026 QPQ AG
|
||||
*
|
||||
* Reference: https://git.qpq.swiss/QPQ-AG/research-megadoc/src/commit/c7c4592d4b21ad120145ef63334471a1a7ec1e60/paste/2026-02/grok-webrtc.html
|
||||
*
|
||||
* @module
|
||||
*/
|
||||
|
||||
main();
|
||||
|
||||
async function
|
||||
main
|
||||
()
|
||||
: Promise<void>
|
||||
{
|
||||
console.log('peepy');
|
||||
let video : MediaStream = await getUserCamera();
|
||||
console.log('poopy');
|
||||
console.log('poopu');
|
||||
let moi = document.getElementById('me') as HTMLVideoElement;
|
||||
moi.srcObject = video;
|
||||
console.log('poopa');
|
||||
}
|
||||
|
||||
|
||||
/**
|
||||
* Try to get the user's camera
|
||||
*
|
||||
* tries to get screenshare if user camera not available for whatever reason
|
||||
*
|
||||
* chimps out if
|
||||
* - not on https
|
||||
* - user says no
|
||||
*/
|
||||
async function
|
||||
getUserCamera
|
||||
()
|
||||
: Promise<MediaStream>
|
||||
{
|
||||
if (!(navigator.mediaDevices)) {
|
||||
console.error('navigator.mediaDevices is null; user not on https or something');
|
||||
}
|
||||
|
||||
let availableDevices: Array<MediaDeviceInfo> =
|
||||
await navigator.mediaDevices.enumerateDevices();
|
||||
console.log(availableDevices);
|
||||
|
||||
return await navigator.mediaDevices.getUserMedia({video: true, audio: false});
|
||||
// return await navigator.mediaDevices.getDisplayMedia();
|
||||
}
|
||||
@@ -0,0 +1,27 @@
|
||||
<!DOCTYPE html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta charset="utf-8">
|
||||
<title>FEWD: voice chat demo</title>
|
||||
<link rel="stylesheet" href="/css/default.css">
|
||||
</head>
|
||||
<body>
|
||||
<div id="titlebar">
|
||||
<div class="content">
|
||||
<a href="/" class="tb-home">Home</a>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
<div class="content">
|
||||
<h1 class="content-title">FEWD: webrtc demo</h1>
|
||||
|
||||
<div class="content-body">
|
||||
<textarea disabled id="wfc-output"></textarea>
|
||||
|
||||
<video id="me" autoplay muted></video>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
<script src="/js/dist/webrtc.js"></script>
|
||||
</body>
|
||||
</html>
|
||||
@@ -0,0 +1,166 @@
|
||||
<!DOCTYPE html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta charset="UTF-8" />
|
||||
<title>Super Simple WebRTC – Manual Signaling</title>
|
||||
<style>
|
||||
body { font-family: sans-serif; margin: 20px; }
|
||||
textarea { width: 100%; height: 90px; font-family: monospace; }
|
||||
button { margin: 6px 0; padding: 8px 16px; }
|
||||
video { max-width: 320px; border: 1px solid #444; margin: 8px; background: #000; }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
|
||||
<h2>WebRTC 1:1 test (copy-paste signaling)</h2>
|
||||
|
||||
<div>
|
||||
<button id="btnCreateOffer">1. Create Offer (Peer A)</button>
|
||||
<button id="btnSetRemoteOffer">2. Paste offer → Set remote description</button><br>
|
||||
<textarea id="offerSdp" placeholder="Offer SDP will appear here (Peer A) or paste offer here (Peer B)"></textarea>
|
||||
</div>
|
||||
|
||||
<div style="margin-top: 24px;">
|
||||
<button id="btnCreateAnswer">3. Create Answer (Peer B)</button>
|
||||
<button id="btnSetRemoteAnswer">4. Paste answer → Set remote description</button><br>
|
||||
<textarea id="answerSdp" placeholder="Answer SDP will appear here (Peer B) or paste answer here (Peer A)"></textarea>
|
||||
</div>
|
||||
|
||||
<div style="margin-top: 20px;">
|
||||
<button id="btnAddIce">Add ICE candidate manually (if needed)</button><br>
|
||||
<textarea id="iceInput" placeholder="Paste remote ICE candidate here"></textarea>
|
||||
<div id="iceLog"></div>
|
||||
</div>
|
||||
|
||||
<div style="margin-top: 20px;">
|
||||
<video id="localVideo" autoplay playsinline muted></video>
|
||||
<video id="remoteVideo" autoplay playsinline></video>
|
||||
</div>
|
||||
|
||||
<pre id="status">Status: ready</pre>
|
||||
|
||||
<script>
|
||||
// ────────────────────────────────────────────────
|
||||
const $ = s => document.querySelector(s);
|
||||
const status = $('pre#status');
|
||||
const offerArea = $('#offerSdp');
|
||||
const answerArea = $('#answerSdp');
|
||||
const iceInput = $('#iceInput');
|
||||
const iceLog = $('#iceLog');
|
||||
|
||||
let pc = null;
|
||||
let localStream = null;
|
||||
|
||||
// ────────────────────────────────────────────────
|
||||
async function initPeerConnection() {
|
||||
if (pc) pc.close();
|
||||
|
||||
pc = new RTCPeerConnection({
|
||||
iceServers: [
|
||||
{ urls: "stun:stun.l.google.com:19302" },
|
||||
{ urls: "stun:stun.stunprotocol.org" }
|
||||
]
|
||||
});
|
||||
|
||||
pc.onicecandidate = e => {
|
||||
if (e.candidate) {
|
||||
console.log("New ICE candidate:", e.candidate);
|
||||
iceLog.innerHTML += "<div style='color:#c33'>→ " + e.candidate.candidate + "</div>";
|
||||
}
|
||||
};
|
||||
|
||||
pc.oniceconnectionstatechange = () => {
|
||||
status.textContent = "ICE state: " + pc.iceConnectionState;
|
||||
};
|
||||
|
||||
pc.ontrack = e => {
|
||||
console.log("ontrack", e);
|
||||
const remoteVideo = $('#remoteVideo');
|
||||
remoteVideo.srcObject = e.streams[0];
|
||||
status.textContent = "ICE state: " + pc.iceConnectionState + " (receiving media!)";
|
||||
};
|
||||
|
||||
// Add local stream if we have camera/mic
|
||||
if (localStream) {
|
||||
localStream.getTracks().forEach(track => {
|
||||
pc.addTrack(track, localStream);
|
||||
});
|
||||
}
|
||||
}
|
||||
|
||||
// ────────────────────────────────────────────────
|
||||
async function startLocalCamera() {
|
||||
try {
|
||||
localStream = await navigator.mediaDevices.getUserMedia({
|
||||
video: true,
|
||||
audio: false // change to true if you want audio too
|
||||
});
|
||||
$('#localVideo').srcObject = localStream;
|
||||
} catch (err) {
|
||||
console.error("Camera access failed", err);
|
||||
status.textContent = "Camera access failed: " + err.message;
|
||||
}
|
||||
}
|
||||
|
||||
// ────────────────────────────────────────────────
|
||||
$('#btnCreateOffer').onclick = async () => {
|
||||
await initPeerConnection();
|
||||
await startLocalCamera();
|
||||
|
||||
const offer = await pc.createOffer();
|
||||
await pc.setLocalDescription(offer);
|
||||
|
||||
offerArea.value = JSON.stringify(pc.localDescription, null, 2);
|
||||
status.textContent = "Offer created – copy and send to peer B";
|
||||
};
|
||||
|
||||
// ────────────────────────────────────────────────
|
||||
$('#btnCreateAnswer').onclick = async () => {
|
||||
await initPeerConnection();
|
||||
await startLocalCamera();
|
||||
|
||||
const offer = JSON.parse(offerArea.value);
|
||||
await pc.setRemoteDescription(offer);
|
||||
|
||||
const answer = await pc.createAnswer();
|
||||
await pc.setLocalDescription(answer);
|
||||
|
||||
answerArea.value = JSON.stringify(pc.localDescription, null, 2);
|
||||
status.textContent = "Answer created – copy and send to peer A";
|
||||
};
|
||||
|
||||
// ────────────────────────────────────────────────
|
||||
$('#btnSetRemoteOffer').onclick = async () => {
|
||||
if (!pc) await initPeerConnection();
|
||||
|
||||
const remote = JSON.parse(offerArea.value);
|
||||
await pc.setRemoteDescription(remote);
|
||||
status.textContent = "Remote offer set";
|
||||
};
|
||||
|
||||
// ────────────────────────────────────────────────
|
||||
$('#btnSetRemoteAnswer').onclick = async () => {
|
||||
const remote = JSON.parse(answerArea.value);
|
||||
await pc.setRemoteDescription(remote);
|
||||
status.textContent = "Remote answer set – waiting for ICE/media";
|
||||
};
|
||||
|
||||
// ────────────────────────────────────────────────
|
||||
$('#btnAddIce').onclick = async () => {
|
||||
if (!iceInput.value.trim()) return;
|
||||
try {
|
||||
const candidate = new RTCIceCandidate(JSON.parse(iceInput.value));
|
||||
await pc.addIceCandidate(candidate);
|
||||
iceLog.innerHTML += "<div style='color:#3a3'>← added ICE candidate</div>";
|
||||
iceInput.value = "";
|
||||
} catch (err) {
|
||||
console.error("Bad ICE candidate", err);
|
||||
}
|
||||
};
|
||||
|
||||
// Optional: auto-start camera when page loads
|
||||
// startLocalCamera();
|
||||
|
||||
</script>
|
||||
</body>
|
||||
</html>
|
||||
@@ -0,0 +1,127 @@
|
||||
/**
|
||||
* webrtc page script
|
||||
*
|
||||
* Author: Peter Harpending <peterharpending@qpq.swiss>
|
||||
* Date: 2026-02-04
|
||||
* Copyright: Copyright (c) 2026 QPQ AG
|
||||
*
|
||||
* Reference: https://git.qpq.swiss/QPQ-AG/research-megadoc/src/commit/c7c4592d4b21ad120145ef63334471a1a7ec1e60/paste/2026-02/grok-webrtc.html
|
||||
*
|
||||
* @module
|
||||
*/
|
||||
|
||||
type state =
|
||||
{whoami: string,
|
||||
roster: Array<string>};
|
||||
|
||||
let st: state =
|
||||
{whoami: "",
|
||||
roster: []};
|
||||
|
||||
main();
|
||||
|
||||
async function
|
||||
main
|
||||
()
|
||||
: Promise<void>
|
||||
{
|
||||
// start websocket immediately
|
||||
let ws: WebSocket;
|
||||
let init = document.getElementById('init') as HTMLDivElement;
|
||||
let init_join = document.getElementById('init-join') as HTMLButtonElement;
|
||||
|
||||
// handle button click
|
||||
init_join.addEventListener('click',
|
||||
function() {
|
||||
init.hidden = true;
|
||||
document.getElementById('run')!.hidden = false;
|
||||
ws = new WebSocket('/ws/webrtc');
|
||||
ws.onopen = function(e) { console.log('ws open'); };
|
||||
ws.onclose = function(e) { console.warn('ws closed'); };
|
||||
ws.onerror = function(e) { console.error('ws error:', e); };
|
||||
ws.onmessage =
|
||||
function(e) {
|
||||
// console.log('ws message:', e.data);
|
||||
let message = JSON.parse(e.data) as ws_msg;
|
||||
handle_ws_msg(message);
|
||||
};
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
type ws_msg = ["whoami", string]
|
||||
| ["roster", Array<string>];
|
||||
|
||||
function
|
||||
handle_ws_msg
|
||||
(message: ws_msg)
|
||||
: void
|
||||
{
|
||||
console.log('message from server:', message);
|
||||
switch(message[0]) {
|
||||
case "whoami":
|
||||
st.whoami = message[1];
|
||||
break;
|
||||
case "roster":
|
||||
st.roster = (message[1] as Array<string>);
|
||||
break;
|
||||
default:
|
||||
console.warn("unknown message", message);
|
||||
}
|
||||
|
||||
render_state();
|
||||
}
|
||||
|
||||
|
||||
|
||||
function
|
||||
ws_send_json
|
||||
(ws : WebSocket,
|
||||
x : any)
|
||||
: void
|
||||
{
|
||||
let s: string = JSON.stringify(x, undefined, 4);
|
||||
console.log('sending:\n', s);
|
||||
|
||||
ws.send(s);
|
||||
}
|
||||
|
||||
|
||||
|
||||
function
|
||||
render_state
|
||||
()
|
||||
: void
|
||||
{
|
||||
console.log('st', st);
|
||||
// whoami
|
||||
document.getElementById('whoami')!.innerText = st.whoami;
|
||||
//
|
||||
let roster_ul = document.getElementById('roster-ul') as HTMLUListElement;
|
||||
let newChildren : Array<HTMLElement> = [];
|
||||
for (let nick of st.roster) {
|
||||
if (!(nick === st.whoami)) {
|
||||
let li = nickkk(nick);
|
||||
newChildren.push(li);
|
||||
}
|
||||
}
|
||||
roster_ul.replaceChildren(...newChildren);
|
||||
}
|
||||
|
||||
function
|
||||
nickkk
|
||||
(nick: string)
|
||||
: HTMLElement
|
||||
{
|
||||
let li = document.createElement('li');
|
||||
|
||||
li.innerText += nick;
|
||||
li.innerText += ' ';
|
||||
|
||||
let call_a = document.createElement('button');
|
||||
call_a.innerText = 'call';
|
||||
|
||||
li.appendChild(call_a);
|
||||
|
||||
return li;
|
||||
}
|
||||
+8
-1
@@ -23,6 +23,12 @@ start_link() ->
|
||||
|
||||
init([]) ->
|
||||
RestartStrategy = {one_for_one, 1, 60},
|
||||
WebRTC = {fd_httpd_webrtc,
|
||||
{fd_httpd_webrtc, start_link, []},
|
||||
permanent,
|
||||
5000,
|
||||
worker,
|
||||
[fd_httpd_webrtc]},
|
||||
FileCache = {fd_httpd_sfc,
|
||||
{fd_httpd_sfc, start_link, []},
|
||||
permanent,
|
||||
@@ -35,5 +41,6 @@ init([]) ->
|
||||
5000,
|
||||
supervisor,
|
||||
[fd_httpd_clients]},
|
||||
Children = [FileCache, Clients],
|
||||
Children = [WebRTC, FileCache, Clients],
|
||||
%Children = [FileCache, Clients],
|
||||
{ok, {RestartStrategy, Children}}.
|
||||
|
||||
+107
-38
@@ -135,9 +135,19 @@ loop(Parent, Debug, State = #s{socket = Socket, next = Next0}) ->
|
||||
Received = <<Next0/binary, Message/binary>>,
|
||||
case qhl:parse(Socket, Received) of
|
||||
{ok, Req, Next1} ->
|
||||
Next2 = handle_request(Socket, Req, Next1),
|
||||
%% FIXME: unfuck received logic here
|
||||
%% handle_request should eventually call back into
|
||||
%% loop/3 or close the socket
|
||||
%%
|
||||
%% also loop/3 should be loop/1, because we need to pass
|
||||
%% the state down the callchains
|
||||
Next2 =
|
||||
case Next1 of
|
||||
none -> <<>>;
|
||||
Bin -> Bin
|
||||
end,
|
||||
NewState = State#s{next = Next2},
|
||||
loop(Parent, Debug, NewState);
|
||||
handle_request(Req, Parent, Debug, NewState);
|
||||
Error ->
|
||||
%% should trigger bad request
|
||||
tell(error, "~p QHL parse error: ~tp", [?LINE, Error]),
|
||||
@@ -210,40 +220,44 @@ system_replace_state(StateFun, State) ->
|
||||
|
||||
%%% http request handling
|
||||
|
||||
-spec handle_request(Sock, Request, Received) -> NewReceived
|
||||
when Sock :: gen_tcp:socket(),
|
||||
Request :: request(),
|
||||
Received :: binary(),
|
||||
NewReceived :: binary().
|
||||
-spec handle_request(Request, Parent, Debug, State) -> no_return()
|
||||
when Request :: request(),
|
||||
Parent :: pid(),
|
||||
Debug :: [sys:dbg_opt()],
|
||||
State :: state().
|
||||
|
||||
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).
|
||||
handle_request(Req = #request{method = Method, path = Path}, Parent, Debug, State)
|
||||
when Method =/= undefined,
|
||||
Path =/= undefined ->
|
||||
tell("~tp ~tp ~ts", [self(), Method, Path]),
|
||||
route(Method, Path, Req, Parent, Debug, State).
|
||||
|
||||
|
||||
|
||||
-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) ->
|
||||
% hardcode routes first
|
||||
route(get, Route, Request, P, D, S = #s{socket = Sock}) ->
|
||||
case Route of
|
||||
<<"/ws/echo">> -> ws_echo(Sock, Request) , Received;
|
||||
<<"/">> -> route_static(Sock, <<"/index.html">>) , Received;
|
||||
_ -> route_static(Sock, Route) , Received
|
||||
<<"/ws/echo">> -> ws_echo(Sock, Request);
|
||||
<<"/ws/webrtc">> ->
|
||||
ws_webrtc(Request, S);
|
||||
<<"/">> ->
|
||||
route_static(Sock, <<"/index.html">>),
|
||||
loop(P, D, S);
|
||||
_ ->
|
||||
route_static(Sock, Route),
|
||||
loop(P, D, S)
|
||||
end;
|
||||
route(Sock, post, Route, Request, Received) ->
|
||||
route(post, Route, Request, P, D, S = #s{socket = Sock}) ->
|
||||
case Route of
|
||||
<<"/wfcin">> -> wfcin(Sock, Request) , Received;
|
||||
_ -> fd_httpd_utils:http_err(Sock, 404) , Received
|
||||
<<"/wfcin">> ->
|
||||
wfcin(Sock, Request),
|
||||
loop(P, D, S);
|
||||
_ ->
|
||||
fd_httpd_utils:http_err(Sock, 404),
|
||||
loop(P, D, S)
|
||||
end;
|
||||
route(Sock, _, _, _, Received) ->
|
||||
route(_, _, _, P, D, S = #s{socket = Sock}) ->
|
||||
fd_httpd_utils:http_err(Sock, 404),
|
||||
Received.
|
||||
loop(P, D, S).
|
||||
|
||||
|
||||
|
||||
@@ -279,6 +293,69 @@ respond_static(Sock, not_found) ->
|
||||
fd_httpd_utils:http_err(Sock, 404).
|
||||
|
||||
|
||||
%% ------------------------------
|
||||
%% webrtc
|
||||
%% ------------------------------
|
||||
|
||||
ws_webrtc(Request, State = #s{socket = Sock}) ->
|
||||
try
|
||||
case qhl_ws:handshake(Request) of
|
||||
{ok, Response} ->
|
||||
fd_httpd_utils:respond(Sock, Response),
|
||||
% wait for username
|
||||
ok = fd_httpd_webrtc:join(),
|
||||
ws_webrtc_loop(State);
|
||||
Error ->
|
||||
tell("ws_webrtc: error: ~tp", [Error]),
|
||||
fd_httpd_utils:http_err(Sock, 400),
|
||||
exit(bad_request)
|
||||
end
|
||||
catch
|
||||
exit:Y:Z ->
|
||||
tell("~tp ws_webrtc: dying peacefully: ~tp:~tp", [self(), Y, Z]),
|
||||
gen_tcp:close(Sock);
|
||||
error:Y:Z ->
|
||||
tell(error, "~tp ws_webrtc: ERROR ~tp:~tp", [self(), Y, Z]),
|
||||
fd_httpd_utils:http_err(Sock, 500),
|
||||
error(internal_server_error)
|
||||
end.
|
||||
|
||||
|
||||
-spec ws_webrtc_loop(state()) -> no_return().
|
||||
|
||||
% we have no tcp bytes waiting to be parsed
|
||||
ws_webrtc_loop(State = #s{socket = Socket, next = <<>>}) ->
|
||||
ok = inet:setopts(Socket, [{active, once}]),
|
||||
receive
|
||||
{tcp, Socket, Message} ->
|
||||
NewState = State#s{next = Message},
|
||||
ws_webrtc_loop(NewState);
|
||||
{webrtc, Message} ->
|
||||
ok = ws_webrtc_relay(Socket, s2c, Message),
|
||||
ws_webrtc_loop(State);
|
||||
{tcp_closed, Socket} ->
|
||||
ok = tell("~p Socket closed, retiring.~n", [self()]),
|
||||
exit(normal)
|
||||
end;
|
||||
% we have TCP bytes sitting and waiting to be parsed
|
||||
ws_webrtc_loop(State = #s{socket = Sock, next = Recv}) ->
|
||||
{ok, Message, NewRecv} = qhl_ws:recv_json(Sock, Recv, 5000),
|
||||
ok = ws_webrtc_relay(Sock, c2s, Message),
|
||||
ws_webrtc_loop(State#s{next = NewRecv}).
|
||||
|
||||
|
||||
% relay
|
||||
% message is a zj:value()
|
||||
ws_webrtc_relay(Socket, Direction, ZJValue) ->
|
||||
tell("~p ws_webrtc_relay ~p: ~p", [self(), Direction, ZJValue]),
|
||||
case Direction of
|
||||
c2s -> fd_httpd_webrtc:hi(ZJValue);
|
||||
s2c -> qhl_ws:send_json(Socket, ZJValue)
|
||||
end,
|
||||
ok.
|
||||
|
||||
|
||||
|
||||
%% ------------------------------
|
||||
%% echo
|
||||
%% ------------------------------
|
||||
@@ -348,7 +425,7 @@ wfcin(Sock, #request{enctype = json,
|
||||
{fd_httpd_utils:jsbad(ErrorMessage), Ctx0}
|
||||
end,
|
||||
% update cache with new context
|
||||
ok = fd_cache:set(Cookie, NewCtx),
|
||||
ok = fd_wfcd_cache:set(Cookie, NewCtx),
|
||||
Body = zj:encode(RespObj),
|
||||
Response = #response{headers = [{"content-type", "application/json"},
|
||||
{"set-cookie", ["wfc=", Cookie]}],
|
||||
@@ -366,17 +443,9 @@ wfcin(Sock, Request) ->
|
||||
Context :: wfc_eval_context:context().
|
||||
|
||||
ctx(#{<<"wfc">> := Cookie}) ->
|
||||
case fd_cache:query(Cookie) of
|
||||
case fd_wfcd_cache:query(Cookie) of
|
||||
{ok, Context} -> {Cookie, Context};
|
||||
error -> {Cookie, wfc_eval_context:default()}
|
||||
end;
|
||||
ctx(_) ->
|
||||
{fd_httpd_utils:new_cookie(), wfc_eval_context:default()}.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,165 @@
|
||||
% @doc webrtc peer pool
|
||||
-module(fd_httpd_webrtc).
|
||||
|
||||
-behavior(gen_server).
|
||||
|
||||
%% api (caller context)
|
||||
-export([
|
||||
join/0, hi/1
|
||||
]).
|
||||
|
||||
% startup/gen_server callbacks
|
||||
-export([
|
||||
% caller context
|
||||
start_link/0,
|
||||
% process context
|
||||
init/1, handle_call/3, handle_cast/2, handle_info/2,
|
||||
code_change/3, terminate/2
|
||||
]).
|
||||
|
||||
-include("$zx_include/zx_logger.hrl").
|
||||
|
||||
|
||||
-record(u, {pid :: pid()}).
|
||||
-type user() :: #u{}.
|
||||
|
||||
-record(s, {roster = [] :: [user()]}).
|
||||
-type state() :: #s{}.
|
||||
|
||||
|
||||
%%-----------------------------------------------------------------------------
|
||||
%% caller context
|
||||
%%-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
start_link() ->
|
||||
gen_server:start_link({local, ?MODULE}, ?MODULE, none, []).
|
||||
|
||||
|
||||
|
||||
-spec join() -> ok | {error, any()}.
|
||||
|
||||
join() ->
|
||||
gen_server:call(?MODULE, join).
|
||||
|
||||
|
||||
|
||||
-spec hi(Message) -> ok
|
||||
when Message :: zj:value().
|
||||
|
||||
hi(Message) ->
|
||||
gen_server:cast(?MODULE, {hi, self(), Message}).
|
||||
|
||||
|
||||
|
||||
%%-----------------------------------------------------------------------------
|
||||
%% process context
|
||||
%%-----------------------------------------------------------------------------
|
||||
|
||||
%% gen_server callbacks
|
||||
|
||||
init(none) ->
|
||||
tell("starting fd_httpd_webrtc", []),
|
||||
InitState = #s{},
|
||||
{ok, InitState}.
|
||||
|
||||
|
||||
handle_call(join, _From = {PID, _Tag}, State) ->
|
||||
{Reply, NewState} = do_join(PID, State),
|
||||
{reply, Reply, NewState};
|
||||
handle_call(Unexpected, From, State) ->
|
||||
tell("~tp: unexpected call from ~tp: ~tp", [?MODULE, Unexpected, From]),
|
||||
{noreply, State}.
|
||||
|
||||
|
||||
handle_cast(Unexpected, State) ->
|
||||
tell("~tp: unexpected cast: ~tp", [?MODULE, Unexpected]),
|
||||
{noreply, State}.
|
||||
|
||||
|
||||
handle_info({'DOWN', _Ref, process, PID, _Reason}, State) ->
|
||||
NewState = do_down(PID, State),
|
||||
{noreply, NewState};
|
||||
handle_info(Unexpected, State) ->
|
||||
tell("~tp: unexpected info: ~tp", [?MODULE, Unexpected]),
|
||||
{noreply, State}.
|
||||
|
||||
|
||||
code_change(_, State, _) ->
|
||||
{ok, State}.
|
||||
|
||||
terminate(_, _) ->
|
||||
ok.
|
||||
|
||||
|
||||
%%---------------------
|
||||
%% doers
|
||||
%%---------------------
|
||||
|
||||
-spec do_join(PID, State) -> {Reply, NewState}
|
||||
when PID :: pid(),
|
||||
State :: state(),
|
||||
Reply :: ok
|
||||
| {error, any()},
|
||||
NewState :: state().
|
||||
% @private join a user to a pool
|
||||
|
||||
do_join(PID, State = #s{roster = Users}) ->
|
||||
% see if pid is already there
|
||||
case lists:keymember(PID, #u.pid, Users) of
|
||||
true -> {error, already_joined};
|
||||
false -> do_join2(PID, State)
|
||||
end.
|
||||
|
||||
do_join2(PID, State = #s{roster = Users}) ->
|
||||
monitor(process, PID),
|
||||
NewUser = #u{pid = PID},
|
||||
NewRoster = usort([NewUser | Users]),
|
||||
NewState = State#s{roster = NewRoster},
|
||||
ok = whisper(whoami, PID),
|
||||
ok = gossip(roster, NewState),
|
||||
{ok, NewState}.
|
||||
|
||||
usort(Users) ->
|
||||
lists:keysort(#u.pid, Users).
|
||||
|
||||
|
||||
-spec do_down(PID, State) -> NewState
|
||||
when PID :: pid(),
|
||||
State :: state(),
|
||||
NewState :: state().
|
||||
% @private handle a user dying
|
||||
|
||||
do_down(PID, State = #s{roster = Users}) ->
|
||||
% remove from roster
|
||||
NewUsers = lists:keydelete(PID, #u.pid, Users),
|
||||
NewState = State#s{roster = NewUsers},
|
||||
% broadcast username
|
||||
ok = gossip(roster, NewState),
|
||||
NewState.
|
||||
|
||||
|
||||
% @doc send a message to a specific person
|
||||
whisper(whoami, PID) ->
|
||||
PID ! {webrtc, ["whoami", pidstr(PID)]},
|
||||
ok.
|
||||
|
||||
|
||||
% @doc send a message to everyone
|
||||
gossip(roster, State = #s{roster = Us}) ->
|
||||
Pids = [pidstr(PID) || #u{pid = PID} <- Us],
|
||||
gossip_json(["roster", Pids], State).
|
||||
|
||||
pidstr(PID) ->
|
||||
unicode:characters_to_list(io_lib:format("~tp", [PID])).
|
||||
|
||||
|
||||
-spec gossip_json(zj:value(), state()) -> ok.
|
||||
% @private gossip a message to everyone
|
||||
|
||||
gossip_json(Message, #s{roster = Users}) ->
|
||||
GossipTo =
|
||||
fun(#u{pid = PID}) ->
|
||||
PID ! {webrtc, Message}
|
||||
end,
|
||||
lists:foreach(GossipTo, Users).
|
||||
+5
-5
@@ -36,17 +36,17 @@ start_link() ->
|
||||
|
||||
init([]) ->
|
||||
RestartStrategy = {one_for_one, 1, 60},
|
||||
Cache = {fd_cache,
|
||||
{fd_cache, start_link, []},
|
||||
WFCd = {fd_wfcd,
|
||||
{fd_wfcd, start_link, []},
|
||||
permanent,
|
||||
5000,
|
||||
worker,
|
||||
[fd_cache]},
|
||||
supervisor,
|
||||
[fd_wfcd]},
|
||||
Httpd = {fd_httpd,
|
||||
{fd_httpd, start_link, []},
|
||||
permanent,
|
||||
5000,
|
||||
supervisor,
|
||||
[fd_httpd]},
|
||||
Children = [Cache, Httpd],
|
||||
Children = [WFCd, Httpd],
|
||||
{ok, {RestartStrategy, Children}}.
|
||||
|
||||
@@ -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}}.
|
||||
@@ -1,5 +1,5 @@
|
||||
% @doc storing map #{cookie := Context}
|
||||
-module(fd_cache).
|
||||
-module(fd_wfcd_cache).
|
||||
-vsn("0.2.0").
|
||||
|
||||
-behavior(gen_server).
|
||||
-105
@@ -1,105 +0,0 @@
|
||||
% @doc Abstracts a web socket into a process
|
||||
%
|
||||
% hands the TCP socket over to this process, also this process does the
|
||||
% handshake.
|
||||
%
|
||||
% this process sends back `{ws, self(), Message: qhl_ws:ws_msg()}'
|
||||
%
|
||||
% for each websocket message it gets
|
||||
-module(fd_wsp).
|
||||
-vsn("0.2.0").
|
||||
|
||||
-behavior(gen_server).
|
||||
|
||||
-export_type([
|
||||
|
||||
]).
|
||||
|
||||
-export([
|
||||
%% caller context
|
||||
%handshake/0,
|
||||
start_link/3,
|
||||
|
||||
%% process context
|
||||
init/1, handle_call/3, handle_cast/2, handle_info/2,
|
||||
code_change/3, terminate/2
|
||||
]).
|
||||
|
||||
-include("http.hrl").
|
||||
-include("$zx_include/zx_logger.hrl").
|
||||
|
||||
-record(s, {socket :: gen_tcp:socket()}).
|
||||
-type state() :: #s{}.
|
||||
|
||||
|
||||
%%-----------------------------------------------------------------------------
|
||||
%% caller context
|
||||
%%-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
-spec start_link(Socket, HandshakeReq, Received) -> Result
|
||||
when Socket :: gen_tcp:socket(),
|
||||
HandshakeReq :: request(),
|
||||
Received :: binary(),
|
||||
Result :: {ok, pid()}
|
||||
| {error, term()}.
|
||||
% @doc
|
||||
% starts a websocket and hands control of socket over to child process
|
||||
|
||||
start_link(Socket, HandshakeReq, Received) ->
|
||||
case gen_server:start_link(?MODULE, [Socket, HandshakeReq, Received], []) of
|
||||
{ok, PID} ->
|
||||
gen_tcp:controlling_process(Socket, PID),
|
||||
{ok, PID};
|
||||
Error ->
|
||||
Error
|
||||
end.
|
||||
|
||||
|
||||
%%-----------------------------------------------------------------------------
|
||||
%% process context below this line
|
||||
%%-----------------------------------------------------------------------------
|
||||
|
||||
%% gen_server callbacks
|
||||
|
||||
init([Socket, HandshakeReq, Received]) ->
|
||||
log("~p:~p init", [?MODULE, self()]),
|
||||
case qhl_ws:handshake(HandshakeReq) of
|
||||
{ok, Response} ->
|
||||
ok = fd_http_utils:respond(Socket, Response),
|
||||
InitState = #s{socket = Socket},
|
||||
{ok, InitState};
|
||||
Error ->
|
||||
tell("~p:~p websocket handshake err: ~p", [?MODULE, self(), Error]),
|
||||
fd_http_utils:http_err(Socket, 400),
|
||||
Error
|
||||
end.
|
||||
|
||||
|
||||
handle_call(Unexpected, From, State) ->
|
||||
tell("~tp: unexpected call from ~tp: ~tp", [?MODULE, Unexpected, From]),
|
||||
{noreply, State}.
|
||||
|
||||
|
||||
handle_cast(Unexpected, State) ->
|
||||
tell("~tp: unexpected cast: ~tp", [?MODULE, Unexpected]),
|
||||
{noreply, State}.
|
||||
|
||||
|
||||
handle_info({tcp, Sock, Bytes}, State = #s{socket = Sock}) ->
|
||||
{noreply, State};
|
||||
handle_info(Unexpected, State) ->
|
||||
tell("~tp: unexpected info: ~tp", [?MODULE, Unexpected]),
|
||||
{noreply, State}.
|
||||
|
||||
|
||||
code_change(_, State, _) ->
|
||||
{ok, State}.
|
||||
|
||||
terminate(_, _) ->
|
||||
ok.
|
||||
|
||||
|
||||
%%-----------------------------------------------------------------------------
|
||||
%% internals
|
||||
%%-----------------------------------------------------------------------------
|
||||
+85
-2
@@ -16,7 +16,9 @@
|
||||
%% porcelain
|
||||
handshake/1,
|
||||
recv/3, recv/4,
|
||||
send/2
|
||||
recv_strict/3, recv_json/3,
|
||||
send/2,
|
||||
send_dwim/2, send_json/2
|
||||
]).
|
||||
|
||||
-include("http.hrl").
|
||||
@@ -259,6 +261,54 @@ response_token(ChallengeToken) when is_binary(ChallengeToken) ->
|
||||
base64:encode(Sha1).
|
||||
|
||||
|
||||
-spec recv_json(Socket, Received, TimeoutMS) -> Result
|
||||
when Socket :: gen_tcp:socket(),
|
||||
Received :: binary(),
|
||||
TimeoutMS :: non_neg_integer(),
|
||||
Result :: {ok, zj:value(), Remainder}
|
||||
| {error, Reason},
|
||||
Remainder :: binary(),
|
||||
Reason :: any().
|
||||
% @doc
|
||||
% asserts response is text
|
||||
|
||||
recv_json(Sock, Recv, TimeoutMS) ->
|
||||
case recv_strict(Sock, Recv, TimeoutMS) of
|
||||
{ok, {Type, Payload}, NewRecv} when Type =:= text orelse
|
||||
Type =:= binary ->
|
||||
case zj:decode(Payload) of
|
||||
{ok, Value} ->
|
||||
io:format("~p value: ~p~n", [self(), Value]),
|
||||
{ok, Value, NewRecv};
|
||||
Error -> {error, {zj_decode, Error}}
|
||||
end;
|
||||
Error ->
|
||||
Error
|
||||
end.
|
||||
|
||||
|
||||
-spec recv_strict(Socket, Received, TimeoutMS) -> Result
|
||||
when Socket :: gen_tcp:socket(),
|
||||
Received :: binary(),
|
||||
TimeoutMS :: non_neg_integer(),
|
||||
Result :: {ok, Message, Remainder}
|
||||
| {error, Reason},
|
||||
Message :: ws_msg(),
|
||||
Remainder :: binary(),
|
||||
Reason :: any().
|
||||
% @doc
|
||||
% Almost equivalent to recv/3, but asserts resulting frames are empty
|
||||
|
||||
recv_strict(Sock, Recv, TimeoutMS) ->
|
||||
case recv(Sock, Recv, TimeoutMS) of
|
||||
{ok, Message, [], Remainder} ->
|
||||
{ok, Message, Remainder};
|
||||
Illegal = {ok, _, _NonEmptyFrames, _} ->
|
||||
{error, {bad_frame_stack, Illegal}};
|
||||
Error ->
|
||||
Error
|
||||
end.
|
||||
|
||||
|
||||
-spec recv(Socket, Received, TimeoutMS) -> Result
|
||||
when Socket :: gen_tcp:socket(),
|
||||
@@ -604,10 +654,15 @@ recv_frame(Frame = #frame{payload_length = Len, payload = none}, Sock, Received,
|
||||
|
||||
%% factoring this out into a function to reduce repetition
|
||||
recv_frame_await(Frame, Sock, Received, Timeout) ->
|
||||
io:format("~p called: recv_frame_await(~p, ~p, ~p, ~p)~n",
|
||||
[self(), Frame, Sock, Received, Timeout]),
|
||||
case inet:setopts(Sock, [{active, once}]) of
|
||||
ok ->
|
||||
receive
|
||||
{tcp, Sock, Bin} -> recv_frame(Frame, Sock, <<Received/bits, Bin/binary>>, Timeout);
|
||||
{tcp, Sock, Bin} ->
|
||||
io:format("~p calling: recv_frame(~p, ~p, ~p, ~p)~n",
|
||||
[self(),Frame, Sock, <<Received/bits, Bin/binary>>, Timeout]),
|
||||
recv_frame(Frame, Sock, <<Received/bits, Bin/binary>>, Timeout);
|
||||
{tcp_closed, Sock} -> {error, tcp_closed};
|
||||
{tcp_error, Sock, Reason} -> {error, {tcp_error, Reason}}
|
||||
after Timeout ->
|
||||
@@ -618,6 +673,34 @@ recv_frame_await(Frame, Sock, Received, Timeout) ->
|
||||
end.
|
||||
|
||||
|
||||
send_json(Socket, X) ->
|
||||
send_dwim(Socket, {json, X}).
|
||||
|
||||
|
||||
-spec send_dwim(Socket, Message) -> Result
|
||||
when Socket :: gen_tcp:socket(),
|
||||
Message :: string()
|
||||
| binary()
|
||||
| {json, zj:value()}
|
||||
| ws_msg(),
|
||||
Result :: ok
|
||||
| {error, Reason},
|
||||
Reason :: any().
|
||||
% @doc
|
||||
% equivalent to send/2 but assumes iolists/strings are meant to be `text`, and
|
||||
% naked binaries are meant to be `binary`
|
||||
%
|
||||
% lists are assumed to be unicode iolists and are converted to strings via
|
||||
% unicode:characters_to_list
|
||||
%
|
||||
% json is encoded as text and sent as such
|
||||
% @end
|
||||
|
||||
send_dwim(Socket, X) when is_list(X) -> send(Socket, {text, X});
|
||||
send_dwim(Socket, X) when is_binary(X) -> send(Socket, {binary, X});
|
||||
send_dwim(Socket, {json, X}) -> send(Socket, {text, zj:encode(X)});
|
||||
send_dwim(Socket, {Type, Payload}) -> send(Socket, {Type, Payload}).
|
||||
|
||||
|
||||
-spec send(Socket, Message) -> Result
|
||||
when Socket :: gen_tcp:socket(),
|
||||
|
||||
-694
@@ -1,694 +0,0 @@
|
||||
%%% @doc
|
||||
%%% ZJ: The tiny JSON parser
|
||||
%%%
|
||||
%%% This module exports four functions and accepts no options.
|
||||
%%% @end
|
||||
|
||||
-module(zj).
|
||||
-vsn("0.2.0").
|
||||
-author("Craig Everett <zxq9@zxq9.com>").
|
||||
-copyright("Craig Everett <zxq9@zxq9.com>").
|
||||
-license("MIT").
|
||||
|
||||
-export([encode/1, decode/1,
|
||||
binary_encode/1, binary_decode/1]).
|
||||
|
||||
-export_type([value/0, bin_value/0]).
|
||||
|
||||
-type value() :: string()
|
||||
| number()
|
||||
| true
|
||||
| false
|
||||
| undefined
|
||||
| [value()]
|
||||
| #{string() := value()}.
|
||||
|
||||
|
||||
-type bin_value() :: binary()
|
||||
| number()
|
||||
| true
|
||||
| false
|
||||
| undefined
|
||||
| [bin_value()]
|
||||
| #{binary() := bin_value()}.
|
||||
|
||||
|
||||
|
||||
%%% Character constants
|
||||
|
||||
-define(BKSPC, 16#08).
|
||||
-define(H_TAB, 16#09).
|
||||
-define(NEW_L, 16#0A).
|
||||
-define(FORMF, 16#0C).
|
||||
-define(CAR_R, 16#0D).
|
||||
-define(SPACE, 16#20).
|
||||
|
||||
|
||||
%%% Interface Functions
|
||||
|
||||
-spec encode(term()) -> string().
|
||||
|
||||
%% @doc
|
||||
%% Take any convertable Erlang term and convert it to a JSON string.
|
||||
%%
|
||||
%% As JSON can only satirically be referred to as "a serialization format", it is
|
||||
%% almost impossible to map any interesting data between Erlang (or any other language)
|
||||
%% and JSON. For example, tuples do not exist in JSON, so converting an Erlang tuple
|
||||
%% turns it into a list (a JSON array). Atoms also do not exist, so atoms other than
|
||||
%% the ternay logic values `true', `false' and `null' become strings (those three
|
||||
%% remain as atoms, with the added detail that JSON `null' maps to Erlang
|
||||
%% `undefined').
|
||||
%%
|
||||
%% Unless care is taken to pick types that JSON can accurately express (integers,
|
||||
%% floats, strings, maps, lists, ternary logic atoms) it is not possible to guarantee
|
||||
%% (or even reasonable to expect) that `Term == decode(encode(Term))' will be true.
|
||||
%%
|
||||
%% This function crashes when it fails. Things that will cause a crash are trying to
|
||||
%% convert non-UTF-8 binaries to strings, use non-string values as object keys,
|
||||
%% encode an unaligned bitstring, etc.
|
||||
%%
|
||||
%% Note that Erlang terms are converted as type primitives, meaning that compound
|
||||
%% functional structures like GB-trees, dicts, sets, etc. will wind up having their
|
||||
%% underlying structures converted as-is which is almost never what you want. It is
|
||||
%% usually best to reduce compound values down to primitives (lists or maps) before
|
||||
%% running encode.
|
||||
%%
|
||||
%% The only unsupported Erlang pritmitive is bitstrings. Care has NOT been taken to
|
||||
%% ensure separation between actual binary data and binaries that are supposed to be
|
||||
%% interpreted as strings. The same is true of deep list data: it just comes out raw
|
||||
%% unless you flatten or convert it to a utf8 string with the unicode module.
|
||||
%%
|
||||
%% NOTE: If you need a serialization format that is less ambiguous and expresses more
|
||||
%% types consider using BERT (language-independent implementations of Erlang external
|
||||
%% binary format) instead: http://bert-rpc.org
|
||||
|
||||
encode(true) -> "true";
|
||||
encode(false) -> "false";
|
||||
encode(undefined) -> "null";
|
||||
encode([]) -> "[]";
|
||||
encode(T) when is_atom(T) -> quote(atom_to_list(T));
|
||||
encode(T) when is_float(T) -> float_to_list(T);
|
||||
encode(T) when is_integer(T) -> integer_to_list(T);
|
||||
encode(T) when is_pid(T) -> quote(pid_to_list(T));
|
||||
encode(T) when is_port(T) -> quote(port_to_list(T));
|
||||
encode(T) when is_function(T) -> quote(erlang:fun_to_list(T));
|
||||
encode(T) when is_reference(T) -> quote(ref_to_list(T));
|
||||
encode(T) -> unicode:characters_to_list(encode_value(T)).
|
||||
|
||||
|
||||
-spec decode(Stream) -> Result
|
||||
when Stream :: unicode:chardata(),
|
||||
Result :: {ok, value()}
|
||||
| {error, Parsed, Remainder}
|
||||
| {incomplete, Parsed, Remainder},
|
||||
Parsed :: value(),
|
||||
Remainder :: unicode:chardata()
|
||||
| unicode:external_chardata()
|
||||
| binary().
|
||||
%% @doc
|
||||
%% Take any IO data acceptable to the unicode module and return a parsed data structure.
|
||||
%% In the event of a parsing error whatever part of the structure could be successfully
|
||||
%% parsed will be returned along with the remainder of the string. Note that the string
|
||||
%% remainder may have been changed to a different form by unicode:characters_to_list/1.
|
||||
%% If the unicode library itself runs into a problem performing the initial conversion
|
||||
%% its error return (`error' or `incomplete') will be returned directly.
|
||||
|
||||
decode(Stream) ->
|
||||
case unicode:characters_to_list(Stream) of
|
||||
E when is_tuple(E) -> E;
|
||||
[16#FEFF | String] -> parse(seek(String));
|
||||
String -> parse(seek(String))
|
||||
end.
|
||||
|
||||
|
||||
-spec binary_encode(term()) -> binary().
|
||||
%% @doc
|
||||
%% A strict encoding routine that works very similarly to `encode/1' but with a few
|
||||
%% differences:
|
||||
%% ```
|
||||
%% - Lists and Strings are firmly separated:
|
||||
%% ALL lists are lists of discrete values, never strings.
|
||||
%% ALL binaries are always UTF-8 strings.
|
||||
%% An Erlang string or io_list will be encoded as JSON array.
|
||||
%% - This function generates a UTF-8 binary, not a list.
|
||||
%% - The burden is on the user to ensure that io_lists are collapsed to unicode
|
||||
%% binaries via `unicode:characters_to_binary/1' before passing in string values.
|
||||
%% - Erlang strings (lists) are still accepted as map/object keys.
|
||||
%% '''
|
||||
%%
|
||||
%% NOTE:
|
||||
%% Most cases are better served by `encode/1', as most code deals in strings and not
|
||||
%% arrays of integer values.
|
||||
%%
|
||||
%% Using this function requires a little bit more work up front (because ununified
|
||||
%% io_list() data will always be interpreted as a JSON array), but provides a way to
|
||||
%% reliably generate lists or strings in an unambiguous way in the special case where
|
||||
%% your code is generating both strings and lists of integer values that may overlap
|
||||
%% with valid UTF-8 codepoint values.
|
||||
|
||||
binary_encode(true) -> <<"true">>;
|
||||
binary_encode(false) -> <<"false">>;
|
||||
binary_encode(undefined) -> <<"null">>;
|
||||
binary_encode(T) when is_atom(T) -> <<"\"", (atom_to_binary(T, utf8))/binary, "\"">>;
|
||||
binary_encode(T) when is_float(T) -> float_to_binary(T);
|
||||
binary_encode(T) when is_integer(T) -> integer_to_binary(T);
|
||||
binary_encode(T) when is_pid(T) -> <<"\"", (list_to_binary(pid_to_list(T)))/binary, "\"">>;
|
||||
binary_encode(T) when is_port(T) -> <<"\"", (list_to_binary(port_to_list(T)))/binary, "\"">>;
|
||||
binary_encode(T) when is_function(T) -> <<"\"", (list_to_binary(erlang:fun_to_list(T)))/binary, "\"">>;
|
||||
binary_encode(T) when is_reference(T) -> <<"\"", (list_to_binary(ref_to_list(T)))/binary, "\"">>;
|
||||
binary_encode(T) -> unicode:characters_to_binary(b_encode_value(T)).
|
||||
|
||||
|
||||
-spec binary_decode(Stream) -> Result
|
||||
when Stream :: unicode:chardata(),
|
||||
Result :: {ok, bin_value()}
|
||||
| {error, Parsed, Remainder}
|
||||
| {incomplete, Parsed, Remainder},
|
||||
Parsed :: bin_value(),
|
||||
Remainder :: binary().
|
||||
%% @doc
|
||||
%% Almost identical in behavior to `decode/1' except this returns strings as binaries
|
||||
%% and arrays of integers as Erlang lists (which may also be valid strings if the
|
||||
%% values are valid UTF-8 codepoints).
|
||||
%%
|
||||
%% NOTE:
|
||||
%% This function returns map keys as binaries
|
||||
|
||||
binary_decode(Stream) ->
|
||||
case b_decode(Stream) of
|
||||
{error, Part, Rest} -> {error, Part, unicode:characters_to_binary(Rest)};
|
||||
Result -> Result
|
||||
end.
|
||||
|
||||
|
||||
|
||||
%%% Encoding Functions
|
||||
|
||||
encode_value(true) -> "true";
|
||||
encode_value(false) -> "false";
|
||||
encode_value(undefined) -> "null";
|
||||
encode_value(T) when is_atom(T) -> quote(atom_to_list(T));
|
||||
encode_value(T) when is_float(T) -> float_to_list(T);
|
||||
encode_value(T) when is_integer(T) -> integer_to_list(T);
|
||||
encode_value(T) when is_binary(T) -> maybe_string(T);
|
||||
encode_value(T) when is_list(T) -> maybe_array(T);
|
||||
encode_value(T) when is_map(T) -> pack_object(T);
|
||||
encode_value(T) when is_tuple(T) -> pack_array(tuple_to_list(T));
|
||||
encode_value(T) when is_pid(T) -> quote(pid_to_list(T));
|
||||
encode_value(T) when is_port(T) -> quote(port_to_list(T));
|
||||
encode_value(T) when is_function(T) -> quote(erlang:fun_to_list(T));
|
||||
encode_value(T) when is_reference(T) -> quote(ref_to_list(T)).
|
||||
|
||||
|
||||
maybe_string(T) ->
|
||||
L = binary_to_list(T),
|
||||
true = io_lib:printable_unicode_list(L),
|
||||
quote(L).
|
||||
|
||||
|
||||
maybe_array(T) ->
|
||||
case io_lib:printable_unicode_list(T) of
|
||||
true -> quote(T);
|
||||
false -> pack_array(T)
|
||||
end.
|
||||
|
||||
|
||||
quote(T) -> [$" | escape(T)].
|
||||
|
||||
escape([]) -> [$"];
|
||||
escape([$\b | T]) -> [$\\, $b | escape(T)];
|
||||
escape([$\f | T]) -> [$\\, $f | escape(T)];
|
||||
escape([$\n | T]) -> [$\\, $n | escape(T)];
|
||||
escape([$\r | T]) -> [$\\, $r | escape(T)];
|
||||
escape([$\t | T]) -> [$\\, $t | escape(T)];
|
||||
escape([$\" | T]) -> [$\\, $" | escape(T)];
|
||||
escape([$\\ | T]) -> [$\\, $\\ | escape(T)];
|
||||
escape([H | T]) -> [H | escape(T)].
|
||||
|
||||
|
||||
pack_array([]) -> "[]";
|
||||
pack_array([H | []]) -> [$[, encode_value(H), $]];
|
||||
pack_array([H | T]) -> [$[, encode_value(H), $,, encode_array(T), $]].
|
||||
|
||||
encode_array([H | []]) -> encode_value(H);
|
||||
encode_array([H | T]) -> [encode_value(H), $,, encode_array(T)].
|
||||
|
||||
|
||||
pack_object(M) ->
|
||||
case maps:to_list(M) of
|
||||
[] ->
|
||||
"{}";
|
||||
[{K, V} | T] when is_list(K) ->
|
||||
true = io_lib:printable_unicode_list(K),
|
||||
Init = [$", K, $", $:, encode_value(V)],
|
||||
[${, lists:foldl(fun pack_object/2, Init, T), $}];
|
||||
[{K, V} | T] when is_binary(K) ->
|
||||
Key = unicode:characters_to_list(K),
|
||||
true = io_lib:printable_unicode_list(Key),
|
||||
Init = [$", Key, $", $:, encode_value(V)],
|
||||
[${, lists:foldl(fun pack_object/2, Init, T), $}];
|
||||
[{K, V} | T] when is_float(K) ->
|
||||
Key = float_to_list(K),
|
||||
Init = [$", Key, $", $:, encode_value(V)],
|
||||
[${, lists:foldl(fun pack_object/2, Init, T), $}];
|
||||
[{K, V} | T] when is_integer(K) ->
|
||||
Key = integer_to_list(K),
|
||||
Init = [$", Key, $", $:, encode_value(V)],
|
||||
[${, lists:foldl(fun pack_object/2, Init, T), $}];
|
||||
[{K, V} | T] when is_atom(K) ->
|
||||
Init = [$", atom_to_list(K), $", $:, encode_value(V)],
|
||||
[${, lists:foldl(fun pack_object/2, Init, T), $}]
|
||||
end.
|
||||
|
||||
pack_object({K, V}, L) when is_list(K) ->
|
||||
true = io_lib:printable_unicode_list(K),
|
||||
[$", K, $", $:, encode_value(V), $, | L];
|
||||
pack_object({K, V}, L) when is_binary(K) ->
|
||||
Key = unicode:characters_to_list(K),
|
||||
true = io_lib:printable_unicode_list(Key),
|
||||
[$", Key, $", $:, encode_value(V), $, | L];
|
||||
pack_object({K, V}, L) when is_float(K) ->
|
||||
Key = float_to_list(K),
|
||||
[$", Key, $", $:, encode_value(V), $, | L];
|
||||
pack_object({K, V}, L) when is_integer(K) ->
|
||||
Key = integer_to_list(K),
|
||||
[$", Key, $", $:, encode_value(V), $, | L];
|
||||
pack_object({K, V}, L) when is_atom(K) ->
|
||||
[$", atom_to_list(K), $", $:, encode_value(V), $, | L].
|
||||
|
||||
|
||||
b_encode_value(true) -> <<"true">>;
|
||||
b_encode_value(false) -> <<"false">>;
|
||||
b_encode_value(undefined) -> <<"null">>;
|
||||
b_encode_value(T) when is_atom(T) -> [$", atom_to_binary(T, utf8), $"];
|
||||
b_encode_value(T) when is_float(T) -> float_to_binary(T);
|
||||
b_encode_value(T) when is_integer(T) -> integer_to_binary(T);
|
||||
b_encode_value(T) when is_binary(T) -> [$", b_maybe_string(T), $"];
|
||||
b_encode_value(T) when is_list(T) -> b_pack_array(T);
|
||||
b_encode_value(T) when is_map(T) -> b_pack_object(T);
|
||||
b_encode_value(T) when is_tuple(T) -> b_pack_array(tuple_to_list(T));
|
||||
b_encode_value(T) when is_pid(T) -> [$", list_to_binary(pid_to_list(T)), $"];
|
||||
b_encode_value(T) when is_port(T) -> [$", list_to_binary(port_to_list(T)), $"];
|
||||
b_encode_value(T) when is_function(T) -> [$", list_to_binary(erlang:fun_to_list(T)), $"];
|
||||
b_encode_value(T) when is_reference(T) -> [$", list_to_binary(ref_to_list(T)), $"].
|
||||
|
||||
|
||||
b_maybe_string(T) ->
|
||||
S = unicode:characters_to_binary(T),
|
||||
true = is_binary(S),
|
||||
S.
|
||||
|
||||
|
||||
b_pack_array([]) -> "[]";
|
||||
b_pack_array([H | []]) -> [$[, b_encode_value(H), $]];
|
||||
b_pack_array([H | T]) -> [$[, b_encode_value(H), $,, b_encode_array(T), $]].
|
||||
|
||||
b_encode_array([H | []]) -> b_encode_value(H);
|
||||
b_encode_array([H | T]) -> [b_encode_value(H), $,, b_encode_array(T)].
|
||||
|
||||
|
||||
b_pack_object(M) ->
|
||||
case maps:to_list(M) of
|
||||
[] ->
|
||||
"{}";
|
||||
[{K, V} | T] when is_list(K) ->
|
||||
true = io_lib:printable_unicode_list(K),
|
||||
Init = [$", K, $", $:, b_encode_value(V)],
|
||||
[${, lists:foldl(fun b_pack_object/2, Init, T), $}];
|
||||
[{K, V} | T] when is_binary(K) ->
|
||||
true = io_lib:printable_unicode_list(unicode:characters_to_list(K)),
|
||||
Init = [$", K, $", $:, b_encode_value(V)],
|
||||
[${, lists:foldl(fun b_pack_object/2, Init, T), $}];
|
||||
[{K, V} | T] when is_float(K) ->
|
||||
Key = float_to_list(K),
|
||||
Init = [$", Key, $", $:, b_encode_value(V)],
|
||||
[${, lists:foldl(fun b_pack_object/2, Init, T), $}];
|
||||
[{K, V} | T] when is_integer(K) ->
|
||||
Key = integer_to_list(K),
|
||||
Init = [$", Key, $", $:, b_encode_value(V)],
|
||||
[${, lists:foldl(fun b_pack_object/2, Init, T), $}];
|
||||
[{K, V} | T] when is_atom(K) ->
|
||||
Init = [$", atom_to_binary(K, utf8), $", $:, b_encode_value(V)],
|
||||
[${, lists:foldl(fun b_pack_object/2, Init, T), $}]
|
||||
end.
|
||||
|
||||
b_pack_object({K, V}, L) when is_list(K) ->
|
||||
true = io_lib:printable_unicode_list(K),
|
||||
[$", K, $", $:, b_encode_value(V), $, | L];
|
||||
b_pack_object({K, V}, L) when is_binary(K) ->
|
||||
true = io_lib:printable_unicode_list(unicode:characters_to_list(K)),
|
||||
[$", K, $", $:, b_encode_value(V), $, | L];
|
||||
b_pack_object({K, V}, L) when is_float(K) ->
|
||||
Key = float_to_list(K),
|
||||
[$", Key, $", $:, b_encode_value(V), $, | L];
|
||||
b_pack_object({K, V}, L) when is_integer(K) ->
|
||||
Key = integer_to_list(K),
|
||||
[$", Key, $", $:, b_encode_value(V), $, | L];
|
||||
b_pack_object({K, V}, L) when is_atom(K) ->
|
||||
[$", atom_to_list(K), $", $:, b_encode_value(V), $, | L].
|
||||
|
||||
|
||||
%%% Decode Functions
|
||||
|
||||
-spec parse(Stream) -> Result
|
||||
when Stream :: string(),
|
||||
Result :: {ok, value()}
|
||||
| {error, Extracted :: value(), Remaining :: string()}.
|
||||
%% @private
|
||||
%% The top-level dispatcher. This packages the top level value (or top-level error)
|
||||
%% for return to the caller. A very similar function (value/1) is used for inner
|
||||
%% values.
|
||||
|
||||
parse([${ | Rest]) ->
|
||||
case object(Rest) of
|
||||
{ok, Object, ""} -> {ok, Object};
|
||||
{ok, Object, More} -> polish(Object, seek(More));
|
||||
Error -> Error
|
||||
end;
|
||||
parse([$[ | Rest]) ->
|
||||
case array(Rest) of
|
||||
{ok, Array, ""} -> {ok, Array};
|
||||
{ok, Array, More} -> polish(Array, seek(More));
|
||||
Error -> Error
|
||||
end;
|
||||
parse([$" | Rest]) ->
|
||||
case string(Rest) of
|
||||
{ok, String, ""} -> {ok, String};
|
||||
{ok, String, More} -> polish(String, seek(More));
|
||||
Error -> Error
|
||||
end;
|
||||
parse([I | Rest]) when I == $-; $0 =< I, I =< $9 ->
|
||||
case number_int(Rest, [I]) of
|
||||
{ok, Number, ""} -> {ok, Number};
|
||||
{ok, Number, More} -> polish(Number, seek(More));
|
||||
Error -> Error
|
||||
end;
|
||||
parse("true" ++ More) ->
|
||||
polish(true, seek(More));
|
||||
parse("false" ++ More) ->
|
||||
polish(false, seek(More));
|
||||
parse("null" ++ More) ->
|
||||
polish(undefined, seek(More));
|
||||
parse(Other) ->
|
||||
{error, [], Other}.
|
||||
|
||||
|
||||
polish(Value, "") -> {ok, Value};
|
||||
polish(Value, More) -> {error, Value, More}.
|
||||
|
||||
|
||||
value([${ | Rest]) -> object(Rest);
|
||||
value([$[ | Rest]) -> array(Rest);
|
||||
value([$" | Rest]) -> string(Rest);
|
||||
value([I | Rest]) when I == $-; $0 =< I, I =< $9 -> number_int(Rest, [I]);
|
||||
value("true" ++ Rest) -> {ok, true, Rest};
|
||||
value("false" ++ Rest) -> {ok, false, Rest};
|
||||
value("null" ++ Rest) -> {ok, undefined, Rest};
|
||||
value(_) -> error.
|
||||
|
||||
|
||||
object([$} | Rest]) -> {ok, #{}, Rest};
|
||||
object(String) -> object(seek(String), #{}).
|
||||
|
||||
object([$} | Rest], Map) ->
|
||||
{ok, Map, Rest};
|
||||
object([$" | Rest], Map) ->
|
||||
case string(Rest) of
|
||||
{ok, Key, Remainder} -> object_value(seek(Remainder), Key, Map);
|
||||
{error, _, _} -> {error, Map, Rest}
|
||||
end;
|
||||
object(Rest, Map) ->
|
||||
{error, Map, Rest}.
|
||||
|
||||
object_value([$: | Rest], Key, Map) ->
|
||||
object_value_parse(seek(Rest), Key, Map);
|
||||
object_value(Rest, Key, Map) ->
|
||||
{error, maps:put(Key, undefined, Map), Rest}.
|
||||
|
||||
object_value_parse(String, Key, Map) ->
|
||||
case value(String) of
|
||||
{ok, Value, Rest} -> object_next(seek(Rest), maps:put(Key, Value, Map));
|
||||
{error, Value, Rest} -> {error, maps:put(Key, Value, Map), Rest};
|
||||
error -> {error, Map, String}
|
||||
end.
|
||||
|
||||
|
||||
object_next([$, | Rest], Map) -> object(seek(Rest), Map);
|
||||
object_next([$} | Rest], Map) -> {ok, Map, seek(Rest)};
|
||||
object_next(Rest, Map) -> {error, Map, Rest}.
|
||||
|
||||
|
||||
array([$] | Rest]) -> {ok, [], Rest};
|
||||
array(String) -> array(seek(String), []).
|
||||
|
||||
array([$] | Rest], List) ->
|
||||
{ok, lists:reverse(List), seek(Rest)};
|
||||
array(String, List) ->
|
||||
case value(String) of
|
||||
{ok, Value, Rest} -> array_next(seek(Rest), [Value | List]);
|
||||
{error, Value, Rest} -> {error, lists:reverse([Value | List]), Rest};
|
||||
error -> {error, lists:reverse(List), String}
|
||||
end.
|
||||
|
||||
array_next([$, | Rest], List) -> array(seek(Rest), List);
|
||||
array_next([$] | Rest], List) -> {ok, lists:reverse(List), seek(Rest)};
|
||||
array_next(Rest, List) -> {error, lists:reverse(List), Rest}.
|
||||
|
||||
|
||||
string(Stream) -> string(Stream, "").
|
||||
|
||||
string([$" | Rest], String) ->
|
||||
{ok, lists:reverse(String), Rest};
|
||||
string([$\\, $" | Rest], String) ->
|
||||
string(Rest, [$" | String]);
|
||||
string([$\\, $\\ | Rest], String) ->
|
||||
string(Rest, [$\\ | String]);
|
||||
string([$\\, $b | Rest], String) ->
|
||||
string(Rest, [?BKSPC | String]);
|
||||
string([$\\, $t | Rest], String) ->
|
||||
string(Rest, [?H_TAB | String]);
|
||||
string([$\\, $n | Rest], String) ->
|
||||
string(Rest, [?NEW_L | String]);
|
||||
string([$\\, $f | Rest], String) ->
|
||||
string(Rest, [?FORMF | String]);
|
||||
string([$\\, $r | Rest], String) ->
|
||||
string(Rest, [?CAR_R | String]);
|
||||
string([$\\, $u, A, B, C, D | Rest], String)
|
||||
when (($0 =< A andalso A =< $9) or ($A =< A andalso A =< $F) or ($a =< A andalso A =< $f))
|
||||
and (($0 =< B andalso B =< $9) or ($A =< B andalso B =< $F) or ($a =< B andalso B =< $f))
|
||||
and (($0 =< C andalso C =< $9) or ($A =< C andalso C =< $F) or ($a =< C andalso C =< $f))
|
||||
and (($0 =< D andalso D =< $9) or ($A =< D andalso D =< $F) or ($a =< D andalso D =< $f)) ->
|
||||
Char = list_to_integer([A, B, C, D], 16),
|
||||
string(Rest, [Char | String]);
|
||||
string(Stream = [$\\, $u | _], String) ->
|
||||
{error, String, Stream};
|
||||
string([$\\, Char | Rest], String)
|
||||
when Char == 16#20;
|
||||
Char == 16#21;
|
||||
16#23 =< Char, Char =< 16#5B;
|
||||
16#5D =< Char, Char =< 16#10FFFF ->
|
||||
string(Rest, [$\\, Char | String]);
|
||||
string([Char | Rest], String)
|
||||
when Char == 16#20;
|
||||
Char == 16#21;
|
||||
16#23 =< Char, Char =< 16#5B;
|
||||
16#5D =< Char, Char =< 16#10FFFF ->
|
||||
string(Rest, [Char | String]);
|
||||
string(Rest, String) ->
|
||||
{error, lists:reverse(String), Rest}.
|
||||
|
||||
|
||||
number_int([$. | Rest], String) ->
|
||||
number_float(Rest, [$. | String]);
|
||||
number_int([$e, Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_float_exp(Rest, [Char, $+, $e, $0, $. | String]);
|
||||
number_int([$E, Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_float_exp(Rest, [Char, $+, $e, $0, $. | String]);
|
||||
number_int([$e, $+, Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_float_exp(Rest, [Char, $+, $e, $0, $. | String]);
|
||||
number_int([$E, $+, Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_float_exp(Rest, [Char, $+, $e, $0, $. | String]);
|
||||
number_int([$e, $-, Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_float_exp(Rest, [Char, $-, $e, $0, $. | String]);
|
||||
number_int([$E, $-, Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_float_exp(Rest, [Char, $-, $e, $0, $. | String]);
|
||||
number_int([Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_int(Rest, [Char | String]);
|
||||
number_int(Rest, "-") ->
|
||||
{error, "", [$- | Rest]};
|
||||
number_int(Rest, String) ->
|
||||
{ok, list_to_integer(lists:reverse(String)), seek(Rest)}.
|
||||
|
||||
number_float([Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_float(Rest, [Char | String]);
|
||||
number_float([$E, Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_float_exp(Rest, [Char, $+, $e | String]);
|
||||
number_float([$e, Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_float_exp(Rest, [Char, $+, $e | String]);
|
||||
number_float([$E, $+, Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_float_exp(Rest, [Char, $+, $e | String]);
|
||||
number_float([$e, $+, Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_float_exp(Rest, [Char, $+, $e | String]);
|
||||
number_float([$E, $-, Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_float_exp(Rest, [Char, $-, $e | String]);
|
||||
number_float([$e, $-, Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_float_exp(Rest, [Char, $-, $e | String]);
|
||||
number_float(Rest, String) ->
|
||||
Target = lists:reverse(String),
|
||||
try
|
||||
Number = list_to_float(Target),
|
||||
{ok, Number, seek(Rest)}
|
||||
catch
|
||||
error:badarg -> {error, "", Target ++ Rest}
|
||||
end.
|
||||
|
||||
|
||||
number_float_exp([Char | Rest], String) when $0 =< Char, Char =< $9 ->
|
||||
number_float_exp(Rest, [Char | String]);
|
||||
number_float_exp(Rest, String) ->
|
||||
Target = lists:reverse(String),
|
||||
try
|
||||
Number = list_to_float(Target),
|
||||
{ok, Number, seek(Rest)}
|
||||
catch
|
||||
error:badarg -> {error, "", Target ++ Rest}
|
||||
end.
|
||||
|
||||
|
||||
seek([?H_TAB | Rest]) -> seek(Rest);
|
||||
seek([?NEW_L | Rest]) -> seek(Rest);
|
||||
seek([?CAR_R | Rest]) -> seek(Rest);
|
||||
seek([?SPACE | Rest]) -> seek(Rest);
|
||||
seek(String) -> String.
|
||||
|
||||
|
||||
b_decode(Stream) ->
|
||||
case unicode:characters_to_list(Stream) of
|
||||
E when is_tuple(E) -> E;
|
||||
[16#FEFF | String] -> binary_parse(seek(String));
|
||||
String -> binary_parse(seek(String))
|
||||
end.
|
||||
|
||||
-spec binary_parse(Stream) -> Result
|
||||
when Stream :: string(),
|
||||
Result :: {ok, bin_value()}
|
||||
| {error, Extracted :: bin_value(), Remaining :: binary()}.
|
||||
%% @private
|
||||
%% The top-level dispatcher. This packages the top level value (or top-level error)
|
||||
%% for return to the caller. A very similar function (b_value/1) is used for inner
|
||||
%% values.
|
||||
|
||||
binary_parse([${ | Rest]) ->
|
||||
case b_object(Rest) of
|
||||
{ok, Object, ""} -> {ok, Object};
|
||||
{ok, Object, More} -> b_polish(Object, seek(More));
|
||||
Error -> Error
|
||||
end;
|
||||
binary_parse([$[ | Rest]) ->
|
||||
case b_array(Rest) of
|
||||
{ok, Array, ""} -> {ok, Array};
|
||||
{ok, Array, More} -> b_polish(Array, seek(More));
|
||||
Error -> Error
|
||||
end;
|
||||
binary_parse([$" | Rest]) ->
|
||||
case string(Rest) of
|
||||
{ok, String, ""} ->
|
||||
case unicode:characters_to_binary(String) of
|
||||
E when is_tuple(E) -> E;
|
||||
Result -> {ok, Result}
|
||||
end;
|
||||
{ok, String, More} ->
|
||||
case unicode:characters_to_binary(String) of
|
||||
E when is_tuple(E) -> E;
|
||||
Result -> b_polish(Result, seek(More))
|
||||
end;
|
||||
Error ->
|
||||
Error
|
||||
end;
|
||||
binary_parse([I | Rest]) when I == $-; $0 =< I, I =< $9 ->
|
||||
case number_int(Rest, [I]) of
|
||||
{ok, Number, ""} -> {ok, Number};
|
||||
{ok, Number, More} -> b_polish(Number, seek(More));
|
||||
Error -> Error
|
||||
end;
|
||||
binary_parse("true" ++ More) ->
|
||||
b_polish(true, seek(More));
|
||||
binary_parse("false" ++ More) ->
|
||||
b_polish(false, seek(More));
|
||||
binary_parse("null" ++ More) ->
|
||||
b_polish(undefined, seek(More));
|
||||
binary_parse(Other) ->
|
||||
{error, [], Other}.
|
||||
|
||||
|
||||
b_polish(Value, "") -> {ok, Value};
|
||||
b_polish(Value, More) -> {error, Value, More}.
|
||||
|
||||
|
||||
b_value([${ | Rest]) -> b_object(Rest);
|
||||
b_value([$[ | Rest]) -> b_array(Rest);
|
||||
b_value([$" | Rest]) -> b_string(Rest);
|
||||
b_value([I | Rest]) when I == $-; $0 =< I, I =< $9 -> number_int(Rest, [I]);
|
||||
b_value("true" ++ Rest) -> {ok, true, Rest};
|
||||
b_value("false" ++ Rest) -> {ok, false, Rest};
|
||||
b_value("null" ++ Rest) -> {ok, undefined, Rest};
|
||||
b_value(_) -> error.
|
||||
|
||||
|
||||
b_string(Stream) ->
|
||||
case string(Stream) of
|
||||
{ok, String, More} ->
|
||||
case unicode:characters_to_binary(String) of
|
||||
E when is_tuple(E) -> E;
|
||||
Result -> {ok, Result, More}
|
||||
end;
|
||||
Error -> Error
|
||||
end.
|
||||
|
||||
|
||||
b_object([$} | Rest]) -> {ok, #{}, Rest};
|
||||
b_object(String) -> b_object(seek(String), #{}).
|
||||
|
||||
b_object([$} | Rest], Map) ->
|
||||
{ok, Map, Rest};
|
||||
b_object([$" | Rest], Map) ->
|
||||
case string(Rest) of
|
||||
{ok, Key, Remainder} ->
|
||||
b_object_value(seek(Remainder), unicode:characters_to_binary(Key), Map);
|
||||
{error, _, _} ->
|
||||
{error, Map, Rest}
|
||||
end;
|
||||
b_object(Rest, Map) ->
|
||||
{error, Map, Rest}.
|
||||
|
||||
b_object_value([$: | Rest], Key, Map) -> b_object_value_parse(seek(Rest), Key, Map);
|
||||
b_object_value(Rest, Key, Map) -> {error, maps:put(Key, undefined, Map), Rest}.
|
||||
|
||||
b_object_value_parse(String, Key, Map) ->
|
||||
case b_value(String) of
|
||||
{ok, Value, Rest} -> b_object_next(seek(Rest), maps:put(Key, Value, Map));
|
||||
{error, Value, Rest} -> {error, maps:put(Key, Value, Map), Rest};
|
||||
error -> {error, Map, String}
|
||||
end.
|
||||
|
||||
|
||||
b_object_next([$, | Rest], Map) -> b_object(seek(Rest), Map);
|
||||
b_object_next([$} | Rest], Map) -> {ok, Map, seek(Rest)};
|
||||
b_object_next(Rest, Map) -> {error, Map, Rest}.
|
||||
|
||||
|
||||
b_array([$] | Rest]) -> {ok, [], Rest};
|
||||
b_array(String) -> b_array(seek(String), []).
|
||||
|
||||
b_array([$] | Rest], List) ->
|
||||
{ok, lists:reverse(List), seek(Rest)};
|
||||
b_array(String, List) ->
|
||||
case b_value(String) of
|
||||
{ok, Value, Rest} -> b_array_next(seek(Rest), [Value | List]);
|
||||
{error, Value, Rest} -> {error, lists:reverse([Value | List]), Rest};
|
||||
error -> {error, lists:reverse(List), String}
|
||||
end.
|
||||
|
||||
b_array_next([$, | Rest], List) -> b_array(seek(Rest), List);
|
||||
b_array_next([$] | Rest], List) -> {ok, lists:reverse(List), seek(Rest)};
|
||||
b_array_next(Rest, List) -> {error, lists:reverse(List), Rest}.
|
||||
Reference in New Issue
Block a user