Can now |hi to King Haskell over Ames! (and merged Master)

This commit is contained in:
Benjamin Summers 2019-07-31 22:16:02 -07:00
parent 94b5b57faa
commit 6302d5fb90
76 changed files with 934 additions and 134878 deletions

1
.gitignore vendored
View File

@ -11,3 +11,4 @@ cross/
release/
.stack-work
\#*\#
s/*

3
.ignore Normal file
View File

@ -0,0 +1,3 @@
.stack-work
./pkg/hs-vere/.stack-work
./pkg/hs-urbit/.stack-work

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:e534cb57dc8b2bee35004d843c7e0b2d028ba699e86d47a58efac4b065ce2f1b
size 6047224
oid sha256:8f6e93cb3ee5fcb0970851bd10d2d2a640ff968292d147c35385623b86570296
size 6662042

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:96b1f1ad730789b1d557aac66b847047c98341bcf436e1927f40f082a728d641
size 3816083
oid sha256:0e520b9ab0232d1765e1dacde96a1210845768e7334a334b5705d1c40348c82b
size 4464201

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:e4a4f8f86b18de5e410caeb491eecf8cf4fe24fbaba03ad8183b55a13eee154a
size 9108350
oid sha256:a4a8e1daf0bfe86d5fc4ef7060b0c6a6c2678a344787926f14bb4b8cfabe8752
size 9549390

View File

@ -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
View 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
View 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;
}

View File

@ -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;

View File

@ -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;

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)
::

View File

@ -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)
--

View File

@ -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)

View File

@ -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

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.8 KiB

View File

@ -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;

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)])

View File

@ -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

View File

@ -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

View File

@ -0,0 +1,3 @@
:- %say
|= [* ~ ~]
[%azimuth-tracker-poke %init ~]

View 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]

View File

@ -0,0 +1,7 @@
=> |%
+$ config
[url=@ta =from=number:block:able:kale]
--
:- %say
|= [* config ~]
[%azimuth-tracker-poke %watch config]

View 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]

View 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]

View File

@ -95,7 +95,6 @@
[%home %launch]
[%home %chat]
[%home %publish]
[%home %timer]
[%home %clock]
[%home %weather]
==

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -1,4 +1,3 @@
!:
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
:::::: :::::: Postface ::::::
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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]

View File

@ -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

View File

@ -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

View File

@ -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]

View File

@ -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

View File

@ -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)

View File

@ -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 -----------------------------------------------------------------------

View File

@ -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/"

View File

@ -4,6 +4,7 @@
/config.mk
include/config.h
include/ca-bundle.h
include/ivory.h
#
# Build Outputs
#

View File

@ -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

View File

@ -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;

View File

@ -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

View File

@ -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)) {

File diff suppressed because it is too large Load Diff

View File

@ -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);
}

View File

@ -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

View File

@ -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).

View File

@ -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);
}

View File

@ -3,8 +3,8 @@
set -e
case $# in
0) ship=zod; target=./zod;;
1) ship=$1; target=./$1;;
0) ship=zod; target=./s/zod;;
1) ship=$1; target=./s/$1;;
2) ship=$1; target=$2;;
*) echo "Usage: $0 [ship] [target-dir]" >&2
exit 1;;