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

Compare commits

base: pharpend:60803b4a4ec4e7d6b52373213c3d0d2b220a95a1
Branches Tags
pharpend:master
pharpend:f-qrdemo
pharpend:develop
pharpend:staging
pharpend:0.1.0
..
compare: pharpend:57e7254f8daf58e534dfebb7d74a83e45222938c
Branches Tags
pharpend:f-qrdemo
pharpend:develop
pharpend:staging
pharpend:master
pharpend:0.1.0

No commits in common. "60803b4a4ec4e7d6b52373213c3d0d2b220a95a1" and "57e7254f8daf58e534dfebb7d74a83e45222938c" have entirely different histories.
60803b4a4e ... 57e7254f8d

11 changed files with 819 additions and 808 deletions
Show Stats Expand all files Collapse all files

9
ebin/fewd.app
View File

@ -4,11 +4,10 @@
{included_applications,[]},
{applications,[stdlib,kernel]},
{vsn,"0.2.0"},
{modules,[fd_httpd,fd_httpd_client,fd_httpd_client_man,
{modules,[fd_cache,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]},
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]},
{mod,{fewd,[]}}]}.

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

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

122
src/fd_gridsd.erl
View File

@ -1,122 +0,0 @@
% @doc grids cache
-module(fd_gridsd).
-vsn("0.2.0").
-behavior(gen_server).
-export_type([
]).
-export([
%% caller context
get_url/2,
%% 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 mh_str() :: string().
%% for craig's autism
-record(sp,
{recipient :: string(),
amount :: non_neg_integer(),
payload :: binary()}).
-type search_pattern() :: #sp{}.
-record(s,
{current_gen_height :: pos_integer(),
current_gen_hash :: string(),
current_gen_seen_mb_hashes :: [mh_str()],
past_gen_seen_mb_hashes :: [mh_str()],
looking_for :: [search_pattern()]}).
-type state() :: #s{}.
%%-----------------------------------------------------------------------------
%% caller context
%%-----------------------------------------------------------------------------
-spec get_url(Amount, Payload) -> {ok, URL, QR_PNG} | {error, term()}
when Amount :: none | pos_integer(),
Payload :: none | binary(),
URL :: string(),
QR_PNG :: binary().
get_url(Amount, Payload) ->
gen_server:call(?MODULE, {get_url, 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({get_url, Amount, Payload}, From, State) ->
case i_get_url(Amount, Payload, From, State) of
{ok, URL, PNG, NewState} ->
{reply, {ok, URL, PNG}, NewState};
Error ->
{reply, Error, State}
end;
handle_call(Unexpected, From, State) ->
tell("~tp: unexpected call from ~tp: ~tp", [?MODULE, Unexpected, From]),
{noreply, State}.
handle_cast(Unexpected, State) ->
tell("~tp: unexpected cast: ~tp", [?MODULE, Unexpected]),
{noreply, State}.
handle_info(Unexpected, State) ->
tell("~tp: unexpected info: ~tp", [?MODULE, Unexpected]),
{noreply, State}.
code_change(_, State, _) ->
{ok, State}.
terminate(_, _) ->
ok.
%%-----------------------------------------------------------------------------
%% internals
%%-----------------------------------------------------------------------------
-spec i_get_url(Amount, Payload, From, State) -> Result
when Amount :: none | pos_integer(),
Payload :: none | binary(),
From :: {pid(), reference()},
State :: state(),
URL :: string(),
QR_PNG :: binary().
Result :: {ok, URL, QR_PNG, NewState}
| {error, term()}.
i_get_url(Amount, Payload, From, State) ->
NetworkId = fewd:network_id(),
Pubkey = fewd:pubkey(),
URL = gmgrids:encode({spend, NetworkId, Pubkey},
[{amount, Amount}, {payload, Payload}]),

12
src/fd_httpd_client.erl
View File

@ -348,7 +348,7 @@ wfcin(Sock, #request{enctype = json,
{fd_httpd_utils:jsbad(ErrorMessage), Ctx0}
end,
% update cache with new context
ok = fd_wfcd_cache:set(Cookie, NewCtx),
ok = fd_cache:set(Cookie, NewCtx),
Body = zj:encode(RespObj),
Response = #response{headers = [{"content-type", "application/json"},
{"set-cookie", ["wfc=", Cookie]}],
@ -366,9 +366,17 @@ wfcin(Sock, Request) ->
Context :: wfc_eval_context:context().
ctx(#{<<"wfc">> := Cookie}) ->
case fd_wfcd_cache:query(Cookie) of
case fd_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()}.

14
src/fd_sup.erl
View File

@ -36,23 +36,17 @@ start_link() ->
init([]) ->
RestartStrategy = {one_for_one, 1, 60},
GridsD = {fd_gridsd,
{fd_gridsd, start_link, []},
Cache = {fd_cache,
{fd_cache, start_link, []},
permanent,
5000,
worker,
[fd_gridsd]},
WFCd = {fd_wfcd,
{fd_wfcd, start_link, []},
permanent,
5000,
supervisor,
[fd_wfcd]},
[fd_cache]},
Httpd = {fd_httpd,
{fd_httpd, start_link, []},
permanent,
5000,
supervisor,
[fd_httpd]},
Children = [GridsD, WFCd, Httpd],
Children = [Cache, Httpd],
{ok, {RestartStrategy, Children}}.

33
src/fd_wfcd.erl
View File

@ -1,33 +0,0 @@
-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}}.

105
src/fd_wsp.erl Normal file
View File

@ -0,0 +1,105 @@
% @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
%%-----------------------------------------------------------------------------

14
src/fewd.erl
View File

@ -9,25 +9,12 @@
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
-license("BSD-2-Clause-FreeBSD").
-export([network_id/0, pubkey/0]).
-export([listen/1, ignore/0]).
-export([start/2, stop/1]).
-include("$zx_include/zx_logger.hrl").
network_id() -> "groot.testnet".
pubkey() -> pad32("fewd demo").
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
@ -55,7 +42,6 @@ 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
src/gmgrids.erl
View File

@ -1,618 +0,0 @@
% @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.

694
src/zj.erl Normal file
View File

@ -0,0 +1,694 @@
%%% @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}.

4
zomp.meta
View File

@ -5,9 +5,7 @@
{prefix,"fd"}.
{desc,"Front End Web Dev in Erlang stuff"}.
{package_id,{"otpr","fewd",{0,2,0}}}.
{deps,[{"otpr","hakuzaru",{0,7,0}},
{"otpr","qr",{0,1,0}},
{"otpr","zj",{1,1,2}}]}.
{deps,[]}.
{key_name,none}.
{a_email,"peterharpending@qpq.swiss"}.
{c_email,"peterharpending@qpq.swiss"}.