mirror of
https://github.com/urbit/shrub.git
synced 2024-11-27 10:26:14 +03:00
Can now |hi to King Haskell over Ames! (and merged Master)
This commit is contained in:
Benjamin Summers
parent
94b5b57faa
commit
6302d5fb90
1
.gitignore
vendored
1
.gitignore
vendored
@ -11,3 +11,4 @@ cross/
|
||||
release/
|
||||
.stack-work
|
||||
\#*\#
|
||||
s/*
|
||||
|
||||
3
.ignore
Normal file
3
.ignore
Normal file
@ -0,0 +1,3 @@
|
||||
.stack-work
|
||||
./pkg/hs-vere/.stack-work
|
||||
./pkg/hs-urbit/.stack-work
|
||||
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:e534cb57dc8b2bee35004d843c7e0b2d028ba699e86d47a58efac4b065ce2f1b
|
||||
size 6047224
|
||||
oid sha256:8f6e93cb3ee5fcb0970851bd10d2d2a640ff968292d147c35385623b86570296
|
||||
size 6662042
|
||||
|
||||
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:96b1f1ad730789b1d557aac66b847047c98341bcf436e1927f40f082a728d641
|
||||
size 3816083
|
||||
oid sha256:0e520b9ab0232d1765e1dacde96a1210845768e7334a334b5705d1c40348c82b
|
||||
size 4464201
|
||||
|
||||
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:e4a4f8f86b18de5e410caeb491eecf8cf4fe24fbaba03ad8183b55a13eee154a
|
||||
size 9108350
|
||||
oid sha256:a4a8e1daf0bfe86d5fc4ef7060b0c6a6c2678a344787926f14bb4b8cfabe8752
|
||||
size 9549390
|
||||
|
||||
@ -48,4 +48,9 @@ rec {
|
||||
pier = zod;
|
||||
};
|
||||
|
||||
ivory = import ./ivory {
|
||||
inherit arvo pkgs tlon deps debug;
|
||||
pier = zod;
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
22
nix/ops/ivory/builder.sh
Executable file
22
nix/ops/ivory/builder.sh
Executable file
@ -0,0 +1,22 @@
|
||||
source $stdenv/setup
|
||||
|
||||
set -ex
|
||||
|
||||
cp -r $PIER ./pier
|
||||
chmod -R u+rw ./pier
|
||||
|
||||
$URBIT -d ./pier
|
||||
|
||||
cleanup () {
|
||||
if [ -e ./pier/.vere.lock ]
|
||||
then kill $(< ./pier/.vere.lock) || true;
|
||||
fi
|
||||
}
|
||||
|
||||
trap cleanup EXIT
|
||||
|
||||
herb ./pier -P ivory.pill -d '+ivory'
|
||||
|
||||
mv ivory.pill $out
|
||||
|
||||
set +x
|
||||
19
nix/ops/ivory/default.nix
Normal file
19
nix/ops/ivory/default.nix
Normal file
@ -0,0 +1,19 @@
|
||||
{ pkgs, tlon, deps, pier, arvo, debug }:
|
||||
|
||||
let
|
||||
|
||||
urbitExe = if debug
|
||||
then "${tlon.urbit-debug}/bin/urbit-debug -g"
|
||||
else "${tlon.urbit}/bin/urbit";
|
||||
|
||||
in
|
||||
|
||||
pkgs.stdenv.mkDerivation rec {
|
||||
name = "ivory";
|
||||
builder = ./builder.sh;
|
||||
buildInputs = [ tlon.herb pkgs.coreutils ];
|
||||
|
||||
URBIT = urbitExe;
|
||||
PIER = pier;
|
||||
ARVO = arvo;
|
||||
}
|
||||
@ -1,6 +1,7 @@
|
||||
{
|
||||
pkgs,
|
||||
debug,
|
||||
ivory ? ../../../bin/ivory.pill,
|
||||
argon2, ed25519, ent, ge-additions, h2o, murmur3, scrypt, secp256k1, sni, softfloat3, uv
|
||||
}:
|
||||
|
||||
@ -30,6 +31,7 @@ pkgs.stdenv.mkDerivation {
|
||||
hardeningDisable = if debug then [ "all" ] else [];
|
||||
|
||||
CFLAGS = if debug then "-O3 -g -Werror" else "-O3 -Werror";
|
||||
IVORY = ivory;
|
||||
MEMORY_DEBUG = debug;
|
||||
CPU_DEBUG = debug;
|
||||
EVENT_TIME_DEBUG = false;
|
||||
|
||||
@ -1,6 +1,12 @@
|
||||
{ env_name, env, deps }:
|
||||
|
||||
{ ent, ge-additions, cacert, xxd, name ? "urbit", debug ? false }:
|
||||
{
|
||||
ent,
|
||||
name ? "urbit",
|
||||
debug ? false,
|
||||
ivory ? ../../../bin/ivory.pill,
|
||||
ge-additions, cacert, xxd
|
||||
}:
|
||||
|
||||
let
|
||||
|
||||
@ -22,6 +28,7 @@ env.make_derivation {
|
||||
EVENT_TIME_DEBUG = false;
|
||||
NCURSES = env.ncurses;
|
||||
SSL_CERT_FILE = "${cacert}/etc/ssl/certs/ca-bundle.crt";
|
||||
IVORY = ivory;
|
||||
|
||||
name = "${name}-${env_name}";
|
||||
exename = name;
|
||||
|
||||
@ -1,37 +0,0 @@
|
||||
{ pkgs ? import ../../nixpkgs.nix }:
|
||||
|
||||
let
|
||||
|
||||
compiler = "default";
|
||||
doBenchmark = false;
|
||||
|
||||
run-hpack =
|
||||
"${pkgs.haskellPackages.hpack}/bin/hpack";
|
||||
|
||||
f = { mkDerivation, stdenv,
|
||||
base, classy-prelude, lens, hpack, megaparsec }:
|
||||
mkDerivation {
|
||||
pname = "uterm";
|
||||
version = "0.1.0.0";
|
||||
src = ../../../pkg/uterm;
|
||||
isLibrary = false;
|
||||
isExecutable = true;
|
||||
executableHaskellDepends = [
|
||||
base classy-prelude lens hpack megaparsec
|
||||
];
|
||||
license = stdenv.lib.licenses.lgpl3;
|
||||
preConfigure = ''
|
||||
${run-hpack}
|
||||
'';
|
||||
};
|
||||
|
||||
haskellPackages = if compiler == "default"
|
||||
then pkgs.haskellPackages
|
||||
else pkgs.haskell.packages.${compiler};
|
||||
|
||||
variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id;
|
||||
drv = variant (haskellPackages.callPackage f {});
|
||||
|
||||
in
|
||||
|
||||
if pkgs.lib.inNixShell then drv.env else drv
|
||||
@ -6,12 +6,19 @@
|
||||
$: url=@ta
|
||||
from-number=number:block
|
||||
==
|
||||
+$ app-state ~
|
||||
+$ app-state
|
||||
$: url=@ta
|
||||
=number:block
|
||||
=pending-udiffs
|
||||
blocks=(list block)
|
||||
==
|
||||
+$ peek-data ~
|
||||
+$ in-poke-data
|
||||
$% [%watch =config]
|
||||
[%clear ~]
|
||||
[%noun *]
|
||||
$: %azimuth-tracker-poke
|
||||
$% [%init ~]
|
||||
[%listen whos=(set ship) =source:kale]
|
||||
[%watch =config]
|
||||
==
|
||||
==
|
||||
+$ out-poke-data ~
|
||||
+$ in-peer-data ~
|
||||
@ -183,40 +190,62 @@
|
||||
==
|
||||
=/ event-logs=(list event-log:rpc:ethereum)
|
||||
(parse-event-logs:rpc:ethereum json)
|
||||
=/ =udiffs:point
|
||||
%+ murn event-logs
|
||||
|= =event-log:rpc:ethereum
|
||||
^- (unit [=ship =udiff:point])
|
||||
?~ mined.event-log
|
||||
~
|
||||
?: removed.u.mined.event-log
|
||||
~& [%removed-log event-log]
|
||||
~
|
||||
=/ =id:block [block-hash block-number]:u.mined.event-log
|
||||
=, azimuth-events:azimuth
|
||||
=, abi:ethereum
|
||||
?: =(broke-continuity i.topics.event-log)
|
||||
=/ who=@ (decode-topics t.topics.event-log ~[%uint])
|
||||
=/ num=@ (decode-results data.event-log ~[%uint])
|
||||
`[who id %rift num]
|
||||
?: =(changed-keys i.topics.event-log)
|
||||
=/ who=@ (decode-topics t.topics.event-log ~[%uint])
|
||||
=+ ^- [enc=octs aut=octs sut=@ud rev=@ud]
|
||||
%+ decode-results data.event-log
|
||||
~[[%bytes-n 32] [%bytes-n 32] %uint %uint]
|
||||
`[who id %keys rev sut (pass-from-eth:azimuth enc aut sut)]
|
||||
?: =(lost-sponsor i.topics.event-log)
|
||||
=+ ^- [who=@ pos=@]
|
||||
(decode-topics t.topics.event-log ~[%uint %uint])
|
||||
`[who id %spon ~]
|
||||
?: =(escape-accepted i.topics.event-log)
|
||||
=+ ^- [who=@ wer=@]
|
||||
(decode-topics t.topics.event-log ~[%uint %uint])
|
||||
`[who id %spon `wer]
|
||||
~& [%bad-topic event-log]
|
||||
~
|
||||
=/ =udiffs:point (event-logs-to-udiffs event-logs)
|
||||
(pure:m udiffs)
|
||||
::
|
||||
++ get-logs-by-range
|
||||
|= [url=@ta =from=number:block =to=number:block]
|
||||
=/ m (async:stdio udiffs:point)
|
||||
^- form:m
|
||||
;< =json bind:m
|
||||
%+ request-rpc url
|
||||
:* `'logs by range'
|
||||
%eth-get-logs
|
||||
`number+from-number
|
||||
`number+to-number
|
||||
~[azimuth:contracts:azimuth]
|
||||
topics
|
||||
==
|
||||
=/ event-logs=(list event-log:rpc:ethereum)
|
||||
(parse-event-logs:rpc:ethereum json)
|
||||
=/ =udiffs:point (event-logs-to-udiffs event-logs)
|
||||
(pure:m udiffs)
|
||||
::
|
||||
++ event-logs-to-udiffs
|
||||
|= event-logs=(list =event-log:rpc:ethereum)
|
||||
^- =udiffs:point
|
||||
%+ murn event-logs
|
||||
|= =event-log:rpc:ethereum
|
||||
^- (unit [=ship =udiff:point])
|
||||
?~ mined.event-log
|
||||
~
|
||||
?: removed.u.mined.event-log
|
||||
~& [%removed-log event-log]
|
||||
~
|
||||
=/ =id:block [block-hash block-number]:u.mined.event-log
|
||||
=, azimuth-events:azimuth
|
||||
=, abi:ethereum
|
||||
?: =(broke-continuity i.topics.event-log)
|
||||
=/ who=@ (decode-topics t.topics.event-log ~[%uint])
|
||||
=/ num=@ (decode-results data.event-log ~[%uint])
|
||||
`[who id %rift num]
|
||||
?: =(changed-keys i.topics.event-log)
|
||||
=/ who=@ (decode-topics t.topics.event-log ~[%uint])
|
||||
=+ ^- [enc=octs aut=octs sut=@ud rev=@ud]
|
||||
%+ decode-results data.event-log
|
||||
~[[%bytes-n 32] [%bytes-n 32] %uint %uint]
|
||||
`[who id %keys rev sut (pass-from-eth:azimuth enc aut sut)]
|
||||
?: =(lost-sponsor i.topics.event-log)
|
||||
=+ ^- [who=@ pos=@]
|
||||
(decode-topics t.topics.event-log ~[%uint %uint])
|
||||
`[who id %spon ~]
|
||||
?: =(escape-accepted i.topics.event-log)
|
||||
=+ ^- [who=@ wer=@]
|
||||
(decode-topics t.topics.event-log ~[%uint %uint])
|
||||
`[who id %spon `wer]
|
||||
~& [%bad-topic event-log]
|
||||
~
|
||||
::
|
||||
++ jael-update
|
||||
|= =udiffs:point
|
||||
=/ m (async:stdio ,~)
|
||||
@ -224,41 +253,86 @@
|
||||
=* loop $
|
||||
?~ udiffs
|
||||
(pure:m ~)
|
||||
~& > [%update block i.udiffs]
|
||||
:: ;< ~ bind:m (send-effect [%vent-update i.udiffs])
|
||||
~& [%sending-event i.udiffs]
|
||||
;< ~ bind:m (send-effect:stdio %new-event /ne i.udiffs)
|
||||
loop(udiffs t.udiffs)
|
||||
--
|
||||
::
|
||||
:: Main loop
|
||||
::
|
||||
=> |%
|
||||
++ watch
|
||||
|= =config
|
||||
=/ m (async:stdio ,~)
|
||||
::
|
||||
:: Subscribe to %sources from kale
|
||||
::
|
||||
++ init
|
||||
|= state=app-state
|
||||
=/ m (async:stdio ,app-state)
|
||||
^- form:m
|
||||
=/ =number:block from-number.config
|
||||
=| =pending-udiffs
|
||||
=| blocks=(list block)
|
||||
|- ^- form:m
|
||||
=* poll-loop $
|
||||
~& [%poll-loop number]
|
||||
;< =latest=block bind:m (get-latest-block url.config)
|
||||
;< ~ bind:m (send-effect:stdio %sources /se ~)
|
||||
(pure:m state)
|
||||
::
|
||||
:: Send %listen to kale
|
||||
::
|
||||
++ listen
|
||||
|= [state=app-state whos=(set ship) =source:kale]
|
||||
=/ m (async:stdio ,app-state)
|
||||
^- form:m
|
||||
;< ~ bind:m (send-effect:stdio %listen /lo whos source)
|
||||
(pure:m state)
|
||||
::
|
||||
:: Take %source from kale
|
||||
::
|
||||
++ take-source
|
||||
|= [state=app-state whos=(set ship) =source:kale]
|
||||
=/ m (async:stdio ,app-state)
|
||||
^- form:m
|
||||
?: ?=(%& -.source)
|
||||
(pure:m state)
|
||||
=/ a-purl=purl:eyre node.p.source
|
||||
=. url.state (crip (en-purl:html a-purl))
|
||||
(watch state url.state launch:contracts:azimuth)
|
||||
::
|
||||
:: Start watching a node
|
||||
::
|
||||
++ watch
|
||||
|= [state=app-state =config]
|
||||
=/ m (async:stdio ,app-state)
|
||||
^- form:m
|
||||
=: url.state url.config
|
||||
number.state from-number.config
|
||||
pending-udiffs.state *pending-udiffs
|
||||
blocks.state *(list block)
|
||||
==
|
||||
(get-updates state)
|
||||
::
|
||||
:: Get updates since last checked
|
||||
::
|
||||
++ get-updates
|
||||
|= state=app-state
|
||||
=/ m (async:stdio ,app-state)
|
||||
^- form:m
|
||||
~& [%get-updates number.state]
|
||||
;< =latest=block bind:m (get-latest-block url.state)
|
||||
;< =new=number:block bind:m (zoom state number.id.latest-block)
|
||||
=. number.state new-number
|
||||
|- ^- form:m
|
||||
=* walk-loop $
|
||||
~& [%walk-loop number]
|
||||
?: (gth number number.id.latest-block)
|
||||
~& [%walk-loop number.state]
|
||||
?: (gth number.state number.id.latest-block)
|
||||
;< now=@da bind:m get-time:stdio
|
||||
;< ~ bind:m (wait:stdio (add now ~s10))
|
||||
poll-loop
|
||||
;< =block bind:m (get-block-by-number url.config number)
|
||||
;< [=new=^pending-udiffs new-blocks=(lest ^block)] bind:m
|
||||
(take-block url.config pending-udiffs block blocks)
|
||||
=: pending-udiffs new-pending-udiffs
|
||||
blocks new-blocks
|
||||
number +(number.id.i.new-blocks)
|
||||
;< ~ bind:m (wait-effect:stdio (add now ~s10))
|
||||
(pure:m state)
|
||||
;< =block bind:m (get-block-by-number url.state number.state)
|
||||
;< [=new=pending-udiffs new-blocks=(lest ^block)] bind:m
|
||||
(take-block url.state pending-udiffs.state block blocks.state)
|
||||
=: pending-udiffs.state new-pending-udiffs
|
||||
blocks.state new-blocks
|
||||
number.state +(number.id.i.new-blocks)
|
||||
==
|
||||
walk-loop
|
||||
::
|
||||
:: Process a block, detecting and handling reorgs
|
||||
::
|
||||
++ take-block
|
||||
|= [url=@ta =a=pending-udiffs =block blocks=(list block)]
|
||||
=/ m (async:stdio ,[pending-udiffs (lest ^block)])
|
||||
@ -274,6 +348,8 @@
|
||||
=. b-pending-udiffs (~(put by b-pending-udiffs) number.id.block new-udiffs)
|
||||
(pure:m b-pending-udiffs block blocks)
|
||||
::
|
||||
:: Release events if they're more than 30 blocks ago
|
||||
::
|
||||
++ release-old-events
|
||||
|= [=pending-udiffs =number:block]
|
||||
=/ m (async:stdio ,^pending-udiffs)
|
||||
@ -283,6 +359,8 @@
|
||||
;< ~ bind:m (jael-update udiffs)
|
||||
(pure:m (~(del by pending-udiffs) rel-number))
|
||||
::
|
||||
:: Reorg detected, so rewind until we're back in sync
|
||||
::
|
||||
++ rewind
|
||||
|= [url=@ta =pending-udiffs =block blocks=(list block)]
|
||||
=/ m (async:stdio ,[^pending-udiffs (lest ^block)])
|
||||
@ -300,11 +378,31 @@
|
||||
=. pending-udiffs (~(del by pending-udiffs) number.id.block)
|
||||
loop(block next-block, blocks t.blocks)
|
||||
::
|
||||
:: Tell subscribers there was a deep reorg
|
||||
::
|
||||
++ disavow
|
||||
|= =block
|
||||
=/ m (async:stdio ,~)
|
||||
^- form:m
|
||||
(jael-update [*ship id.block %disavow ~]~)
|
||||
::
|
||||
:: Zoom forward to near a given block number.
|
||||
::
|
||||
:: Zooming doesn't go forward one block at a time. As a
|
||||
:: consequence, it cannot detect and handle reorgs. Only use it
|
||||
:: at a safe distance -- 500 blocks ago is probably sufficient.
|
||||
::
|
||||
++ zoom
|
||||
|= [state=app-state =latest=number:block]
|
||||
=/ m (async:stdio ,number:block)
|
||||
^- form:m
|
||||
?: (lth latest-number (add number.state 500))
|
||||
(pure:m latest-number)
|
||||
=/ to-number=number:block (sub latest-number 500)
|
||||
;< =udiffs:point bind:m
|
||||
(get-logs-by-range url.state number.state to-number)
|
||||
;< ~ bind:m (jael-update udiffs)
|
||||
(pure:m to-number)
|
||||
--
|
||||
::
|
||||
:: Main
|
||||
@ -316,17 +414,20 @@
|
||||
|= =in-poke-data
|
||||
=/ m tapp-async
|
||||
^- form:m
|
||||
?- -.in-poke-data
|
||||
%noun (watch (config +.in-poke-data))
|
||||
%watch (watch +.in-poke-data)
|
||||
%clear !!
|
||||
?- +<.in-poke-data
|
||||
%init (init state)
|
||||
%listen (listen state +>.in-poke-data)
|
||||
%watch (watch state +>.in-poke-data)
|
||||
==
|
||||
::
|
||||
++ handle-take
|
||||
|= =sign:tapp
|
||||
!!
|
||||
:: ?> ?=(%sources -.sign)
|
||||
:: (handle-poke %watch +.sign)
|
||||
=/ m tapp-async
|
||||
^- form:m
|
||||
?+ -.sign ~|([%strange-sign -.sign] !!)
|
||||
%source (take-source state +.sign)
|
||||
%wake (get-updates state)
|
||||
==
|
||||
::
|
||||
++ handle-peer ~(handle-peer default-tapp bowl state)
|
||||
--
|
||||
|
||||
File diff suppressed because one or more lines are too long
Binary file not shown.
|
Before Width: | Height: | Size: 1.1 KiB After Width: | Height: | Size: 1.7 KiB |
@ -5,7 +5,8 @@
|
||||
<meta charset="utf-8" />
|
||||
<meta name="viewport"
|
||||
content="width=device-width, initial-scale=1, shrink-to-fit=no"/>
|
||||
<link rel="stylesheet" href="/~chat/css/index.css" />
|
||||
<link rel="stylesheet" href="/~chat/css/index.css" />
|
||||
<link rel="icon" type="image/png" href="/~launch/img/Favicon.png">
|
||||
</head>
|
||||
<body>
|
||||
<div id="root" />
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@ -16,6 +16,7 @@
|
||||
$% [%dns-authority =authority]
|
||||
[%dns-bind =ship =target]
|
||||
[%handle-http-request =inbound-request:eyre]
|
||||
[%noun noun=*]
|
||||
==
|
||||
+$ out-poke-data
|
||||
$% [%dns-bind =ship =target]
|
||||
@ -612,6 +613,14 @@
|
||||
:: XX retryable?
|
||||
::
|
||||
?. &(?=(^ rep) =(200 p.u.rep))
|
||||
?: &(?=(^ rep) =(401 p.u.rep))
|
||||
:: XX automate
|
||||
::
|
||||
~& %authentication-failure
|
||||
~& (skim q.u.rep |=((pair @t @t) ?=(%www-authenticate p)))
|
||||
(pure:m ~)
|
||||
::
|
||||
~& [%create-bind-failed rep]
|
||||
(pure:m ~)
|
||||
::
|
||||
=* httr u.rep
|
||||
@ -623,12 +632,7 @@
|
||||
(json-octs u.r.httr parse-record:(provider authority))
|
||||
?~(dat ~. id.u.dat)
|
||||
::
|
||||
=/ =address:dns
|
||||
?>(?=(%direct -.target) +.target)
|
||||
=/ =turf
|
||||
(weld dom.authority /(crip +:(scow %p ship)))
|
||||
;< ~ bind:m (poke-app:stdio collector-app [%dns-complete ship address turf])
|
||||
;< now=@da bind:m get-time:stdio
|
||||
;< now=@da bind:m get-time:stdio
|
||||
=/ =bound
|
||||
[now id target ?~(existing ~ [[wen cur] hit]:u.existing)]
|
||||
(pure:m (some bound))
|
||||
@ -699,6 +703,23 @@
|
||||
?. (team:title [our src]:bowl)
|
||||
~| %bind-yoself !!
|
||||
?- -.in-poke-data
|
||||
%noun
|
||||
?: ?=(%debug noun.in-poke-data)
|
||||
~& bowl
|
||||
:: XX redact secrets
|
||||
::
|
||||
~& state
|
||||
(pure:m state)
|
||||
::
|
||||
:: XX heavy-handed, will duplicate subscriptions
|
||||
:: should track bones
|
||||
::
|
||||
?: ?=(%resubscribe noun.in-poke-data)
|
||||
;< ~ bind:m (peer-app:stdio collector-app /requests)
|
||||
(pure:m state)
|
||||
::
|
||||
~& %poke-unknown
|
||||
(pure:m state)
|
||||
::
|
||||
%dns-authority
|
||||
?. =(~ nem.state)
|
||||
@ -738,6 +759,10 @@
|
||||
?~ new
|
||||
~& [%bind-failed in-poke-data]
|
||||
(pure:m state)
|
||||
=/ =turf
|
||||
(weld dom.aut.nam /(crip +:(scow %p who)))
|
||||
;< ~ bind:m
|
||||
(poke-app:stdio collector-app [%dns-complete who +.tar turf])
|
||||
=. bon.nam (~(put by bon.nam) who u.new)
|
||||
=. nem.state (some nam)
|
||||
::
|
||||
|
||||
@ -8,10 +8,14 @@
|
||||
requested=(map ship address:dns)
|
||||
completed=(map ship binding:dns)
|
||||
==
|
||||
+$ peek-data [%noun (list (pair ship address:dns))]
|
||||
+$ peek-data
|
||||
$% [%requested (list (pair ship address:dns))]
|
||||
[%completed (list (pair ship binding:dns))]
|
||||
==
|
||||
+$ in-poke-data
|
||||
$% [%dns-address =address:dns]
|
||||
[%dns-complete =ship =binding:dns]
|
||||
[%noun noun=*]
|
||||
==
|
||||
+$ out-poke-data
|
||||
$% [%drum-unlink =dock]
|
||||
@ -78,6 +82,15 @@
|
||||
^- (quip move _this)
|
||||
=< abet
|
||||
?- -.in-poke-data
|
||||
%noun
|
||||
?: ?=(%debug noun.in-poke-data)
|
||||
~& bowl
|
||||
~& state
|
||||
this
|
||||
::
|
||||
~& %poke-unknown
|
||||
this
|
||||
::
|
||||
%dns-address
|
||||
=* who src.bowl
|
||||
=* adr address.in-poke-data
|
||||
@ -111,9 +124,10 @@
|
||||
=/ req=(unit address:dns) (~(get by requested.state) who)
|
||||
:: ignore established bindings that don't match requested
|
||||
::
|
||||
?: ?& ?=(^ req)
|
||||
?: ?| ?=(~ req)
|
||||
!=(adr u.req)
|
||||
==
|
||||
~& %unknown-complete
|
||||
this
|
||||
=: requested.state (~(del by requested.state) who)
|
||||
completed.state (~(put by completed.state) who [adr tuf])
|
||||
@ -124,10 +138,12 @@
|
||||
++ peek
|
||||
|= =path
|
||||
^- (unit (unit peek-data))
|
||||
~& path
|
||||
?+ path [~ ~]
|
||||
[%x %requested ~]
|
||||
[~ ~ %noun ~(tap by requested.state)]
|
||||
[~ ~ %requested ~(tap by requested.state)]
|
||||
::
|
||||
[%x %completed ~]
|
||||
[~ ~ %completed ~(tap by completed.state)]
|
||||
==
|
||||
::
|
||||
++ peer
|
||||
@ -149,10 +165,10 @@
|
||||
=. ..this (give-result path %dns-request i.requests)
|
||||
loop(requests t.requests)
|
||||
::
|
||||
=/ who (slaw %p i.path)
|
||||
=/ who=(unit @p) (slaw %p i.path)
|
||||
?~ who
|
||||
~| %invalid-path !!
|
||||
?~ dun=(~(get by completed.state) who)
|
||||
?~ dun=(~(get by completed.state) u.who)
|
||||
this
|
||||
(give-result path %dns-binding u.dun)
|
||||
--
|
||||
|
||||
@ -211,6 +211,9 @@
|
||||
~| [%dns-collector-reserved-address if.adr] !!
|
||||
;< requested=? bind:m (request-by-ip if.adr)
|
||||
:: XX save failure?
|
||||
::
|
||||
~? =(requested.state (some address.in-poke-data))
|
||||
%re-requesting
|
||||
=? requested.state requested
|
||||
(some address.in-poke-data)
|
||||
(pure:m state)
|
||||
|
||||
@ -3293,7 +3293,7 @@
|
||||
|= {t/telegram c/@ud k/(map serial @ud) s/(map circle (list @ud))}
|
||||
:+ +(c) (~(put by k) uid.t c)
|
||||
=/ src/circle
|
||||
?: (~(has by aud.t) [our.bol nom]) [our.bol nom]
|
||||
?: (~(has in aud.t) [our.bol nom]) [our.bol nom]
|
||||
?~ aud.t ~&(%strange-aud [our.bol %inbox])
|
||||
n.aud.t
|
||||
%+ ~(put by s) src
|
||||
|
||||
File diff suppressed because one or more lines are too long
BIN
pkg/arvo/app/launch/img/Favicon.png
Normal file
BIN
pkg/arvo/app/launch/img/Favicon.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2.8 KiB |
@ -7,6 +7,7 @@
|
||||
=name "viewport"
|
||||
=content "width=device-width, initial-scale=1, shrink-to-fit=no";
|
||||
;link(rel "stylesheet", href "/~launch/css/index.css");
|
||||
;link(rel "icon", type "image/png", href "/~launch/img/Favicon.png");
|
||||
==
|
||||
;body
|
||||
;div#root;
|
||||
|
||||
@ -1,18 +0,0 @@
|
||||
|= scripts=marl
|
||||
<!doctype html>
|
||||
<html>
|
||||
<head>
|
||||
<title>Home</title>
|
||||
<meta charset="utf-8" />
|
||||
<meta name="viewport"
|
||||
content="width=device-width, initial-scale=1, shrink-to-fit=no"/>
|
||||
<link rel="stylesheet" href="/~launch/css/index.css" />
|
||||
</head>
|
||||
<body>
|
||||
<div id="root" />
|
||||
<script src="/~/channel/channel.js"></script>
|
||||
<script src="/~modulo/session.js"></script>
|
||||
<script src="/~launch/js/tiles.js"></script>
|
||||
<script src="/~launch/js/index.js"></script>
|
||||
</body>
|
||||
</html>
|
||||
File diff suppressed because one or more lines are too long
@ -348,7 +348,9 @@
|
||||
[~ da-this]
|
||||
=. subs.sat (~(del by subs.sat) who.del col.del)
|
||||
:- ~(tap in ~(key by pos.u.old))
|
||||
(da-emit [ost.bol %pull /collection/[col.del] [who.del %publish] ~])
|
||||
%- da-emil
|
||||
:- [ost.bol %pull /collection/[col.del] [who.del %publish] ~]
|
||||
(affection-primary del)
|
||||
:: iterate through post ids collected before, removing each from
|
||||
:: secondary indices in state
|
||||
::
|
||||
@ -382,7 +384,8 @@
|
||||
=. da-this (da-remove who.del col.del u.pos.del)
|
||||
(da-emil (affection del))
|
||||
=. subs.sat (~(put by subs.sat) [who.del col.del] new)
|
||||
(da-remove who.del col.del u.pos.del)
|
||||
=. da-this (da-remove who.del col.del u.pos.del)
|
||||
(da-emil (affection-primary del))
|
||||
::
|
||||
==
|
||||
::
|
||||
@ -527,6 +530,15 @@
|
||||
|= del=delta
|
||||
^- (quip move _this)
|
||||
da-done:(da-change:da del)
|
||||
:: +affection: rumors to primary
|
||||
::
|
||||
++ affection-primary
|
||||
|= del=delta
|
||||
^- (list move)
|
||||
%+ turn (prey:pubsub:userlib /primary bol)
|
||||
|= [b=bone *]
|
||||
^- move
|
||||
[b %diff %publish-rumor del]
|
||||
:: +affection: rumors to interested
|
||||
::
|
||||
++ affection
|
||||
@ -1023,7 +1035,15 @@
|
||||
%edit-collection
|
||||
?. =(src.bol our.bol)
|
||||
[~ this]
|
||||
[~ this]
|
||||
=/ pax=path /web/publish/[name.act]/publish-info
|
||||
=/ col=(unit collection) (~(get by pubs.sat) name.act)
|
||||
?~ col
|
||||
[~ this]
|
||||
?: ?=(%.n -.dat.col.u.col)
|
||||
[~ this]
|
||||
=/ out=collection-info p.dat.col.u.col(title title.act)
|
||||
:_ this
|
||||
[(write-file pax %publish-info !>(out))]~
|
||||
::
|
||||
%edit-post
|
||||
?. =(who.act our.bol)
|
||||
|
||||
File diff suppressed because one or more lines are too long
@ -9,6 +9,7 @@
|
||||
=name "viewport"
|
||||
=content "width=device-width, initial-scale=1, shrink-to-fit=no";
|
||||
;link(rel "stylesheet", href "/~publish/index.css");
|
||||
;link(rel "icon", type "image/png", href "/~launch/img/Favicon.png");
|
||||
;script@"/~/channel/channel.js";
|
||||
;script@"/~modulo/session.js";
|
||||
;script: window.injectedState = {(en-json:html inject)}
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@ -1391,13 +1391,15 @@
|
||||
::
|
||||
:: prints binding details. goes both ways.
|
||||
::
|
||||
:: XX this type is a misjunction, audience can be ~
|
||||
::
|
||||
|= qur/(unit $@(char audience))
|
||||
^+ ..sh-work
|
||||
?^ qur
|
||||
?^ u.qur
|
||||
=+ cha=(~(get by bound) u.qur)
|
||||
(sh-fact %txt ?~(cha "none" [u.cha]~))
|
||||
=+ pan=~(tap in (~(get ju binds) u.qur))
|
||||
=+ pan=~(tap in (~(get ju binds) `@t`u.qur))
|
||||
?: =(~ pan) (sh-fact %txt "~")
|
||||
=< (sh-fact %mor (turn pan .))
|
||||
|=(a/audience [%txt ~(ar-phat ar a)])
|
||||
|
||||
@ -1,125 +0,0 @@
|
||||
/+ *server
|
||||
/= tile-js
|
||||
/^ octs
|
||||
/; as-octs:mimes:html
|
||||
/: /===/app/timer/js/tile
|
||||
/| /js/
|
||||
/~ ~
|
||||
==
|
||||
/= timer-png
|
||||
/^ (map knot @)
|
||||
/: /===/app/timer/img /_ /png/
|
||||
=, format
|
||||
::
|
||||
|%
|
||||
:: +move: output effect
|
||||
::
|
||||
+$ move [bone card]
|
||||
:: +card: output effect payload
|
||||
::
|
||||
+$ poke
|
||||
$% [%launch-action [@tas path @t]]
|
||||
==
|
||||
::
|
||||
+$ card
|
||||
$% [%poke wire dock poke]
|
||||
[%http-response =http-event:http]
|
||||
[%connect wire binding:eyre term]
|
||||
[%diff %json json]
|
||||
[%wait wire @da]
|
||||
[%rest wire @da]
|
||||
==
|
||||
::
|
||||
--
|
||||
::
|
||||
|_ [bol=bowl:gall tim=@da]
|
||||
::
|
||||
++ this .
|
||||
::
|
||||
++ bound
|
||||
|= [wir=wire success=? binding=binding:eyre]
|
||||
^- (quip move _this)
|
||||
[~ this]
|
||||
::
|
||||
++ prep
|
||||
|= old=(unit tim=@da)
|
||||
^- (quip move _this)
|
||||
=/ launcha [%launch-action [%timer /tile '/~timer/js/tile.js']]
|
||||
:-
|
||||
:~
|
||||
[ost.bol %connect / [~ /'~timer'] %timer]
|
||||
[ost.bol %poke /timer [our.bol %launch] launcha]
|
||||
==
|
||||
?~ old
|
||||
this
|
||||
%= this
|
||||
tim tim.u.old
|
||||
==
|
||||
::
|
||||
++ peer-tile
|
||||
|= pax=path
|
||||
^- (quip move _this)
|
||||
?: =(tim *@da)
|
||||
[[ost.bol %diff %json [%s '']]~ this]
|
||||
[[ost.bol %diff %json [%s (scot %da tim)]]~ this]
|
||||
::
|
||||
++ send-tile-diff
|
||||
|= jon=json
|
||||
^- (list move)
|
||||
%+ turn (prey:pubsub:userlib /tile bol)
|
||||
|= [=bone ^]
|
||||
[bone %diff %json jon]
|
||||
::
|
||||
++ poke-json
|
||||
|= jon=json
|
||||
^- (quip move _this)
|
||||
?. ?=(%s -.jon)
|
||||
[~ this]
|
||||
=/ str/@t +.jon
|
||||
?: =(str 'start')
|
||||
=/ data/@da (add now.bol ~m20)
|
||||
:_ this(tim data)
|
||||
[[ost.bol %wait /timer data] (send-tile-diff [%s (scot %da data)])]
|
||||
?: =(str 'stop')
|
||||
:_ this(tim *@da)
|
||||
[[ost.bol %rest /timer tim] (send-tile-diff [%s ''])]
|
||||
[~ this]
|
||||
::
|
||||
++ poke-handle-http-request
|
||||
%- (require-authorization:app ost.bol move this)
|
||||
|= =inbound-request:eyre
|
||||
^- (quip move _this)
|
||||
=/ request-line (parse-request-line url.request.inbound-request)
|
||||
=/ back-path (flop site.request-line)
|
||||
=/ name=@t
|
||||
=/ back-path (flop site.request-line)
|
||||
?~ back-path
|
||||
''
|
||||
i.back-path
|
||||
::
|
||||
?+ site.request-line
|
||||
[[ost.bol %http-response not-found:app]~ this]
|
||||
::
|
||||
:: tile
|
||||
::
|
||||
[%'~timer' %js %tile ~]
|
||||
[[ost.bol %http-response (js-response:app tile-js)]~ this]
|
||||
::
|
||||
:: images
|
||||
::
|
||||
[%'~timer' %img *]
|
||||
=/ img (as-octs:mimes:html (~(got by timer-png) `@ta`name))
|
||||
:_ this
|
||||
[ost.bol %http-response (png-response:app img)]~
|
||||
==
|
||||
::
|
||||
++ wake
|
||||
|= [wir=wire err=(unit tang)]
|
||||
^- (quip move _this)
|
||||
?~ err
|
||||
:- (send-tile-diff [%s 'alarm'])
|
||||
this(tim *@da)
|
||||
~& err
|
||||
[~ this]
|
||||
::
|
||||
--
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 20 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 15 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 16 KiB |
File diff suppressed because one or more lines are too long
@ -158,12 +158,11 @@
|
||||
?~ err
|
||||
=/ req/request:http (request-darksky location)
|
||||
=/ out *outbound-config:iris
|
||||
=/ lismov/(list move)
|
||||
[ost.bol %request /[(scot %da now.bol)] req out]~
|
||||
?~ timer
|
||||
:- [[ost.bol %wait /timer (add now.bol ~h3)] lismov]
|
||||
this(timer `(add now.bol ~h3))
|
||||
[lismov this]
|
||||
:_ this(timer `(add now.bol ~h3))
|
||||
:~
|
||||
[ost.bol %request /[(scot %da now.bol)] req out]
|
||||
[ost.bol %wait /timer (add now.bol ~h3)]
|
||||
==
|
||||
~& err
|
||||
[~ this]
|
||||
::
|
||||
|
||||
File diff suppressed because one or more lines are too long
3
pkg/arvo/gen/azimuth-tracker/init.hoon
Normal file
3
pkg/arvo/gen/azimuth-tracker/init.hoon
Normal file
@ -0,0 +1,3 @@
|
||||
:- %say
|
||||
|= [* ~ ~]
|
||||
[%azimuth-tracker-poke %init ~]
|
||||
14
pkg/arvo/gen/azimuth-tracker/listen.hoon
Normal file
14
pkg/arvo/gen/azimuth-tracker/listen.hoon
Normal file
@ -0,0 +1,14 @@
|
||||
=> |%
|
||||
+$ src
|
||||
$% [%ship =ship ~]
|
||||
[%node url=@t ~]
|
||||
==
|
||||
--
|
||||
:- %say
|
||||
|= [* [whos=(set ship) =src] ~]
|
||||
=/ =source:kale
|
||||
?- -.src
|
||||
%ship [%& ship.src]
|
||||
%node [%| ~|(%parsing-url (need (de-purl:html url.src))) *@ud *@da]
|
||||
==
|
||||
[%azimuth-tracker-poke %listen whos source]
|
||||
7
pkg/arvo/gen/azimuth-tracker/watch.hoon
Normal file
7
pkg/arvo/gen/azimuth-tracker/watch.hoon
Normal file
@ -0,0 +1,7 @@
|
||||
=> |%
|
||||
+$ config
|
||||
[url=@ta =from=number:block:able:kale]
|
||||
--
|
||||
:- %say
|
||||
|= [* config ~]
|
||||
[%azimuth-tracker-poke %watch config]
|
||||
14
pkg/arvo/gen/dns-collector/complete.hoon
Normal file
14
pkg/arvo/gen/dns-collector/complete.hoon
Normal file
@ -0,0 +1,14 @@
|
||||
:: :dns-collector: manually "complete" (fulfill) requests
|
||||
::
|
||||
:::: /hoon/complete/dns-collector/gen
|
||||
::
|
||||
/- *dns, *sole
|
||||
/+ *generators
|
||||
:- %say
|
||||
|= $: [now=@da eny=@uvJ bec=beak]
|
||||
[who=@p addr=@if =turf ~]
|
||||
~
|
||||
==
|
||||
:- %dns-complete
|
||||
^- [ship binding]
|
||||
[who [%if addr] turf]
|
||||
26
pkg/arvo/gen/reload-event.hoon
Normal file
26
pkg/arvo/gen/reload-event.hoon
Normal file
@ -0,0 +1,26 @@
|
||||
:: Produce a raw event to reload a vane
|
||||
::
|
||||
:: Try: .event/ovo +reload-event %c, then restart urbit with
|
||||
:: -I pier/.urb/put/event.ovo
|
||||
::
|
||||
:- %say
|
||||
|= $: [now=@da eny=@uvJ bek=beak]
|
||||
[[tam=term ~] ~]
|
||||
==
|
||||
:- %ovo
|
||||
=/ top `path`/(scot %p p.bek)/[q.bek]/(scot r.bek)
|
||||
=/ nam
|
||||
=/ van=(list [term ~])
|
||||
:- zus=[%zuse ~]
|
||||
~(tap by dir:.^(arch %cy (welp top /sys/vane)))
|
||||
?. =(1 (met 3 tam))
|
||||
tam
|
||||
=+ ^- zaz=(list [p=knot ~])
|
||||
(skim van |=([a=term ~] =(tam (end 3 1 a))))
|
||||
?> ?=([[@ ~] ~] zaz)
|
||||
`term`p.i.zaz
|
||||
=/ tip (end 3 1 nam)
|
||||
=/ bip ?:(=('z' tip) %$ tip)
|
||||
=/ way ?:(=('z' tip) (welp top /sys/[nam]) (welp top /sys/vane/[nam]))
|
||||
=/ fil .^(@ %cx (welp way /hoon))
|
||||
[//arvo %veer bip way fil]
|
||||
@ -95,7 +95,6 @@
|
||||
[%home %launch]
|
||||
[%home %chat]
|
||||
[%home %publish]
|
||||
[%home %timer]
|
||||
[%home %clock]
|
||||
[%home %weather]
|
||||
==
|
||||
|
||||
@ -251,11 +251,13 @@
|
||||
::
|
||||
=/ old ((soft tapp-state) u.old-state)
|
||||
?~ old
|
||||
~& [%tapp-reset dap.bowl]
|
||||
:: XX may break contracts!
|
||||
:: XX use only for development may break contracts!
|
||||
:: XX if active clam contracts only to abort transaction?
|
||||
::
|
||||
`this-tapp
|
||||
:: ~& [%tapp-reset dap.bowl]
|
||||
:: `this-tapp
|
||||
~| [%tapp-load-incompatible dap.bowl]
|
||||
!!
|
||||
::
|
||||
:: because the clam replaces the active continuation with
|
||||
:: the bunt of its mold, we must fail the transaction
|
||||
@ -410,6 +412,16 @@
|
||||
^- (quip move _this-tapp)
|
||||
(take-async bowl `[wire %bound success binding])
|
||||
::
|
||||
:: Receive source update from kale
|
||||
::
|
||||
++ source
|
||||
|= [=wire whos=(set ship) =source:kale]
|
||||
^- (quip move _this-tapp)
|
||||
=. waiting (~(put to waiting) ost.bowl [%take %source whos source])
|
||||
?^ active
|
||||
`this-tapp
|
||||
start-async
|
||||
::
|
||||
:: Continue computing async
|
||||
::
|
||||
++ take-async
|
||||
|
||||
@ -73,7 +73,10 @@
|
||||
content+so:dejs
|
||||
==
|
||||
::
|
||||
++ delete-collection (of:dejs coll+(su:dejs sym) ~)
|
||||
++ delete-collection
|
||||
%- ot:dejs
|
||||
:~ coll+(su:dejs sym)
|
||||
==
|
||||
::
|
||||
++ delete-post
|
||||
%- ot:dejs
|
||||
@ -92,9 +95,6 @@
|
||||
%- ot:dejs
|
||||
:~ name+(su:dejs sym)
|
||||
title+so:dejs
|
||||
comments+comment-config
|
||||
allow-edit+edit-config
|
||||
perm+perm-config
|
||||
==
|
||||
::
|
||||
++ edit-post
|
||||
|
||||
@ -8,7 +8,7 @@
|
||||
%+ sort ~(val by comments)
|
||||
|= [a=comment:publish b=comment:publish]
|
||||
^- ?
|
||||
(lte date-created.info.a date-created.info.b)
|
||||
(gte date-created.info.a date-created.info.b)
|
||||
::
|
||||
/_ /publish-comment/
|
||||
result
|
||||
|
||||
@ -25,13 +25,7 @@
|
||||
[%delete-post coll=@tas post=@tas]
|
||||
[%delete-comment coll=@tas post=@tas comment=@tas]
|
||||
::
|
||||
$: %edit-collection
|
||||
name=@tas
|
||||
title=@t
|
||||
com=comment-config
|
||||
edit=edit-config
|
||||
perm=perm-config
|
||||
==
|
||||
[%edit-collection name=@tas title=@t]
|
||||
::
|
||||
$: %edit-post
|
||||
who=@p
|
||||
|
||||
@ -15,6 +15,10 @@
|
||||
[%connect wire binding:eyre term]
|
||||
[%http-response =http-event:http]
|
||||
[%rule wire %turf %put turf]
|
||||
[%source wire whos=(set ship) src=source:kale]
|
||||
[%sources wire ~]
|
||||
[%new-event wire =ship =udiff:point:able:kale]
|
||||
[%listen wire whos=(set ship) =source:kale]
|
||||
==
|
||||
::
|
||||
:: Possible async responses
|
||||
@ -26,6 +30,7 @@
|
||||
[%reap =dock =path error=(unit tang)]
|
||||
[%bound success=? =binding:eyre]
|
||||
[%http-response response=client-response:iris]
|
||||
[%source whos=(set ship) =source:kale]
|
||||
==
|
||||
::
|
||||
:: Outstanding contracts
|
||||
|
||||
@ -1,4 +1,3 @@
|
||||
!:
|
||||
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
||||
:::::: :::::: Postface ::::::
|
||||
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
||||
|
||||
@ -1479,13 +1479,13 @@
|
||||
::
|
||||
++ get :: grab value by key
|
||||
~/ %get
|
||||
|= b/*
|
||||
^- {$@(~ {~ u/_?>(?=(^ a) q.n.a)})}
|
||||
=+ 42
|
||||
|* b=*
|
||||
=> .(b `_?>(?=(^ a) p.n.a)`b)
|
||||
|- ^- (unit _?>(?=(^ a) q.n.a))
|
||||
?~ a
|
||||
~
|
||||
?: =(b p.n.a)
|
||||
[~ u=q.n.a]
|
||||
(some q.n.a)
|
||||
?: (gor b p.n.a)
|
||||
$(a l.a)
|
||||
$(a r.a)
|
||||
@ -10400,6 +10400,11 @@
|
||||
{$tsbn *}
|
||||
=+ lem=$(gen p.gen, gol %noun)
|
||||
$(gen q.gen, sut p.lem, dox q.lem)
|
||||
::
|
||||
{$tscm *}
|
||||
=/ boc (busk p.gen)
|
||||
=/ nuf (busk(sut dox) p.gen)
|
||||
$(gen q.gen, sut boc, dox nuf)
|
||||
::
|
||||
{$wtcl *}
|
||||
=+ nor=$(gen p.gen, gol bool)
|
||||
@ -10727,11 +10732,11 @@
|
||||
{$rock *} |- ^- type
|
||||
?@ q.gen [%atom p.gen `q.gen]
|
||||
[%cell $(q.gen -.q.gen) $(q.gen +.q.gen)]
|
||||
{$sand *} |- ^- type
|
||||
?@ q.gen
|
||||
?: =(%n p.gen) ?>(=(0 q.gen) [%atom p.gen ~ q.gen])
|
||||
?:(=(%f p.gen) ?>((lte q.gen 1) bool) [%atom p.gen ~])
|
||||
[%cell $(q.gen -.q.gen) $(q.gen +.q.gen)]
|
||||
{$sand *} ?@ q.gen
|
||||
?: =(%n p.gen) ?>(=(0 q.gen) [%atom p.gen `q.gen])
|
||||
?: =(%f p.gen) ?>((lte q.gen 1) bool)
|
||||
[%atom p.gen ~]
|
||||
$(-.gen %rock)
|
||||
{$tune *} (face p.gen sut)
|
||||
{$dttr *} %noun
|
||||
{$dtts *} bool
|
||||
@ -10746,6 +10751,7 @@
|
||||
{$sgzp *} ~_(duck(sut ^$(gen p.gen)) $(gen q.gen))
|
||||
{$sgbn *} $(gen q.gen)
|
||||
{$tsbn *} $(gen q.gen, sut $(gen p.gen))
|
||||
{$tscm *} $(gen q.gen, sut (busk p.gen))
|
||||
{$wtcl *} =+ [fex=(gain p.gen) wux=(lose p.gen)]
|
||||
%- fork :~
|
||||
?:(=(%void fex) %void $(sut fex, gen q.gen))
|
||||
@ -10754,7 +10760,7 @@
|
||||
{$fits *} bool
|
||||
{$wthx *} bool
|
||||
{$dbug *} ~_((show %o p.gen) $(gen q.gen))
|
||||
{$zpcm *} (play p.gen)
|
||||
{$zpcm *} $(gen p.gen)
|
||||
{$lost *} %void
|
||||
{$zpmc *} (cell $(gen p.gen) $(gen q.gen))
|
||||
{$zpts *} %noun
|
||||
|
||||
@ -2271,7 +2271,7 @@
|
||||
::
|
||||
u.existing
|
||||
::
|
||||
=/ already-heard=? (~(has by fragments.partial-rcv-message) seq)
|
||||
=/ already-heard=? (~(has by fragments.partial-rcv-message) `^fragment-num``@`seq)
|
||||
:: ack dupes except for the last fragment, in which case drop
|
||||
::
|
||||
?: already-heard
|
||||
|
||||
@ -580,8 +580,8 @@
|
||||
[~ ~ %wait ~]
|
||||
?: ?=(%writ +<.sign)
|
||||
=/ uni-rang=rang
|
||||
:- (~(uni by hut.ran) hut.new-rang)
|
||||
(~(uni by lat.ran) lat.new-rang)
|
||||
:- (~(uni by hut.new-rang) hut.ran)
|
||||
(~(uni by lat.new-rang) lat.ran)
|
||||
[~ ~ %done p.sign uni-rang]
|
||||
~| [%expected-writ got=+<.sign]
|
||||
!!
|
||||
@ -1611,7 +1611,10 @@
|
||||
(page-to-lobe:sutil [p q.q]:(~(got by both-patched) pax))
|
||||
[(lobe-to-mark:sutil u.-) u.-]
|
||||
[p q.q]:cay
|
||||
[(~(put by hat) pax p.bol) (~(put by lat) p.bol bol)]
|
||||
:- (~(put by hat) pax p.bol)
|
||||
?: (~(has by lat) p.bol)
|
||||
lat
|
||||
(~(put by lat) p.bol bol)
|
||||
:: ~& old=(~(run by old) mug)
|
||||
:: ~& newdal=(~(run by new.dal) mug)
|
||||
:: ~& newdob=(~(run by new.dob) mug)
|
||||
@ -2047,14 +2050,14 @@
|
||||
(turn ~(tap in lar.nako) |=(=yaki [r.yaki yaki]))
|
||||
:: hut: updated commits by hash
|
||||
::
|
||||
=/ hut (~(gas by hut.ran) nut)
|
||||
=/ hut (~(uni by (malt nut)) hut.ran)
|
||||
:: nat: new blob-hash/blob pairs
|
||||
::
|
||||
=/ nat
|
||||
(turn ~(tap in bar.nako) |=(=blob [p.blob blob]))
|
||||
:: lat: updated blobs by hash
|
||||
::
|
||||
=/ lat (~(gas by lat.ran) nat)
|
||||
=/ lat (~(uni by (malt nat)) lat.ran)
|
||||
:: traverse updated state and sanity check
|
||||
::
|
||||
=+ ~| :* %bad-foreign-update
|
||||
@ -2264,7 +2267,7 @@
|
||||
:: These convert between aeon (version number), tako (commit hash), yaki
|
||||
:: (commit data structure), lobe (content hash), and blob (content).
|
||||
++ aeon-to-tako ~(got by hit.dom)
|
||||
++ aeon-to-yaki (cork aeon-to-tako tako-to-yaki)
|
||||
++ aeon-to-yaki |=(=aeon (tako-to-yaki (aeon-to-tako aeon)))
|
||||
++ lobe-to-blob ~(got by lat.ran)
|
||||
++ tako-to-yaki ~(got by hut.ran)
|
||||
++ lobe-to-mark
|
||||
@ -2396,15 +2399,20 @@
|
||||
::
|
||||
:: Update the object store with new blobs.
|
||||
::
|
||||
:: Must uni the old-lat into the new-lat so that if we recreate
|
||||
:: the same blob hash, we use the old blob not the new one. Else
|
||||
:: you get mutually recurring %delta blobs.
|
||||
::
|
||||
++ add-blobs
|
||||
|= [new-blobs=(map path blob) old-lat=(map lobe blob)]
|
||||
^- (map lobe blob)
|
||||
%- ~(uni by old-lat)
|
||||
%- malt
|
||||
%+ turn
|
||||
~(tap by new-blobs)
|
||||
|= [=path =blob]
|
||||
[p.blob blob]
|
||||
=/ new-lat=(map lobe blob)
|
||||
%- malt
|
||||
%+ turn
|
||||
~(tap by new-blobs)
|
||||
|= [=path =blob]
|
||||
[p.blob blob]
|
||||
(~(uni by new-lat) old-lat)
|
||||
::
|
||||
:: Apply a change list, creating the commit and applying it to
|
||||
:: the current state.
|
||||
@ -3029,8 +3037,8 @@
|
||||
|= [=dome =rang]
|
||||
^+ +>
|
||||
=: dom dome
|
||||
hut.ran (~(uni by hut.ran) hut.rang)
|
||||
lat.ran (~(uni by lat.ran) lat.rang)
|
||||
hut.ran (~(uni by hut.rang) hut.ran)
|
||||
lat.ran (~(uni by lat.rang) lat.ran)
|
||||
==
|
||||
=. +>.$ wake
|
||||
finish-write
|
||||
@ -3070,8 +3078,8 @@
|
||||
^+ +>
|
||||
=. +>.$ (emit [hen %give %mere %& conflicts])
|
||||
=: dom dome
|
||||
hut.ran (~(uni by hut.ran) hut.rang)
|
||||
lat.ran (~(uni by lat.ran) lat.rang)
|
||||
hut.ran (~(uni by hut.rang) hut.ran)
|
||||
lat.ran (~(uni by lat.rang) lat.ran)
|
||||
==
|
||||
=. +>.$ wake
|
||||
finish-write
|
||||
@ -3670,8 +3678,11 @@
|
||||
|%
|
||||
:: These convert between aeon (version number), tako (commit hash), yaki
|
||||
:: (commit data structure), lobe (content hash), and blob (content).
|
||||
::
|
||||
:: XX the following are duplicated from the +state core
|
||||
::
|
||||
++ aeon-to-tako ~(got by hit.dom)
|
||||
++ aeon-to-yaki (cork aeon-to-tako tako-to-yaki)
|
||||
++ aeon-to-yaki |=(=aeon (tako-to-yaki (aeon-to-tako aeon)))
|
||||
++ lobe-to-blob ~(got by lat.ran)
|
||||
++ tako-to-yaki ~(got by hut.ran)
|
||||
++ page-to-lobe page-to-lobe:util
|
||||
@ -4140,10 +4151,17 @@
|
||||
[[[hen %slip %d %flog req] ~] ..^$]
|
||||
::
|
||||
%drop
|
||||
=^ mos ruf
|
||||
=/ den ((de our now ski hen ruf) our des.req)
|
||||
abet:drop-me:den
|
||||
[mos ..^$]
|
||||
?: =(~ act.ruf)
|
||||
~& %clay-idle
|
||||
[~ ..^$]
|
||||
~& :- %clay-cancelling
|
||||
?> ?=(^ act.ruf)
|
||||
[hen -.req -.eval-data]:u.act.ruf
|
||||
=. act.ruf ~
|
||||
?~ cue.ruf
|
||||
[~ ..^$]
|
||||
=/ =duct duct:(need ~(top to cue.ruf))
|
||||
[[duct %pass /queued-request %b %wait now]~ ..^$]
|
||||
::
|
||||
%info
|
||||
?: =(%$ des.req)
|
||||
|
||||
@ -424,7 +424,7 @@
|
||||
;body
|
||||
;div#main
|
||||
;div#inner
|
||||
;h1#topborder:"Modulo"
|
||||
;h1#topborder:"Welcome"
|
||||
;h1:"{(scow %p our)}"
|
||||
;form(action "/~/login", method "post", enctype "application/x-www-form-urlencoded")
|
||||
;input(type "password", name "password", placeholder "passcode", autofocus "true");
|
||||
@ -1042,7 +1042,7 @@
|
||||
%.n
|
||||
:: is this a session that we know about?
|
||||
::
|
||||
?~ session=(~(get by sessions.authentication-state.state) u.session-id)
|
||||
?~ session=(~(get by sessions.authentication-state.state) `@uv`u.session-id)
|
||||
%.n
|
||||
:: is this session still valid?
|
||||
::
|
||||
@ -1382,8 +1382,10 @@
|
||||
=/ channel-wire=path
|
||||
/channel/subscription/[channel-id]/(scot %ud subscription-id.i.requests)
|
||||
::
|
||||
=/ subscriptions
|
||||
subscriptions:(~(got by session.channel-state.state) channel-id)
|
||||
=/ usession (~(get by session.channel-state.state) channel-id)
|
||||
?~ usession
|
||||
$(requests t.requests)
|
||||
=/ subscriptions subscriptions:u.usession
|
||||
::
|
||||
?~ maybe-subscription=(~(get by subscriptions) channel-wire)
|
||||
:: the client sent us a weird request referring to a subscription
|
||||
@ -1567,8 +1569,11 @@
|
||||
|= channel-id=@t
|
||||
^- [(list move) server-state]
|
||||
::
|
||||
=/ session
|
||||
(~(got by session.channel-state.state) channel-id)
|
||||
=/ usession=(unit channel)
|
||||
(~(get by session.channel-state.state) channel-id)
|
||||
?~ usession
|
||||
[~ state]
|
||||
=/ session=channel u.usession
|
||||
::
|
||||
:_ %_ state
|
||||
session.channel-state
|
||||
|
||||
@ -1334,14 +1334,17 @@
|
||||
%keep `%f
|
||||
%kill `%f
|
||||
%look `%j
|
||||
%listen `%k
|
||||
%merg `%c
|
||||
%mint `%j
|
||||
%mont `%c
|
||||
%new-event `%k
|
||||
%nuke `%a
|
||||
%ogre `%c
|
||||
%perm `%c
|
||||
%rest `%b
|
||||
%snap `%j
|
||||
%sources `%k
|
||||
%wait `%b
|
||||
%want `%a
|
||||
%warp `%c
|
||||
|
||||
@ -52,7 +52,7 @@
|
||||
lyf=life :: version
|
||||
jaw=(map life ring) :: private keys
|
||||
== ::
|
||||
$= zim :: ethereum (vent)
|
||||
$= zim :: public
|
||||
$: yen=(jug duct ship) :: trackers
|
||||
ney=(jug ship duct) :: reverse trackers
|
||||
dns=dnses :: on-chain dns state
|
||||
@ -69,7 +69,7 @@
|
||||
+$ message :: message to her kale
|
||||
$% [%nuke whos=(set ship)] :: cancel trackers
|
||||
[%public-keys whos=(set ship)] :: view ethereum events
|
||||
[%public-keys-result who=ship =vent-result] :: tmp workaround
|
||||
[%public-keys-result =public-keys-result] :: tmp workaround
|
||||
== ::
|
||||
+$ card :: i/o action
|
||||
(wind note gift) ::
|
||||
@ -83,7 +83,7 @@
|
||||
$>(%want task:able:ames) :: send message
|
||||
== ::
|
||||
$: %k :: to self
|
||||
$>(%look task) :: set ethereum source
|
||||
$>(%listen task) :: set ethereum source
|
||||
== ::
|
||||
$: @tas ::
|
||||
$% $>(%init vane-task) :: report install
|
||||
@ -246,19 +246,21 @@
|
||||
=. tuf.own.pki turf.tac
|
||||
:: our initial galaxy table as a +map from +life to +public
|
||||
::
|
||||
=/ =udiffs:point
|
||||
=/ diffs=(list [=ship =diff:point])
|
||||
%~ tap by
|
||||
%- ~(run by czar.tac)
|
||||
|=([=life =pass] `udiff:point`[*[@ @] %keys life 1 pass])
|
||||
|= [=a=life =a=pass]
|
||||
^- diff:point
|
||||
[%keys [*life 0 *pass] [a-life 1 a-pass]]
|
||||
=. +>.$
|
||||
|- ^+ +>.^$
|
||||
?~ udiffs
|
||||
?~ diffs
|
||||
+>.^$
|
||||
=. +>.^$
|
||||
%- curd =< abet
|
||||
%- public-keys:~(feel su hen our pki etn sap)
|
||||
[%diff ship udiff]:i.udiffs
|
||||
$(udiffs t.udiffs)
|
||||
[%diff ship diff]:i.diffs
|
||||
$(diffs t.diffs)
|
||||
::
|
||||
=. moz
|
||||
%+ weld moz
|
||||
@ -330,9 +332,10 @@
|
||||
+>.$
|
||||
::
|
||||
:: set ethereum source
|
||||
:: [%look p=(each ship purl)]
|
||||
:: [%listen whos=(set ship) =source]
|
||||
::
|
||||
%look
|
||||
%listen
|
||||
~& [%kale-listen whos source]:tac
|
||||
%- curd =< abet
|
||||
(sources:~(feel su hen our pki etn sap) [whos source]:tac)
|
||||
::
|
||||
@ -385,6 +388,7 @@
|
||||
:: [%sources ~]
|
||||
::
|
||||
%sources
|
||||
~& [%kale-sources]
|
||||
(curd abet:~(sources ~(feed su hen our pki etn sap) hen))
|
||||
::
|
||||
:: XX should be a subscription
|
||||
@ -400,11 +404,12 @@
|
||||
+>.$(moz [[hen %give %turf tuf.own.pki] moz])
|
||||
::
|
||||
:: Update from app
|
||||
:: [%vent-update =vent-result]
|
||||
:: [%new-event =ship =udiff:point]
|
||||
::
|
||||
%vent-update
|
||||
%new-event
|
||||
~& [%kale-new-event ship udiff]:tac
|
||||
%- curd =< abet
|
||||
(public-keys:~(feel su hen our pki etn sap) vent-result.tac)
|
||||
(~(new-event su hen our pki etn sap) ship.tac udiff.tac)
|
||||
::
|
||||
:: learn of kernel upgrade
|
||||
:: [%vega ~]
|
||||
@ -456,11 +461,12 @@
|
||||
$(tac mes)
|
||||
::
|
||||
:: receive keys result
|
||||
:: [%public-keys-result =vent-result]
|
||||
:: [%public-keys-result =public-keys-result]
|
||||
::
|
||||
%public-keys-result
|
||||
=. moz [[hen %give %mack ~] moz]
|
||||
$(tac [%vent-update vent-result.mes])
|
||||
%- curd =< abet
|
||||
(public-keys:~(feel su hen our pki etn sap) public-keys-result.mes)
|
||||
==
|
||||
::
|
||||
:: rewind to snapshot
|
||||
@ -527,8 +533,8 @@
|
||||
:: any subscribers.
|
||||
::
|
||||
=| moz=(list move)
|
||||
=| $: hen/duct
|
||||
our/ship
|
||||
=| $: hen=duct
|
||||
our=ship
|
||||
state-pki
|
||||
state-eth-node
|
||||
state-snapshots
|
||||
@ -556,8 +562,8 @@
|
||||
?~ noy this-su
|
||||
$(noy t.noy, moz [[i.noy cad] moz])
|
||||
::
|
||||
++ vent-give
|
||||
|= [yen=(set duct) =vent-result]
|
||||
++ public-keys-give
|
||||
|= [yen=(set duct) =public-keys-result]
|
||||
=+ yez=~(tap in yen)
|
||||
|- ^+ this-su
|
||||
?~ yez this-su
|
||||
@ -565,10 +571,10 @@
|
||||
=. this-su
|
||||
?. ?=([[%a @ @ *] *] d)
|
||||
%- emit
|
||||
[d %give %public-keys vent-result]
|
||||
[d %give %public-keys public-keys-result]
|
||||
=/ our (slav %p i.t.i.d)
|
||||
=/ who (slav %p i.t.t.i.d)
|
||||
=/ =message [%public-keys-result who vent-result]
|
||||
=/ =message [%public-keys-result public-keys-result]
|
||||
%- emit
|
||||
:^ d
|
||||
%pass
|
||||
@ -600,7 +606,14 @@
|
||||
sources-reverse.etn (~(put by sources-reverse) source top-source-id.etn)
|
||||
==
|
||||
::
|
||||
++ extract-snap :: extract rewind point
|
||||
++ new-event
|
||||
|= [=a=ship =a=udiff:point]
|
||||
^+ this-su
|
||||
=/ a-point=point (~(gut by pos.zim.pki) a-ship *point)
|
||||
=/ a-diff=diff:point (udiff-to-diff:point a-udiff a-point)
|
||||
(public-keys:feel %diff a-ship a-diff)
|
||||
::
|
||||
++ extract-snap :: extract rewind point
|
||||
^- snapshot
|
||||
~
|
||||
:: :: ++feed:su
|
||||
@ -619,7 +632,7 @@
|
||||
?~ whol
|
||||
ney.zim
|
||||
(~(put ju $(whol t.whol)) i.whol hen)
|
||||
=/ =vent-result
|
||||
=/ =public-keys-result
|
||||
:- %full
|
||||
?: =(~ whos)
|
||||
pos.zim
|
||||
@ -637,7 +650,7 @@
|
||||
%+ turn ~(tap in whos)
|
||||
|= who=ship
|
||||
[hen who]
|
||||
=. ..feed (vent-give (sy hen ~) vent-result)
|
||||
=. ..feed (public-keys-give (sy hen ~) public-keys-result)
|
||||
..feed
|
||||
::
|
||||
++ private-keys :: private keys
|
||||
@ -676,13 +689,7 @@
|
||||
^- [who=ship =point]
|
||||
[who [rift=1 life=1 (my [1 1 pass] ~) `(^sein:title who)]]
|
||||
=. moz [[hen %give %public-keys %full (my points)] moz]
|
||||
|- ^+ ..feel
|
||||
?~ passes
|
||||
..feel
|
||||
=. ..feel
|
||||
%- public-keys:feel
|
||||
[%diff who.i.passes *[@ @] %keys 1 1 pass.i.passes]
|
||||
$(passes t.passes)
|
||||
..feel
|
||||
--
|
||||
--
|
||||
:: :: ++feel:su
|
||||
@ -690,49 +697,45 @@
|
||||
|%
|
||||
:: :: ++pubs:feel:su
|
||||
++ public-keys
|
||||
|= =vent-result
|
||||
|= =public-keys-result
|
||||
^+ ..feel
|
||||
?: ?=(%full -.vent-result)
|
||||
=. pos.zim (~(uni by pos.zim) points.vent-result)
|
||||
?: ?=(%full -.public-keys-result)
|
||||
=. pos.zim (~(uni by pos.zim) points.public-keys-result)
|
||||
=/ pointl=(list [who=ship =point])
|
||||
~(tap by points.vent-result)
|
||||
~(tap by points.public-keys-result)
|
||||
|- ^+ ..feel
|
||||
?~ pointl
|
||||
..feel
|
||||
%+ vent-give
|
||||
%+ public-keys-give
|
||||
(~(get ju ney.zim) who.i.pointl)
|
||||
[%full (my i.pointl ~)]
|
||||
=* who who.vent-result
|
||||
=* udiff udiff.vent-result
|
||||
=* who who.public-keys-result
|
||||
=/ a-diff=diff:point diff.public-keys-result
|
||||
=/ maybe-point (~(get by pos.zim) who)
|
||||
=/ =point (fall maybe-point *point)
|
||||
:: XX don't do max etc, just do the thing
|
||||
=. point
|
||||
?- +<.udiff
|
||||
?- -.a-diff
|
||||
%spon
|
||||
point(sponsor sponsor.udiff)
|
||||
point(sponsor to.a-diff)
|
||||
::
|
||||
%rift
|
||||
point(rift (max rift.udiff rift.point))
|
||||
point(rift to.a-diff)
|
||||
::
|
||||
%keys
|
||||
%_ point
|
||||
life (max life.udiff life.point)
|
||||
life life.to.a-diff
|
||||
keys
|
||||
%+ ~(put by keys.point)
|
||||
life.udiff
|
||||
[crypto-suite pass]:udiff
|
||||
life.to.a-diff
|
||||
[crypto-suite pass]:to.a-diff
|
||||
==
|
||||
::
|
||||
%disavow
|
||||
~| %not-implemented !!
|
||||
==
|
||||
=. pos.zim (~(put by pos.zim) who point)
|
||||
%+ vent-give
|
||||
%+ public-keys-give
|
||||
(~(get ju ney.zim) who)
|
||||
?~ maybe-point
|
||||
[%full (my [who point]~)]
|
||||
[%diff who udiff]
|
||||
[%diff who a-diff]
|
||||
:: :: ++vein:feel:su
|
||||
++ private-keys :: kick private keys
|
||||
|= [=life =ring]
|
||||
|
||||
@ -2327,19 +2327,22 @@
|
||||
:: of (list point-diff). Composition of arrows is concatenation,
|
||||
:: and you can apply the diffs to a +point with +apply.
|
||||
::
|
||||
:: It's simplest to consider +point as the product of three
|
||||
:: groupoids, Rift, Keys, and Sponsor. The objects of the product
|
||||
:: are the product of the objects of the underlying groupoids. The
|
||||
:: It's simplest to consider +point as the coproduct of three
|
||||
:: groupoids, Rift, Keys, and Sponsor. Recall that the coproduct
|
||||
:: of monoids is the free monoid (Kleene star) of the coproduct of
|
||||
:: the underlying sets of the monoids. The construction for
|
||||
:: groupoids is similar. Thus, the objects of the coproduct are
|
||||
:: the product of the objects of the underlying groupoids. The
|
||||
:: arrows are a list of a sum of the diff types of the underlying
|
||||
:: groupoids. Given an arrow=(list diff), you can project to the
|
||||
:: underlying arrows with +skim filtering on the head of each
|
||||
:: diff.
|
||||
:: underlying arrows with +skim filtering on the head of each diff.
|
||||
::
|
||||
:: The identity element is ~. Clearly, composing this with any +diff
|
||||
:: gives the original +diff. Since this is a category, +compose must
|
||||
:: be associative (true, because concatenation is associative). This
|
||||
:: is a groupoid, so we must further have that every +point-diff has an
|
||||
:: inverse. These are given by the +inverse operation.
|
||||
:: The identity element is ~. Clearly, composing this with any
|
||||
:: +diff gives the original +diff. Since this is a category,
|
||||
:: +compose must be associative (true, because concatenation is
|
||||
:: associative). This is a groupoid, so we must further have that
|
||||
:: every +point-diff has an inverse. These are given by the
|
||||
:: +inverse operation.
|
||||
::
|
||||
++ point
|
||||
=< point
|
||||
@ -2373,6 +2376,19 @@
|
||||
[%disavow ~]
|
||||
== ==
|
||||
::
|
||||
++ udiff-to-diff
|
||||
|= [=a=udiff =a=point]
|
||||
^- diff
|
||||
?- +<.a-udiff
|
||||
%disavow ~|(%udiff-to-diff-disavow !!)
|
||||
%rift [%rift rift.a-point rift.a-udiff]
|
||||
%spon [%spon sponsor.a-point sponsor.a-udiff]
|
||||
%keys
|
||||
:+ %keys
|
||||
[life.a-point (~(gut by keys.a-point) life.a-point *[@ud pass])]
|
||||
[life crypto-suite pass]:a-udiff
|
||||
==
|
||||
::
|
||||
++ inverse
|
||||
|= diffs=(list diff)
|
||||
^- (list diff)
|
||||
@ -2381,44 +2397,44 @@
|
||||
|= =diff
|
||||
^- ^diff
|
||||
?- -.diff
|
||||
%rift [%rift &2 |2]:diff
|
||||
%keys [%keys &2 |2]:diff
|
||||
%spon [%spon &2 |2]:diff
|
||||
%rift [%rift to from]:diff
|
||||
%keys [%keys to from]:diff
|
||||
%spon [%spon to from]:diff
|
||||
==
|
||||
::
|
||||
++ compose
|
||||
(bake weld ,[(list diff) (list diff)])
|
||||
::
|
||||
++ apply
|
||||
|= [diffs=(list diff) =point]
|
||||
(roll diffs (apply-diff point))
|
||||
|= [diffs=(list diff) =a=point]
|
||||
(roll diffs (apply-diff a-point))
|
||||
::
|
||||
++ apply-diff
|
||||
|= =point
|
||||
|: [*=diff point]
|
||||
^- ^point
|
||||
|= a=point
|
||||
|: [*=diff a-point=a]
|
||||
^- point
|
||||
?- -.diff
|
||||
%rift
|
||||
?> =(rift.point from.diff)
|
||||
point(rift to.diff)
|
||||
?> =(rift.a-point from.diff)
|
||||
a-point(rift to.diff)
|
||||
::
|
||||
%keys
|
||||
?> =(life.point life.from.diff)
|
||||
?> =((~(get by keys.point) life.point) `+.from.diff)
|
||||
%_ point
|
||||
?> =(life.a-point life.from.diff)
|
||||
?> =((~(get by keys.a-point) life.a-point) `+.from.diff)
|
||||
%_ a-point
|
||||
life life.to.diff
|
||||
keys (~(put by keys.point) life.to.diff +.to.diff)
|
||||
keys (~(put by keys.a-point) life.to.diff +.to.diff)
|
||||
==
|
||||
::
|
||||
%spon
|
||||
?> =(sponsor.point from.diff)
|
||||
point(sponsor to.diff)
|
||||
?> =(sponsor.a-point from.diff)
|
||||
a-point(sponsor to.diff)
|
||||
==
|
||||
--
|
||||
::
|
||||
+$ vent-result
|
||||
+$ public-keys-result
|
||||
$% [%full points=(map ship point)]
|
||||
[%diff who=ship =udiff:point]
|
||||
[%diff who=ship =diff:point]
|
||||
==
|
||||
:: ::
|
||||
++ gift :: out result <-$
|
||||
@ -2428,7 +2444,7 @@
|
||||
[%source whos=(set ship) src=source] ::
|
||||
[%turf turf=(list turf)] :: domains
|
||||
[%private-keys =life vein=(map life ring)] :: private keys
|
||||
[%public-keys p=vent-result] :: ethereum changes
|
||||
[%public-keys =public-keys-result] :: ethereum changes
|
||||
== ::
|
||||
:: +seed: private boot parameters
|
||||
::
|
||||
@ -2446,7 +2462,7 @@
|
||||
snap=(unit snapshot) :: head start
|
||||
== ::
|
||||
[%fake =ship] :: fake boot
|
||||
[%look whos=(set ship) =source] :: set ethereum source
|
||||
[%listen whos=(set ship) =source] :: set ethereum source
|
||||
::TODO %next for generating/putting new private key
|
||||
[%nuke whos=(set ship)] :: cancel tracker from
|
||||
[%private-keys ~] :: sub to privates
|
||||
@ -2455,7 +2471,7 @@
|
||||
[%meet =ship =life =pass] :: met after breach
|
||||
[%snap snap=snapshot kick=?] :: load snapshot
|
||||
[%turf ~] :: view domains
|
||||
[%vent-update =vent-result] :: update from app
|
||||
[%new-event =ship =udiff:point] :: update from app
|
||||
$>(%vega vane-task) :: report upgrade
|
||||
$>(%wegh vane-task) :: memory usage request
|
||||
$>(%west vane-task) :: remote request
|
||||
@ -7712,6 +7728,7 @@
|
||||
{$g gift:able:gall}
|
||||
[%i gift:able:iris]
|
||||
{$j gift:able:jael}
|
||||
{$k gift:able:kale}
|
||||
==
|
||||
::
|
||||
+$ unix-task :: input from unix
|
||||
|
||||
@ -2033,7 +2033,7 @@
|
||||
%start
|
||||
:- 200
|
||||
:~ ['content-type' 'text/html']
|
||||
['content-length' '1751']
|
||||
['content-length' '1752']
|
||||
==
|
||||
[~ (login-page:http-server-gate `'/~landscape/inner-path' ~nul)]
|
||||
complete=%.y
|
||||
|
||||
@ -8,5 +8,6 @@ module Arvo
|
||||
import Arvo.Common
|
||||
import Arvo.Effect
|
||||
import Arvo.Event
|
||||
import Noun.Conversions (Lenient)
|
||||
|
||||
type FX = [Ef]
|
||||
type FX = [Lenient Ef]
|
||||
|
||||
@ -120,11 +120,11 @@ deriveNoun ''BehnEf
|
||||
%url -- TODO
|
||||
-}
|
||||
data Blit
|
||||
= Bel
|
||||
| Clr
|
||||
= Bel ()
|
||||
| Clr ()
|
||||
| Hop Word64
|
||||
| Lin [Char]
|
||||
| Mor
|
||||
| Mor ()
|
||||
| Sag Path Noun
|
||||
| Sav Path Atom
|
||||
| Url Cord
|
||||
@ -140,7 +140,7 @@ data Blit
|
||||
-}
|
||||
data TermEf
|
||||
= TermEfBbye Path ()
|
||||
| TermEfBlit Path [Blit]
|
||||
| TermEfBlit (Decimal, ()) [Blit]
|
||||
| TermEfInit (Decimal, ()) ()
|
||||
| TermEfLogo Path ()
|
||||
| TermEfMass Path Noun -- Irrelevant
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
{-# OPTIONS_GHC -Wwarn #-}
|
||||
|
||||
module Vere.Pier (booted, resumed, runPersist, runCompute) where
|
||||
module Vere.Pier (booted, resumed, pier, runPersist, runCompute) where
|
||||
|
||||
import UrbitPrelude
|
||||
|
||||
@ -108,7 +108,7 @@ resumed top flags = do
|
||||
|
||||
pier :: Maybe Port
|
||||
-> (Serf, EventLog, SerfState)
|
||||
-> Acquire Int
|
||||
-> Acquire ()
|
||||
pier mPort (serf, log, ss) = do
|
||||
computeQ <- newTQueueIO :: Acquire (TQueue Ev)
|
||||
persistQ <- newTQueueIO :: Acquire (TQueue (Job, FX))
|
||||
@ -122,12 +122,26 @@ pier mPort (serf, log, ss) = do
|
||||
|
||||
liftIO $ atomically $ for_ bootEvents (writeTQueue computeQ)
|
||||
|
||||
dExe <- startDrivers >>= router (readTQueue executeQ)
|
||||
tExe <- startDrivers >>= router (readTQueue executeQ)
|
||||
tDisk <- runPersist log persistQ (writeTQueue executeQ)
|
||||
tCpu <- runCompute serf ss (readTQueue computeQ) (writeTQueue persistQ)
|
||||
|
||||
undefined [dExe, tDisk, tCpu]
|
||||
-- Wait for something to die.
|
||||
|
||||
let ded = asum [ death "effect thread" tExe
|
||||
, death "persist thread" tDisk
|
||||
, death "compute thread" tCpu
|
||||
]
|
||||
|
||||
atomically ded >>= \case
|
||||
Left (txt, exn) -> print ("Somthing died", txt, exn)
|
||||
Right tag -> print ("something simply exited", tag)
|
||||
|
||||
death :: Text -> Async () -> STM (Either (Text, SomeException) Text)
|
||||
death tag tid = do
|
||||
waitCatchSTM tid <&> \case
|
||||
Left exn -> Left (tag, exn)
|
||||
Right () -> Right tag
|
||||
|
||||
-- Start All Drivers -----------------------------------------------------------
|
||||
|
||||
@ -155,11 +169,11 @@ drivers inst who mPort plan =
|
||||
runDrivers = do
|
||||
dNewt <- runAmes
|
||||
dBehn <- runBehn
|
||||
dAmes <- pure undefined
|
||||
dHttpClient <- pure undefined
|
||||
dHttpServer <- pure undefined
|
||||
dSync <- pure undefined
|
||||
dTerm <- pure undefined
|
||||
dAmes <- pure $ const $ pure ()
|
||||
dHttpClient <- pure $ const $ pure ()
|
||||
dHttpServer <- pure $ const $ pure ()
|
||||
dSync <- pure $ const $ pure ()
|
||||
dTerm <- pure $ const $ pure ()
|
||||
pure (Drivers{..})
|
||||
|
||||
|
||||
@ -170,18 +184,21 @@ router waitFx Drivers{..} = mkAcquire start cancel
|
||||
where
|
||||
start = async $ forever $ do
|
||||
fx <- atomically waitFx
|
||||
for_ fx $ \case
|
||||
EfVega _ _ -> error "TODO"
|
||||
EfExit _ _ -> error "TODO"
|
||||
EfVane (VEAmes ef) -> dAmes ef
|
||||
EfVane (VEBehn ef) -> dBehn ef
|
||||
EfVane (VEBoat ef) -> dSync ef
|
||||
EfVane (VEClay ef) -> dSync ef
|
||||
EfVane (VEHttpClient ef) -> dHttpClient ef
|
||||
EfVane (VEHttpServer ef) -> dHttpServer ef
|
||||
EfVane (VENewt ef) -> dNewt ef
|
||||
EfVane (VESync ef) -> dSync ef
|
||||
EfVane (VETerm ef) -> dTerm ef
|
||||
for_ fx $ \ef -> do
|
||||
putStrLn ("[EFFECT]\n" <> pack (ppShow ef) <> "\n\n")
|
||||
case ef of
|
||||
GoodParse (EfVega _ _) -> error "TODO"
|
||||
GoodParse (EfExit _ _) -> error "TODO"
|
||||
GoodParse (EfVane (VEAmes ef)) -> dAmes ef
|
||||
GoodParse (EfVane (VEBehn ef)) -> dBehn ef
|
||||
GoodParse (EfVane (VEBoat ef)) -> dSync ef
|
||||
GoodParse (EfVane (VEClay ef)) -> dSync ef
|
||||
GoodParse (EfVane (VEHttpClient ef)) -> dHttpClient ef
|
||||
GoodParse (EfVane (VEHttpServer ef)) -> dHttpServer ef
|
||||
GoodParse (EfVane (VENewt ef)) -> dNewt ef
|
||||
GoodParse (EfVane (VESync ef)) -> dSync ef
|
||||
GoodParse (EfVane (VETerm ef)) -> dTerm ef
|
||||
FailParse n -> pPrint n
|
||||
|
||||
|
||||
-- Compute Thread --------------------------------------------------------------
|
||||
@ -194,6 +211,7 @@ runCompute serf ss getEvent putResult =
|
||||
go :: SerfState -> IO ()
|
||||
go ss = do
|
||||
ev <- atomically getEvent
|
||||
putStrLn ("[EVENT]\n" <> pack (ppShow ev) <> "\n\n")
|
||||
wen <- Time.now
|
||||
eId <- pure (ssNextEv ss)
|
||||
mug <- pure (ssLastMug ss)
|
||||
|
||||
@ -61,9 +61,9 @@ compileFlags = foldl' (\acc flag -> setBit acc (fromEnum flag)) 0
|
||||
data Config = Config FilePath [Flag]
|
||||
deriving (Show)
|
||||
|
||||
debug msg = putStrLn ("[DEBUG]\t" <> msg)
|
||||
debug _msg = pure () -- putStrLn ("[DEBUG]\t" <> msg)
|
||||
|
||||
serf msg = putStrLn ("[SERF]\t" <> msg)
|
||||
serf _msg = pure () -- putStrLn ("[SERF]\t" <> msg)
|
||||
|
||||
|
||||
-- Types -----------------------------------------------------------------------
|
||||
|
||||
@ -23,9 +23,6 @@ import qualified Vere.Log as Log
|
||||
import qualified Vere.Pier as Pier
|
||||
import qualified Vere.Serf as Serf
|
||||
|
||||
main = putStrLn ""
|
||||
|
||||
{-
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
zod :: Ship
|
||||
@ -61,6 +58,14 @@ tryBootFromPill pillPath shipPath ship = do
|
||||
shutdown serf 0 >>= print
|
||||
putStrLn "[tryBootFromPill] Booted!"
|
||||
|
||||
runAcquire act = with act pure
|
||||
|
||||
tryPlayShip :: FilePath -> IO ()
|
||||
tryPlayShip shipPath = do
|
||||
runAcquire $ do
|
||||
sls <- Pier.resumed shipPath serfFlags
|
||||
Pier.pier Nothing sls
|
||||
|
||||
tryResume :: FilePath -> IO ()
|
||||
tryResume shipPath = do
|
||||
with (Pier.resumed shipPath serfFlags) $ \(serf, log, ss) -> do
|
||||
@ -151,19 +156,20 @@ collectAllFx top = do
|
||||
main :: IO ()
|
||||
main = runInBoundThread $ do
|
||||
let pillPath = "/home/benjamin/r/urbit/bin/solid.pill"
|
||||
shipPath = "/home/benjamin/r/urbit/zod/"
|
||||
shipPath = "/home/benjamin/r/urbit/s/zod/"
|
||||
ship = zod
|
||||
|
||||
-- collectAllFx "/home/benjamin/r/urbit/testnet-zod/"
|
||||
-- collectAllFx "/home/benjamin/r/urbit/s/testnet-zod/"
|
||||
|
||||
tryParseEvents "/home/benjamin/r/urbit/zod/.urb/log" 1
|
||||
tryParseEvents "/home/benjamin/r/urbit/testnet-zod/.urb/log" 1
|
||||
-- tryParseEvents "/home/benjamin/r/urbit/s/zod/.urb/log" 1
|
||||
-- tryParseEvents "/home/benjamin/r/urbit/s/testnet-zod/.urb/log" 1
|
||||
|
||||
tryParseFX "/home/benjamin/zod-fx" 1 100000000
|
||||
tryParseFX "/home/benjamin/testnet-zod-fx" 1 100000000
|
||||
-- tryParseFX "/home/benjamin/zod-fx" 1 100000000
|
||||
-- tryParseFX "/home/benjamin/testnet-zod-fx" 1 100000000
|
||||
|
||||
-- tryBootFromPill pillPath shipPath ship
|
||||
-- tryResume shipPath
|
||||
tryPlayShip shipPath
|
||||
-- tryFullReplay shipPath
|
||||
|
||||
pure ()
|
||||
@ -213,6 +219,8 @@ tryParseFXStream = loop 0 (mempty :: Set (Text, Noun))
|
||||
-- A _ -> maybe "ERR" unCord (fromNoun n)
|
||||
-- C h _ -> maybe "ERR" unCord (fromNoun h)
|
||||
|
||||
|
||||
{-
|
||||
tryCopyLog :: IO ()
|
||||
tryCopyLog = do
|
||||
let logPath = "/Users/erg/src/urbit/zod/.urb/falselog/"
|
||||
|
||||
1
pkg/urbit/.gitignore
vendored
1
pkg/urbit/.gitignore
vendored
@ -4,6 +4,7 @@
|
||||
/config.mk
|
||||
include/config.h
|
||||
include/ca-bundle.h
|
||||
include/ivory.h
|
||||
#
|
||||
# Build Outputs
|
||||
#
|
||||
|
||||
@ -7,7 +7,7 @@ daemon = $(wildcard daemon/*.c)
|
||||
worker = $(wildcard worker/*.c)
|
||||
|
||||
common = $(jets) $(noun) $(vere)
|
||||
headers = $(shell find include -type f) include/ca-bundle.h
|
||||
headers = $(shell find include -type f) include/ca-bundle.h include/ivory.h
|
||||
|
||||
common_objs = $(shell echo $(common) | sed 's/\.c/.o/g')
|
||||
daemon_objs = $(shell echo $(daemon) | sed 's/\.c/.o/g')
|
||||
@ -27,6 +27,10 @@ ifeq ($(SSL_CERT_FILE),)
|
||||
$(error SSL_CERT_FILE is undefined)
|
||||
endif
|
||||
|
||||
ifeq ($(IVORY),)
|
||||
$(error IVORY is undefined)
|
||||
endif
|
||||
|
||||
################################################################################
|
||||
|
||||
.PHONY: all test clean mkproper
|
||||
@ -44,7 +48,7 @@ clean:
|
||||
rm -f ./tags $(all_objs) $(all_exes)
|
||||
|
||||
mrproper: clean
|
||||
rm -f config.mk include/config.h include/ca-bundle.h
|
||||
rm -f config.mk include/config.h include/ca-bundle.h include/ivory.h
|
||||
|
||||
################################################################################
|
||||
|
||||
@ -54,6 +58,12 @@ include/ca-bundle.h:
|
||||
@xxd -i include/ca-bundle.crt > include/ca-bundle.h
|
||||
@rm include/ca-bundle.crt
|
||||
|
||||
include/ivory.h:
|
||||
@echo XXD -i $(IVORY)
|
||||
@cat $(IVORY) > u3_Ivory.pill
|
||||
@xxd -i u3_Ivory.pill > include/ivory.h
|
||||
@rm u3_Ivory.pill
|
||||
|
||||
build/hashtable_tests: $(common_objs) tests/hashtable_tests.o
|
||||
@echo CC -o $@
|
||||
@mkdir -p ./build
|
||||
|
||||
@ -95,7 +95,7 @@ _main_getopt(c3_i argc, c3_c** argv)
|
||||
u3_Host.ops_u.kno_w = DefaultKernel;
|
||||
|
||||
while ( -1 != (ch_i=getopt(argc, argv,
|
||||
"G:J:B:K:A:H:w:u:e:E:f:F:k:m:p:LjabcCdgqstvxPDRS")) )
|
||||
"G:J:B:K:A:H:I:w:u:e:E:f:F:k:m:p:LjabcCdgqstvxPDRS")) )
|
||||
{
|
||||
switch ( ch_i ) {
|
||||
case 'J': {
|
||||
@ -118,6 +118,10 @@ _main_getopt(c3_i argc, c3_c** argv)
|
||||
u3_Host.ops_u.dns_c = strdup(optarg);
|
||||
break;
|
||||
}
|
||||
case 'I': {
|
||||
u3_Host.ops_u.jin_c = strdup(optarg);
|
||||
break;
|
||||
}
|
||||
case 'e': {
|
||||
u3_Host.ops_u.eth_c = strdup(optarg);
|
||||
break;
|
||||
|
||||
@ -556,6 +556,7 @@
|
||||
c3_c* gen_c; // -G, czar generator
|
||||
c3_o gab; // -g, test garbage collection
|
||||
c3_c* dns_c; // -H, ames bootstrap domain
|
||||
c3_c* jin_c; // -I, inject raw event
|
||||
c3_c* lit_c; // -J, ivory (fastboot) kernel
|
||||
c3_o tra; // -j, json trace
|
||||
c3_w kno_w; // -K, kernel version
|
||||
|
||||
@ -8,6 +8,8 @@
|
||||
#include "all.h"
|
||||
#include "vere/vere.h"
|
||||
|
||||
#include "ivory.h"
|
||||
|
||||
// stash config flags for worker
|
||||
//
|
||||
static c3_w sag_w;
|
||||
@ -873,10 +875,7 @@ u3_daemon_commence()
|
||||
lit = u3m_file(u3_Host.ops_u.lit_c);
|
||||
}
|
||||
else {
|
||||
extern c3_w u3_Ivory_length_w;
|
||||
extern c3_y u3_Ivory_pill_y[];
|
||||
|
||||
lit = u3i_bytes(u3_Ivory_length_w, u3_Ivory_pill_y);
|
||||
lit = u3i_bytes(u3_Ivory_pill_len, u3_Ivory_pill);
|
||||
}
|
||||
|
||||
if ( c3n == u3v_boot_lite(lit)) {
|
||||
|
||||
134397
pkg/urbit/vere/ivory.c
134397
pkg/urbit/vere/ivory.c
File diff suppressed because it is too large
Load Diff
@ -38,7 +38,6 @@
|
||||
static void
|
||||
_newt_consume(u3_moat* mot_u)
|
||||
{
|
||||
fprintf(stderr, "\n_newt_consume\n");
|
||||
/* process stray bytes, trying to create a new message
|
||||
** or add a block to an existing one.
|
||||
*/
|
||||
@ -191,8 +190,6 @@ _newt_consume(u3_moat* mot_u)
|
||||
{
|
||||
u3_noun mat = u3i_bytes((c3_w) len_d, buf_y);
|
||||
|
||||
fprintf(stderr, "\n_newt_consume: poking\n");
|
||||
|
||||
mot_u->pok_f(mot_u->vod_p, mat);
|
||||
}
|
||||
|
||||
|
||||
@ -69,6 +69,7 @@ static void _pier_boot_complete(u3_pier* pir_u);
|
||||
static void _pier_boot_ready(u3_pier* pir_u);
|
||||
static void _pier_boot_set_ship(u3_pier* pir_u, u3_noun who, u3_noun fak);
|
||||
static void _pier_exit_done(u3_pier* pir_u);
|
||||
static void _pier_inject(u3_pier* pir_u, c3_c* pax_c);
|
||||
static void _pier_loop_resume(u3_pier* pir_u);
|
||||
|
||||
/* _pier_db_bail(): bail from disk i/o.
|
||||
@ -1531,6 +1532,12 @@ _pier_boot_complete(u3_pier* pir_u)
|
||||
u3_term_ef_verb();
|
||||
}
|
||||
}
|
||||
|
||||
{
|
||||
if ( 0 != u3_Host.ops_u.jin_c ) {
|
||||
_pier_inject(pir_u, u3_Host.ops_u.jin_c);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _pier_boot_ready():
|
||||
@ -1772,6 +1779,17 @@ _pier_create(c3_w wag_w, c3_c* pax_c)
|
||||
return pir_u;
|
||||
}
|
||||
|
||||
/* _pier_inject(): inject raw event at filename
|
||||
*/
|
||||
static void
|
||||
_pier_inject(u3_pier* pir_u, c3_c* pax_c)
|
||||
{
|
||||
u3_noun ovo = u3ke_cue(u3m_file(pax_c));
|
||||
u3m_p("injecting event", u3h(ovo));
|
||||
u3_pier_work(pir_u, u3k(u3h(ovo)), u3k(u3t(ovo)));
|
||||
u3z(ovo);
|
||||
}
|
||||
|
||||
/* u3_pier_interrupt(): interrupt running process.
|
||||
*/
|
||||
void
|
||||
|
||||
@ -784,11 +784,15 @@ _term_read_cb(uv_stream_t* tcp_u,
|
||||
*/
|
||||
static void
|
||||
_term_try_write_str(u3_utty* uty_u,
|
||||
const c3_c* hun_y)
|
||||
const c3_c* str_c)
|
||||
{
|
||||
// c3_i fid_i = uv_fileno(&uty_u->pop_u);
|
||||
c3_i fid_i = uty_u->pop_u.io_watcher.fd; // XX old libuv
|
||||
_write(fid_i, hun_y, strlen(hun_y));
|
||||
c3_w len_w = strlen(str_c);
|
||||
|
||||
if ( len_w != write(fid_i, str_c, len_w) ) {
|
||||
// ignore, we just tryin
|
||||
}
|
||||
}
|
||||
|
||||
/* _term_try_move_left(): move the cursor left (off-thread).
|
||||
|
||||
@ -363,7 +363,6 @@ _worker_send_complete(u3_noun vir)
|
||||
static void
|
||||
_worker_send_stdr(c3_c* str_c)
|
||||
{
|
||||
fprintf(stderr, "_worker_send_stdr: %s\n", str_c);
|
||||
_worker_send(u3nt(c3__stdr, u3i_chubs(1, &u3V.sen_d), u3i_string(str_c)));
|
||||
}
|
||||
|
||||
@ -682,7 +681,6 @@ _worker_poke_work(c3_d evt_d, // event number
|
||||
u3m_pretty_path(wir), u3m_pretty(cad));
|
||||
|
||||
u3t_event_trace(lab_c, 'B');
|
||||
_worker_send_stdr("WORK SO GOOD. thank for work");
|
||||
_worker_work_live(evt_d, job);
|
||||
u3t_event_trace(lab_c, 'E');
|
||||
}
|
||||
@ -757,8 +755,6 @@ _worker_poke(void* vod_p, u3_noun mat)
|
||||
c3_d evt_d;
|
||||
c3_l mug_l;
|
||||
|
||||
_worker_send_stdr("GOT WORK\n");
|
||||
|
||||
if ( (c3n == u3r_trel(jar, 0, &evt, &jammed_entry)) ||
|
||||
(c3n == u3ud(evt)) ||
|
||||
(1 != u3r_met(6, evt)) )
|
||||
@ -780,8 +776,6 @@ _worker_poke(void* vod_p, u3_noun mat)
|
||||
u3z(entry);
|
||||
u3z(jar);
|
||||
|
||||
_worker_send_stdr("WORK GOOD\n");
|
||||
|
||||
return _worker_poke_work(evt_d, mug_l, job);
|
||||
}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user