urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-23 19:05:48 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #6948 from urbit/next/kelvin/411

Browse Source 
Release 411k
This commit is contained in:
Pyry Kovanen 2024-03-25 13:53:24 +02:00 committed by GitHub
commit bd776eb47c
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
75 changed files with 90524 additions and 1457 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:feaae0eece54db3e92122263706c283674af581d14ffde8a29fb24e1873a35b1
size 6453015
oid sha256:c2ab6607450382e0ec80c7264dad2c72d69672eaf861eb1c24cde5a76921c6a3
size 9972490

2
flake.nix
View File

@ -3,7 +3,7 @@
flake-utils.url = "github:numtide/flake-utils";
tools = {
flake = false;
url = "github:urbit/tools";
url = "github:urbit/tools/d454e2482c3d4820d37db6d5625a6d40db975864";
};
};

14
nix/test-fake-ship.nix
View File

@ -28,17 +28,6 @@ let
--
'';
testThread = dojoCommand:
pkgs.writeTextFile {
name = "${dojoCommand}.hoon";
text = ''
${poke}
=/ m (strand ,vase)
;< [=ship =desk =case] bind:m get-beak
;< ok=? bind:m (poke [ship %dojo] %lens-command !>([%$ [%dojo '${dojoCommand}'] [%stdout ~]]))
(pure:m !>(ok))
'';
};
appThread = generator: app:
pkgs.writeTextFile {
name = ":${app}|${generator}.hoon";
@ -87,11 +76,12 @@ in pkgs.stdenvNoCC.mkDerivation {
sleep 2
${click} -k -p -i ${testThread "-test %/tests ~"} ./pier
${click} -c ./pier "[0 %fyrd [%base %test %noun %noun 0]]"
${click} -k -p -i ${pokeApp "%agents" "noun" "test"} ./pier
${click} -k -p -i ${pokeApp "%generators" "noun" "test"} ./pier
${click} -k -p -i ${pokeApp "%marks" "noun" "test"} ./pier
${click} -k -p -i ${pokeApp "%threads" "noun" "test"} ./pier
${click} -k -p -i ${appThread "mass" "hood"} ./pier
sleep 2

55
pkg/arvo/app/aqua.hoon
View File

@ -85,7 +85,7 @@
=^ cards state
?+ mark ~|([%aqua-bad-mark mark] !!)
%aqua-events (poke-aqua-events:ac !<((list aqua-event) vase))
%pill (poke-pill:ac !<(pill vase))
%pill (poke-pill:ac !<(pill vase))
%noun (poke-noun:ac !<(* vase))
%azimuth-action (poke-azimuth-action:ac !<(azimuth-action vase))
==
@ -663,34 +663,55 @@
(pe ~bud) :: XX why ~bud? need an example
::
%read
?~ pier=(~(get by ships.piers) from.ae)
(pe from.ae)
?~ pier=(~(get by ships.piers) ship.from.ae)
(pe ship.from.ae)
=/ cash (~(get by namespace.u.pier) path.ae)
|-
?^ cash
?: (gth num.ae (lent u.cash))
(pe from.ae)
(pe ship.from.ae)
::TODO depends on /ted/aqua/ames behavior in a weird indirect way
=/ for=@p `@`(tail for.ae) ::NOTE moons & comets not supported
=; task=task-arvo
^$(ae [%event for /a/aqua/fine-response task], thus this)
:+ %hear `lane:ames`[%| `@`from.ae]
=/ for=@p `@`(tail lane.for.ae) ::NOTE moons & comets not supported
%- push-events:(pe for)
%- flop =< events
%+ roll u.cash
|= [=yowl:ames i=@ud events=(list unix-event)]
:- +(i)
:_ events
:- /a/aqua/fine-response/[(scot %ud i)]
^- task-arvo
:+ %hear `lane:ames`[%| `@`ship.from.ae]
^- blob:ames
=/ =shot:ames
::NOTE dec is important! so dumb!!
(sift-shot:ames `@`(snag (dec num.ae) u.cash))
::TODO runtime needs to update rcvr field also
::NOTE rcvr life is allowed to be wrong
(etch-shot:ames shot(sndr from.ae, rcvr for))
%- etch-shot:ames
:* [sndr=ship.from.ae rcvr=for]
req=| sam=|
sndr-tick=life.from.ae
rcvr-tick=life.for.ae
origin=~
content=`@ux`yowl
==
::
=/ pacs=(unit (list yowl:ames))
=/ =path [%fine %hunk (scot %ud num.ae) '512' path.ae]
%+ biff
(peek-once:(pe from.ae) %ax %$ [%fine %message path.ae])
(peek-once:(pe ship.from.ae) %ax %$ path)
(soft (list yowl:ames))
?~ pacs (pe from.ae)
?~ pacs (pe ship.from.ae)
=. u.pacs
:: add request to each response packet payload
::
=+ pat=(spat path.ae)
=+ wid=(met 3 pat)
%- flop =< blobs
%+ roll u.pacs
|= [=yowl:ames num=_1 blobs=(list @ux)]
:- +(num)
:_ blobs
(can 3 4^num 2^wid wid^`@`pat (met 3 yowl)^yowl ~)
=. namespace.u.pier
(~(put by namespace.u.pier) path.ae u.pacs)
=. ships.piers
(~(put by ships.piers) from.ae u.pier)
(~(put by ships.piers) ship.from.ae u.pier)
$(cash pacs, thus this)
::
%event

34
pkg/arvo/app/dbug.hoon
View File

@ -628,6 +628,8 @@
:: duct: ['/paths', ...],
:: message-num: 123
:: }, ...],
:: closing: [bone, ..., bone],
:: corked: [bone, ..., bone],
:: heeds: [['/paths', ...] ...]
:: scries:
:: -> { =path
@ -706,8 +708,8 @@
|^ =/ mix=(list flow)
=- (sort - dor)
%+ welp
(turn ~(tap by snd) (tack %snd))
(turn ~(tap by rcv) (tack %rcv))
(turn ~(tap by snd) (tack %snd closing corked))
(turn ~(tap by rcv) (tack %rcv closing corked))
=/ [forward=(list flow) backward=(list flow)]
%+ skid mix
|= [=bone *]
@ -719,6 +721,8 @@
::
+$ flow
$: =bone
closing=?
corked=?
::
$= state
$% [%snd message-pump-state]
@ -727,17 +731,17 @@
==
::
++ tack
|* =term
|* [=term closing=(set bone) corked=(set bone)]
|* [=bone =noun]
[bone [term noun]]
[bone (~(has in closing) bone) (~(has in corked) bone) [term noun]]
::
++ build
|= flow
^- json
%+ frond -.state
?- -.state
%snd (snd-with-bone ossuary bone +.state)
%rcv (rcv-with-bone ossuary bone +.state)
%snd (snd-with-bone ossuary bone closing corked +.state)
%rcv (rcv-with-bone ossuary bone closing corked +.state)
==
--
::
@ -749,6 +753,10 @@
:* 'message-num'^(numb message-num)
(bone-to-pairs bone ossuary)
==
::
'closing'^(set-array closing numb)
::
'corked'^(set-array corked numb)
::
'heeds'^(set-array heeds from-duct)
::
@ -756,14 +764,16 @@
==
::
++ snd-with-bone
|= [=ossuary =bone message-pump-state]
|= [=ossuary =bone closing=? corked=? message-pump-state]
^- json
%- pairs
:* 'current'^(numb current)
:* 'closing'^b+closing
'corked'^b+corked
'current'^(numb current)
'next'^(numb next)
::
:- 'unsent-messages' :: as byte sizes
(set-array unsent-messages (cork (cury met 3) numb))
(set-array unsent-messages (cork jam (cork (cury met 3) numb)))
::
'unsent-fragments'^(numb (lent unsent-fragments)) :: as lent
::
@ -811,10 +821,12 @@
==
::
++ rcv-with-bone
|= [=ossuary =bone message-sink-state]
|= [=ossuary =bone closing=? corked=? message-sink-state]
^- json
%- pairs
:* 'last-acked'^(numb last-acked)
:* 'closing'^b+closing
'corked'^b+corked
'last-acked'^(numb last-acked)
'last-heard'^(numb last-heard)
::
:- 'pending-vane-ack'

67581
pkg/arvo/app/debug/js/index.js
View File

File diff suppressed because one or more lines are too long

19367
pkg/arvo/app/debug/js/tile.js
View File

File diff suppressed because one or more lines are too long

6
pkg/arvo/app/dojo.hoon
View File

@ -807,7 +807,7 @@
::
++ dy-run-generator
!.
|= [cay=cage cig=dojo-config]
|= [cay=cage cig=dojo-config =desk]
^+ +>+>
?. (~(nest ut [%cell [%atom %$ ~] %noun]) | p.q.cay)
:: naked generator; takes one argument
@ -850,7 +850,7 @@
|. ^- vase
=/ gat=vase (slot 3 q.cay)
=/ som=vase (slot 6 gat)
=/ ven=vase !>([now=now.hid eny=eny.hid bec=he-beak])
=/ ven=vase !>([now=now.hid eny=eny.hid bec=he-beak(q.dir desk)])
=/ poz=vase (dy-sore p.cig)
=/ kev=vase
=/ kuv=(unit vase) (slew 7 som)
@ -990,7 +990,7 @@
%te (dy-wool-poke p.bil q.bil)
%ex (dy-mere p.bil)
%dv (dy-sing hand+q.bil %a p.bil (snoc q.bil %hoon))
%ge (dy-run-generator (dy-cage p.p.p.bil) q.p.bil)
%ge (dy-run-generator (dy-cage p.p.p.bil) q.p.bil desk.q.p.p.bil)
%sa
=/ has-mark .?((get-fit:clay he-beak %mar p.bil))
?. has-mark

5
pkg/arvo/app/hood.hoon
View File

@ -2,8 +2,8 @@
/+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|%
+$ state
$~ [%26 *state:drum *state:helm *state:kiln]
$>(%26 any-state)
$~ [%27 *state:drum *state:helm *state:kiln]
$>(%27 any-state)
::
+$ any-state
$% [ver=?(%1 %2 %3 %4 %5 %6) lac=(map @tas fin-any-state)]
@ -27,6 +27,7 @@
[%24 drum=state-4:drum helm=state-2:helm kiln=state-10:kiln]
[%25 drum=state-5:drum helm=state-2:helm kiln=state-10:kiln]
[%26 drum=state-6:drum helm=state-2:helm kiln=state-10:kiln]
[%27 drum=state-6:drum helm=state-2:helm kiln=state-11:kiln]
==
+$ any-state-tuple
$: drum=any-state:drum

411
pkg/arvo/app/ping.hoon
View File

@ -20,257 +20,42 @@
::
++ nat-timeout ~s25
::
:: How often to check our IP when we know we're not behind a NAT.
::
++ ip-timeout ~m5
::
:: Chosen because it's run by Cloudflare, and others I tried were
:: inconsistently slow.
::
++ ip-reflector 'https://icanhazip.com'
::
+$ card card:agent:gall
+$ ship-state
$% [%idle ~]
[%poking ~]
[%http until=@da]
[%waiting until=@da]
==
+$ state-1
$: %1
ships=(set ship)
nonce=@ud
$= plan
$~ [%nat ~]
$% [%nat ~]
[%pub ip=(unit @t)]
==
::
+$ state-3
$: %3
mode=?(%formal %informal)
pokes=@ud
timer=(unit [=wire date=@da])
galaxy=@p
==
--
::
%- agent:dbug
::
=| state=state-1
=| state=state-3
=> |%
:: Bind for the the writer monad on (quip effect state)
::
++ rind
|* [effect=mold state=*]
|* state-type=mold
|= $: m-b=(quip effect state-type)
fun=$-(state-type (quip effect state-type))
==
^- (quip effect state-type)
=^ effects-1=(list effect) state m-b
=^ effects-2=(list effect) state (fun state)
[(weld effects-1 effects-2) state]
::
++ once
|= =cord
=(cord (scot %uw nonce.state))
::
:: Subsystem to keep track of which ships to ping across breaches
:: and sponsorship changes
::
++ ships
|%
++ rind (^rind card state)
++ kick
|= [our=@p now=@da]
^- (quip card _state)
:: ?: =(%czar (clan:title our))
:: `state
::
:: NB: !! This includes our own ship, and for moons, this is
:: what has caused Jael to fetch our own rift from our parent.
:: This role may be taken by Ames's subscription to
:: %public-keys, but this must be tested before changing the
:: behavior here.
::
=/ new-ships (~(gas in *(set ship)) (saxo:title our now our))
=/ removed (~(dif in ships.state) new-ships)
=/ added (~(dif in new-ships) ships.state)
;< new-state=_state rind
?~ removed `state
[[%pass /jael %arvo %j %nuke removed]~ state]
=. state new-state
::
;< new-state=_state rind
?~ added `state
[[%pass /jael %arvo %j %public-keys added]~ state]
=. state new-state
::
:: Kick even if ships weren't added or removed
::
(kick-pings our now new-ships)
::
:: Kick whenever we get a response. We really care about
:: breaches and sponsorship changes.
::
:: Delay until next event in case of breach, so that ames can
:: clear its state.
::
++ take-jael
|= now=@da
^- (quip card _state)
[[%pass /jael/delay %arvo %b %wait now]~ state]
::
++ take-delay kick
--
::
:: Starts pinging a new set of `ships`.
::
++ kick-pings
|= [our=@p now=@da ships=(set ship)]
^- (quip card _state)
=: nonce.state +(nonce.state)
ships.state ships
==
::
?: ?=(%nat -.plan.state)
(kick:nat our)
(kick:pub our now)
::
:: Subsystem for pinging our sponsors when we might be behind a NAT
::
:: Ping each ship every 25 seconds to keep the pinhole open.
:: This is expensive, but if you don't do it and you are behind a
:: NAT, you will stop receiving packets from other ships except
:: during the 30 seconds following each packet you send.
::
++ nat
?> ?=(%nat -.plan.state)
|%
++ rind (^rind card state)
++ kick
|= our=@p
^- (quip card _state)
=/ ships ~(tap in ships.state)
|- ^- (quip card _state)
?~ ships `state
?: =(our i.ships) $(ships t.ships)
;< new-state=_state rind (send-ping i.ships)
=. state new-state
$(ships t.ships)
::
++ send-ping
|= =ship
^- (quip card _state)
:_ state
=/ wire /nat/(scot %uw nonce.state)/ping/(scot %p ship)
[%pass wire %agent [ship %ping] %poke %noun !>(~)]~
::
++ take-ping
|= [now=@da =wire error=(unit tang)]
^- (quip card _state)
?. ?=([%nat @ %ping @ ~] wire) `state
?. (once i.t.wire) `state
=/ ship (slav %p i.t.t.t.wire)
%- (slog ?~(error ~ ['ping: got nack' >ship< u.error]))
:_ state
=/ wire /nat/(scot %uw nonce.state)/wait/(scot %p ship)
[%pass wire %arvo %b %wait (add nat-timeout now)]~
::
++ take-wait
|= =wire
^- (quip card _state)
?. ?=([%nat @ %wait @ ~] wire) `state
?. (once i.t.wire) `state
=/ ship (slav %p i.t.t.t.wire)
(send-ping ship)
--
::
:: Subsystem for pinging our sponsors when we know we're not behind a NAT
::
:: Check our IP address every minute, and only if it changes,
:: ping all our sponsors.
::
++ pub
?> ?=(%pub -.plan.state)
|%
++ rind (^rind card state)
++ kick
|= [our=@p now=@da]
^- (quip card _state)
;< new-state=_state rind (send-pings our)
=. state new-state
::
;< new-state=_state rind check-ip
=. state new-state
::
(set-timer now)
::
++ send-pings
|= our=@p
^- (quip card _state)
:_ state
%+ murn ~(tap in ships.state)
|= =ship
?: =(our ship)
~
=/ wire /pub/(scot %uw nonce.state)/ping/(scot %p ship)
`u=[%pass wire %agent [ship %ping] %poke %noun !>(~)]
::
++ take-pings
|= [=wire error=(unit tang)]
^- (quip card _state)
?. ?=([%pub @ %ping @ ~] wire) `state
?. (once i.t.wire) `state
=/ ship (slav %p i.t.t.t.wire)
%- (slog ?~(error ~ ['ping: got nack' >ship< u.error]))
`state
::
++ check-ip
^- (quip card _state)
:_ state
=/ wire /pub/(scot %uw nonce.state)/ip
=/ =request:http [%'GET' ip-reflector ~ ~]
[%pass wire %arvo %i %request request *outbound-config:iris]~
::
++ take-ip
|= [our=@p =wire resp=client-response:iris]
^- (quip card _state)
?. ?=([%pub @ %ip ~] wire) `state
?. (once i.t.wire) `state
::
?. ?=(%finished -.resp) `state :: will retry in a minute
?. ?=(%200 status-code.response-header.resp)
=* s status-code.response-header.resp
%- (slog leaf+"ping: ip check failed: {<s>}" ~)
`state
::
?~ full-file.resp
%- (slog 'ping: ip check body empty' ~)
`state
::
=* body q.data.u.full-file.resp
?~ body
%- (slog 'ping: ip check body empty' ~)
`state
::
=/ ip (end [3 (dec (met 3 body))] body)
?: =(ip.plan.state `ip) `state
::
=. ip.plan.state `ip
(send-pings our)
::
++ set-timer
|= now=@da
^- (quip card _state)
=/ =wire /pub/(scot %uw nonce.state)/wait
[[%pass wire %arvo %b %wait (add ip-timeout now)]~ state]
::
++ take-wait
|= [our=@p now=@da =wire]
^- (quip card _state)
?. ?=([%pub @ %wait ~] wire) `state
?. (once i.t.wire) `state
;< new-state=_state rind check-ip
=. state new-state
::
(set-timer now)
--
--
++ galaxy-for
|= [=ship =bowl:gall]
^- @p
=/ next (sein:title our.bowl now.bowl ship)
?: ?=(%czar (clan:title next))
next
$(ship next)
::
++ wait-card
|= [=wire now=@da]
^- card
[%pass wire %arvo %b %wait (add nat-timeout now)]
::
++ ping
|= [=ship force=?]
^- (quip card _state)
?: &(!force (gth pokes.state 0) =(ship galaxy.state))
[~ state]
:_ state(pokes +(pokes.state), galaxy ship)
[%pass /ping %agent [ship %ping] %poke %noun !>(~)]~
--
%+ verb |
^- agent:gall
|_ =bowl:gall
@ -281,28 +66,73 @@
::
++ on-init
^- [(list card) _this]
=. plan.state [%nat ~]
=^ cards state (kick:ships our.bowl now.bowl)
[cards this]
=. mode.state %formal
=. pokes.state 0
=. galaxy.state (galaxy-for our.bowl bowl)
[~ this]
::
++ on-save !>(state)
++ on-load
|= old-vase=vase
|^
=/ old !<(state-any old-vase)
=? old ?=(%0 -.old) (state-0-to-1 old)
?> ?=(%1 -.old)
=? old ?=(%1 -.old) (state-1-to-2 old)
=? old ?=(%2 -.old) (state-2-to-3 old)
?> ?=(%3 -.old)
=. state old
=^ cards state (kick:ships our.bowl now.bowl)
[cards this]
[~ this]
::
+$ state-any $%(state-0 state-1)
+$ state-0 [%0 ships=(map ship [=rift =ship-state])]
+$ ship-state
$% [%idle ~]
[%poking ~]
[%http until=@da]
[%waiting until=@da]
==
+$ state-any $%(state-0 state-1 state-2 state-3)
+$ state-0 [%0 ships=(map ship [=rift =ship-state])]
+$ state-1
$: %1
ships=(set ship)
nonce=@ud
$= plan
$~ [%nat ~]
$% [%nat ~]
[%pub ip=(unit @t)]
== ==
+$ state-2
$: %2
ships=(set ship)
nonce=@ud
$= plan
$~ [%nat ~]
$% [%nat ~]
[%pub ip=(unit @t)]
[%off ~]
[%one ~]
==
==
::
++ state-0-to-1
|= old=state-0
^- state-1
[%1 ~ 0 %nat ~]
::
++ state-1-to-2
|= old=state-1
^- state-2
old(- %2)
::
++ state-2-to-3
|= old=state-2
^- state-3
:* %3 %formal 0 ~
=/ galaxy=(list @p)
%+ skim ~(tap in ships.old)
|=(p=@p ?=(%czar (clan:title p)))
?: =(1 (lent galaxy))
-.galaxy
(head (flop (^saxo:title our.bowl)))
==
--
:: +on-poke: positively acknowledge pokes
::
@ -312,19 +142,17 @@
`this
::
=^ cards state
?: =(q.vase %kick) :: NB: ames calls this on %born
(kick:ships our.bowl now.bowl)
?: =(q.vase %nat)
=. plan.state [%nat ~]
(kick:ships our.bowl now.bowl)
?: =(q.vase %no-nat)
=. plan.state [%pub ~]
(kick:ships our.bowl now.bowl)
?: ?=([%kick ?] q.vase)
=? mode.state =(+.q.vase %.y)
%formal
(ping (galaxy-for our.bowl bowl) %.n)
::
?: |(=(q.vase %once) =(q.vase %stop)) :: NB: ames calls this on %once
=. mode.state %informal
(ping (galaxy-for our.bowl bowl) %.y)
`state
[cards this]
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek
|= =path
^- (unit (unit cage))
@ -334,19 +162,18 @@
++ on-agent
|= [=wire =sign:agent:gall]
^- [(list card) _this]
=^ cards state
?+ wire `state
[%nat *]
?. ?=(%nat -.plan.state) `state
?. ?=(%poke-ack -.sign) `state
(take-ping:nat now.bowl wire p.sign)
::
[%pub *]
?. ?=(%pub -.plan.state) `state
?. ?=(%poke-ack -.sign) `state
(take-pings:pub wire p.sign)
==
[cards this]
?. ?=([%ping *] wire)
`this
?. ?=(%poke-ack -.sign)
`this
=. pokes.state (dec pokes.state)
?. =(pokes.state 0)
`this
?. |(?=(%formal mode.state) ?=(^ p.sign))
`this
=/ wir /wait
=. timer.state `[wir now.bowl]
[[(wait-card wir now.bowl)]~ this]
:: +on-arvo: handle timer firing
::
++ on-arvo
@ -354,36 +181,20 @@
^- [(list card) _this]
=^ cards state
?+ wire `state
[%jael %delay ~]
[%wait *]
?. ?=(%formal mode.state) `state
?> ?=(%wake +<.sign-arvo)
?^ error.sign-arvo
%- (slog 'ping: strange jael wake fail!' u.error.sign-arvo)
%- (slog 'ping: strange wake fail!' u.error.sign-arvo)
`state
(take-delay:ships our.bowl now.bowl)
=. timer.state ~
(ping (galaxy-for our.bowl bowl) %.n)
::
[%jael ~]
?> ?=(%public-keys +<.sign-arvo)
(take-jael:ships now.bowl)
::
[%nat *]
?. ?=(%nat -.plan.state) `state
?> ?=(%wake +<.sign-arvo)
?^ error.sign-arvo
%- (slog 'ping: strange nat wake fail!' u.error.sign-arvo)
`state
(take-wait:nat wire)
::
[%pub @ %ip *]
?. ?=(%pub -.plan.state) `state
?> ?=(%http-response +<.sign-arvo)
(take-ip:pub our.bowl wire client-response.sign-arvo)
::
[%pub @ %wait *]
?. ?=(%pub -.plan.state) `state
?> ?=(%wake +<.sign-arvo)
(take-wait:pub our.bowl now.bowl wire)
==
[cards this]
::
++ on-save !>(state)
++ on-fail on-fail:def
++ on-watch on-watch:def
++ on-leave on-leave:def
--

5
pkg/arvo/app/spider.hoon
View File

@ -490,8 +490,9 @@
^- [(list card) _state]
%+ roll cards.r
|= [=card cards=(list card) s=_state]
:_ =? scrying.s ?=([%pass ^ %arvo %a %keen @ *] card)
(~(put ju scrying.s) tid [&2 &6 |6]:card)
:_ =? scrying.s ?=([%pass ^ %arvo %a %keen ?(~ ^) @ *] card)
:: &2=wire &7=ship 7|=path
(~(put ju scrying.s) tid [&2 &7 |7]:card)
s
:_ cards
^- ^card

37
pkg/arvo/app/test.hoon
View File

@ -2,7 +2,7 @@
!:
|%
+$ card card:agent:gall
+$ test ?(%agents %marks %generators)
+$ test ?(%agents %marks %generators %threads)
+$ state
$: app=(set path)
app-ok=?
@ -10,6 +10,8 @@
mar-ok=?
gen=(set path)
gen-ok=?
ted=(set path)
ted-ok=?
==
--
=, format
@ -29,9 +31,10 @@
|^
=+ !<(=test vase)
?- test
%marks test-marks
%agents test-agents
%marks test-marks
%agents test-agents
%generators test-generators
%threads test-threads
==
::
++ test-marks
@ -100,6 +103,25 @@
gen.state (~(put in gen.state) i.paz)
==
::
++ test-threads
=| fex=(list card)
^+ [fex this]
?> =(~ ted.state)
=. ted-ok.state %.y
=+ .^(paz=(list path) ct+(en-beam now-beak /ted))
|- ^+ [fex this]
?~ paz [(flop fex) this]
=/ xap=path (flop i.paz)
?. ?=([%hoon *] xap)
$(paz t.paz)
=/ sing=card
:+ %pass build+i.paz
[%arvo %c %warp our.bowl q.byk.bowl ~ %sing %a da+now.bowl i.paz]
%_ $
paz t.paz
fex [sing fex]
ted.state (~(put in ted.state) i.paz)
==
++ now-beak %_(byk.bowl r [%da now.bowl])
--
++ on-watch on-watch:def
@ -150,6 +172,15 @@
~? =(~ gen.state)
?:(gen-ok.state %all-generators-built %some-generators-failed)
[~ this]
::
[%ted *]
=/ ok ?=(^ p.sign-arvo)
%- (report path ok)
=? ted-ok.state !ok %.n
=. ted.state (~(del in ted.state) path)
~? =(~ ted.state)
?:(ted-ok.state %all-threads-built %some-threads-failed)
[~ this]
==
++ on-fail on-fail:def
--

6
pkg/arvo/gen/hood/approve-merge.hoon Normal file
View File

@ -0,0 +1,6 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[syd=desk her=ship sud=desk approve=? ~]
~
==
kiln-approve-merge+[[syd her sud] approve]

6
pkg/arvo/gen/hood/global-automerge.hoon Normal file
View File

@ -0,0 +1,6 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[auto=? ~]
~
==
kiln-global-automerge+auto

6
pkg/arvo/gen/hood/jump/approve.hoon Normal file
View File

@ -0,0 +1,6 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[old=dock new=dock ~]
~
==
kiln-jump-opt+[old new &]

16
pkg/arvo/gen/hood/jump/propose.hoon Normal file
View File

@ -0,0 +1,16 @@
/+ *generators
:- %ask
|= $: [now=@da eny=@uvJ bec=beak]
[syd=desk her=ship sud=desk ~]
hard=_|
==
?: hard (produce %kiln-jump-propose syd her sud)
=/ msg
leaf+"Are you sure you want to tell subscribers to get ".
"updates for {<syd>} from {<her>}/{(trip sud)}?"
%+ print msg
%+ prompt [%& %prompt "(y/N) "]
|= in=tape
?. |(=("y" in) =("Y" in) =("yes" in))
no-product
(produce %kiln-jump-propose syd her sud)

6
pkg/arvo/gen/hood/jump/reject.hoon Normal file
View File

@ -0,0 +1,6 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[old=dock new=dock ~]
~
==
kiln-jump-opt+[old new |]

6
pkg/arvo/gen/hood/sync-automerge.hoon Normal file
View File

@ -0,0 +1,6 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[syd=desk her=ship sud=desk auto=(unit ?) ~]
~
==
kiln-sync-automerge+[[syd her sud] auto]

16
pkg/arvo/gen/jumps.hoon Normal file
View File

@ -0,0 +1,16 @@
/- h=hood
:- %say
|= [[now=@da eny=@uvJ bec=beak] ~ ~]
:- %tang
^- tang
=+ .^ hop=jump:h
%gx
(scot %p p.bec)
%hood
(scot %da now)
/kiln/jumps/noun
==
?> ?=(%all -.hop)
%+ turn ~(tap by all.hop)
|= [old=dock new=dock]
leaf+"{<p.old>}/{(trip q.old)} -> {<p.new>}/{(trip q.new)}"

16
pkg/arvo/gen/updates.hoon Normal file
View File

@ -0,0 +1,16 @@
/- h=hood
:- %say
|= [[now=@da eny=@uvJ bec=beak] ~ ~]
:- %tang
^- tang
=+ .^ upd=sync-update:h
%gx
(scot %p p.bec)
%hood
(scot %da now)
/kiln/pending/noun
==
?> ?=(%pending -.upd)
%+ turn ~(tap in pending.upd)
|= [sync-record:h rev=@ud]
leaf+"{<syd>} <- {<her>}/{(trip sud)}/{<rev>}"

13
pkg/arvo/lib/dprint.hoon
View File

@ -77,6 +77,7 @@
:: +hunt: door used for refining the type while searching for doccords
::
++ hunt
=| gil=(set type)
|_ [topics=(lest term) sut=type]
+* this .
::
@ -255,7 +256,8 @@
^- (unit item)
?> ?=([%face *] sut)
:: TODO: handle tune case
?> ?=(term p.sut)
?. ?=(term p.sut)
return-item:this(sut q.sut)
=* compiled-against return-item:this(sut q.sut)
`[%face (trip p.sut) *what compiled-against]
::
@ -318,7 +320,14 @@
[%face *] return-face
[%fork *] return-fork
[%hint *] return-hint
[%hold *] return-item:this(sut (~(play ut p.sut) q.sut))
[%hold *]
?: (~(has in gil) sut)
~
=< return-item
%= this
gil (~(put in gil) sut)
sut (~(play ut p.sut) q.sut)
==
==
::
++ return-hint-core

314
pkg/arvo/lib/hood/kiln.hoon
View File

@ -5,7 +5,8 @@
=, format
=* dude dude:gall
|%
+$ state state-10
+$ state state-11
+$ state-11 [%11 pith-11]
+$ state-10 [%10 pith-10]
+$ state-9 [%9 pith-9]
+$ state-8 [%8 pith-9]
@ -19,7 +20,8 @@
+$ state-0 [%0 pith-0]
+$ any-state
$~ *state
$% state-10
$% state-11
state-10
state-9
state-8
state-7
@ -32,10 +34,32 @@
state-0
==
::
+$ pith-11
$: rem=(map desk per-desk)
nyz=@ud
zyn=(map sync-record sync-state)
:: requests from publishers to switch sync source
hop=(map dock dock)
:: toggle global update auto-merge
mer=?
::
commit-timer=[way=wire nex=@da tim=@dr mon=term]
:: map desk to the currently ongoing fuse request
:: and the latest version numbers for beaks to
fus=(map desk per-fuse)
:: used for fuses - every time we get a fuse we
:: bump this. used when calculating hashes to
:: ensure they're unique even when the same
:: request is made multiple times.
hxs=(map desk @ud)
==
::
+$ sync-state-10 [nun=@ta kid=(unit desk) let=@ud]
::
+$ pith-10
$: rem=(map desk per-desk)
nyz=@ud
zyn=(map kiln-sync sync-state)
zyn=(map sync-record sync-state-10)
commit-timer=[way=wire nex=@da tim=@dr mon=term]
:: map desk to the currently ongoing fuse request
:: and the latest version numbers for beaks to
@ -50,7 +74,7 @@
+$ pith-9
$: wef=(unit weft)
rem=(map desk per-desk)
syn=(map kiln-sync let=@ud)
syn=(map sync-record let=@ud)
ark=(map desk arak-9)
commit-timer=[way=wire nex=@da tim=@dr mon=term]
:: map desk to the currently ongoing fuse request
@ -78,7 +102,7 @@
+$ pith-7
$: wef=(unit weft)
rem=(map desk per-desk)
syn=(map kiln-sync let=@ud)
syn=(map sync-record let=@ud)
ark=(map desk arak-7)
commit-timer=[way=wire nex=@da tim=@dr mon=term]
:: map desk to the currently ongoing fuse request
@ -121,7 +145,7 @@
+$ pith-6
$: wef=(unit weft)
rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
syn=(map sync-record let=@ud) ::
ark=(map desk arak-6) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
:: map desk to the currently ongoing fuse request
@ -139,7 +163,7 @@
::
+$ pith-5
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
syn=(map sync-record let=@ud) ::
ark=(map desk arak-6) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
:: map desk to the currently ongoing fuse request
@ -154,7 +178,7 @@
::
+$ pith-4 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
syn=(map sync-record let=@ud) ::
ark=(map desk arak-4) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
:: map desk to the currently ongoing fuse request
@ -175,7 +199,7 @@
==
+$ pith-3 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
syn=(map sync-record let=@ud) ::
ark=(map desk arak-3) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
:: map desk to the currently ongoing fuse request
@ -201,7 +225,7 @@
::
+$ pith-2 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
syn=(map sync-record let=@ud) ::
ota=(unit [=ship =desk =aeon]) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
fus=(map desk per-fuse)
@ -209,13 +233,13 @@
== ::
+$ pith-1 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
syn=(map sync-record let=@ud) ::
ota=(unit [=ship =desk =aeon]) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
== ::
+$ pith-0 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
syn=(map sync-record let=@ud) ::
autoload-on=? ::
cur-hoon=@uvI ::
cur-arvo=@uvI ::
@ -245,16 +269,6 @@
pot=term ::
==
+$ kiln-unmount $@(term [knot path]) ::
+$ kiln-sync ::
$: syd=desk :: local desk
her=ship :: foreign ship
sud=desk :: foreign desk
==
+$ kiln-unsync ::
$: syd=desk :: local desk
her=ship :: foreign ship
sud=desk :: foreign desk
==
+$ kiln-merge ::
$@ ~
$: syd=desk ::
@ -285,7 +299,6 @@
+$ kiln-fuse-list (unit desk)
--
|= [bowl:gall state]
?> =(src our)
=| moz=(list card:agent:gall)
|%
++ kiln .
@ -440,7 +453,7 @@
=^ cards-9=(list card:agent:gall) old
?. ?=(%9 -.old)
`old
=/ syn=(set kiln-sync)
=/ syn=(set sync-record)
%- ~(gas in ~(key by syn.old))
%+ murn ~(tap by ark.old)
|= [=desk =arak-9]
@ -468,8 +481,8 @@
[%pass /kiln/load-zest %arvo %c %zest desk zest]
::
%+ turn ~(tap in syn)
|= k=kiln-sync
[%pass /kiln/load-sync %agent [our %hood] %poke %kiln-sync !>(k)]
|= r=sync-record
[%pass /kiln/load-sync %agent [our %hood] %poke %kiln-sync !>(r)]
::
=/ ks ~(tap in syn)
|- ^- (list card:agent:gall)
@ -483,7 +496,17 @@
$(ks t.ks)
==
::
?> ?=(%10 -.old)
=? old ?=(%10 -.old)
%= old
- %11
|4 [hop=~ mer=& |4.old]
zyn %- ~(run by zyn.old)
|= sync-state-10
^- sync-state
[nun kid let ~ ~ |]
==
::
?> ?=(%11 -.old)
=. state old
abet:(emil cards-9)
::
@ -499,18 +522,31 @@
=/ ver (mergebase-hashes our %base now (~(got by sources) %base))
``noun+!>(?~(ver 0v0 i.ver))
::
[%x %kiln %syncs ~] ``noun+!>(zyn)
[%x %kiln %sources ~] ``noun+!>(sources)
[%x %kiln %jumps ~] ``kiln-jump+!>([%all hop])
[%x %kiln %syncs ~] ``noun+!>(zyn)
[%x %kiln %sources ~] ``noun+!>(sources)
[%x %kiln %automerge ~] ``loob+!>(mer)
[%x %kiln %pikes ~]
=+ .^(=rock:tire %cx /(scot %p our)//(scot %da now)/tire)
:^ ~ ~ %kiln-pikes
!> ^- pikes
%- ~(rut by rock)
%- ~(urn by rock)
|= [=desk =zest wic=(set weft)]
^- pike
=+ .^(hash=@uv %cz /(scot %p our)/[desk]/(scot %da now))
=/ sync (~(get by sources) desk)
[sync hash zest wic]
::
[%x %kiln %pending ~]
:^ ~ ~ %kiln-sync-update
!> ^- sync-update
:- %pending
%- ~(gas by *(set [sync-record @ud]))
^- (list [sync-record @ud])
%+ murn ~(tap by zyn)
|= [sync-record sync-state]
?~ hav ~
(some [syd her sud] u.hav)
==
::
:: +get-germ: select merge strategy into local desk
@ -528,12 +564,15 @@
::
++ poke
|= [=mark =vase]
?> |(=(src our) =(%kiln-jump-ask mark))
?+ mark ~|([%poke-kiln-bad-mark mark] !!)
%kiln-approve-merge =;(f (f !<(_+<.f vase)) poke-approve-merge)
%kiln-autocommit =;(f (f !<(_+<.f vase)) poke-autocommit)
%kiln-bump =;(f (f !<(_+<.f vase)) poke-bump)
%kiln-cancel =;(f (f !<(_+<.f vase)) poke-cancel)
%kiln-cancel-autocommit =;(f (f !<(_+<.f vase)) poke-cancel-autocommit)
%kiln-commit =;(f (f !<(_+<.f vase)) poke-commit)
%kiln-sync-automerge =;(f (f !<(_+<.f vase)) poke-sync-automerge)
%kiln-fuse =;(f (f !<(_+<.f vase)) poke-fuse)
%kiln-fuse-list =;(f (f !<(_+<.f vase)) poke-fuse-list)
%kiln-gall-sear =;(f (f !<(_+<.f vase)) poke-gall-sear)
@ -543,12 +582,16 @@
%kiln-label =;(f (f !<(_+<.f vase)) poke-label)
%kiln-merge =;(f (f !<(_+<.f vase)) poke-merge)
%kiln-mount =;(f (f !<(_+<.f vase)) poke-mount)
%kiln-jump-ask =;(f (f !<(_+<.f vase)) poke-jump-ask)
%kiln-jump-opt =;(f (f !<(_+<.f vase)) poke-jump-opt)
%kiln-jump-propose =;(f (f !<(_+<.f vase)) poke-jump-propose)
%kiln-nuke =;(f (f !<(_+<.f vase)) poke-nuke)
%kiln-pause =;(f (f !<(_+<.f vase)) poke-pause)
%kiln-permission =;(f (f !<(_+<.f vase)) poke-permission)
%kiln-revive =;(f (f !<(_+<.f vase)) poke-revive)
%kiln-rein =;(f (f !<(_+<.f vase)) poke-rein)
%kiln-rm =;(f (f !<(_+<.f vase)) poke-rm)
%kiln-global-automerge =;(f (f !<(_+<.f vase)) poke-global-automerge)
%kiln-schedule =;(f (f !<(_+<.f vase)) poke-schedule)
%kiln-suspend =;(f (f !<(_+<.f vase)) poke-suspend)
%kiln-suspend-many =;(f (f !<(_+<.f vase)) poke-suspend-many)
@ -559,6 +602,19 @@
%kiln-unsync =;(f (f !<(_+<.f vase)) poke-unsync)
==
::
++ poke-approve-merge
|= [sync-record approve=?]
?~ got=(~(get by zyn) syd her sud)
=+ msg="kiln: no syncs from {(scow %p her)}/{(trip sud)} to {<syd>}"
((slog leaf+msg ~) abet)
?~ hav.u.got
=+ msg="kiln: no updates from {(scow %p her)}/{(trip sud)} for {<syd>}"
((slog leaf+msg ~) abet)
=< abet
?. approve
abet:drop:(sync syd her sud)
abet:(merg /main syd):(sync syd her sud)
::
++ poke-autocommit
|= [mon=kiln-commit auto=?]
=< abet
@ -679,6 +735,23 @@
|= =ship
abet:(emit %pass /kiln %arvo %g %sear ship)
::
++ poke-global-automerge
|= auto=?
=. mer auto
?. mer abet
=/ zyns=(list [sync-record sync-state]) ~(tap by zyn)
=< abet
|-
?~ zyns ..abet
?. ?& ?=(^ hav.i.zyns)
!?=([~ %.n] nit.i.zyns)
==
$(zyns t.zyns)
%= $
zyns t.zyns
..abet abet:(merg /main syd):(sync -.i.zyns)
==
::
++ poke-info
|= [mez=tape tor=(unit toro)]
?~ tor
@ -692,17 +765,20 @@
?~ got=(~(get by rock) loc)
%dead
zest.u.got
=. zyn
=. ..abet
?~ got=(~(get by sources) loc)
zyn
(~(del by zyn) loc u.got)
..abet
?: =([her rem] u.got)
..abet
=. ..abet abet:drop:(sync loc u.got)
..abet(zyn (~(del by zyn) loc u.got))
=? ..abet ?=(%dead zest)
(emit %pass /kiln/install %arvo %c %zest loc ?:(=(our her) %live %held))
?: (~(has by zyn) loc her rem)
abet:(spam (render "already syncing" loc her rem ~) ~)
?: =([our loc] [her rem])
abet
=/ sun (sync loc her rem)
=/ sun okay:(sync loc her rem)
~> %slog.(fmt "beginning install into {here:sun}")
=< abet:abet:init
?: =(%base loc)
@ -710,7 +786,7 @@
sun
::
++ poke-kids
|= [hos=kiln-sync nex=(unit desk)]
|= [hos=sync-record nex=(unit desk)]
abet:abet:(apex:(sync hos) nex)
::
++ poke-label
@ -731,6 +807,84 @@
abet:(spam leaf+- ~)
abet:(emit %pass /mount %arvo %c [%mont pot u.bem])
::
++ poke-jump-propose
|= [syd=desk her=ship sud=desk]
?: =([our syd] [her sud])
abet
=/ let=@ud ud:.^(cass:clay %cw /(scot %p our)/[syd]/(scot %da now))
=/ subs=(set [@p rave:clay])
.^((set [@p rave:clay]) %cx /(scot %p our)//(scot %da now)/cult/[syd])
=/ ships=(set @p)
%+ roll ~(tap in subs)
|= [[=ship =rave:clay] ships=(set @p)]
?: =(our ship) ships
?. ?=([%sing %w [%ud @] ~] rave) ships
?. =(+(let) p.case.mood.rave) ships
(~(put in ships) ship)
=< abet
%- emil
%+ turn ~(tap in ships)
|= =ship
:* %pass /kiln/jump-propose %agent [ship %hood]
%poke %kiln-jump-ask !>([[our syd] [her sud]])
==
::
++ poke-jump-ask
|= [old=dock new=dock]
?> |(=(src p.old) =(src our))
?: =(old new)
?~ had=(~(get by hop) old)
abet
=. hop (~(del by hop) old)
abet:(emit %give %fact ~[/jumps] %kiln-jump !>([%nay old u.had]))
?~ (skim ~(tap by sources) |=(sync-record =(old [her sud])))
~> %slog.(fmt "no syncs from {(scow %p p.old)}/{(trip q.old)}")
abet
=. hop (~(put by hop) old new)
abet:(emit %give %fact ~[/jumps] %kiln-jump !>([%add old new]))
::
++ poke-jump-opt
|= [old=dock new=dock yea=?]
?~ got=(~(get by hop) old)
~> %slog.(fmt "no jump request for {(scow %p p.old)}/{(trip q.old)}")
abet
?. =(new u.got)
=/ txt-old "{(scow %p p.old)}/{(trip q.old)}"
=/ txt-new "{(scow %p p.new)}/{(trip q.new)}"
~> %slog.(fmt "no jump request from {txt-old} to {txt-new}")
abet
?. yea
=/ txt-old "{(scow %p p.old)}/{(trip q.old)}"
=/ txt-new "{(scow %p p.new)}/{(trip q.new)}"
~> %slog.(fmt "denied jump from {txt-old} to {txt-new}")
=. hop (~(del by hop) old)
abet:(emit %give %fact ~[/jumps] %kiln-jump !>([%nay old new]))
=/ old-sources=(list sync-record)
(skim ~(tap by sources) |=(sync-record =(old [her sud])))
=/ new-sources=(list sync-record)
(turn old-sources |=(sync-record [syd new]))
=. ..abet
(emit %give %fact ~[/jumps] %kiln-jump !>([%yea old new]))
=. ..abet
|-
?~ old-sources
..abet
=. ..abet abet:drop:(sync i.old-sources)
=. zyn (~(del by zyn) i.old-sources)
$(old-sources t.old-sources, ..abet ..abet)
=. hop (~(del by hop) old)
=< abet
|- ^+ ..abet
?~ new-sources ..abet
%= $
new-sources t.new-sources
..abet =/ sun (sync i.new-sources)
=< abet:init
?: =(%base syd.i.new-sources)
(apex:sun `%kids)
sun
==
::
++ poke-nuke
|= [=term desk=?]
=< abet
@ -801,11 +955,28 @@
|=(=desk [%pass /kiln/suspend %arvo %c %zest desk %dead])
::
++ poke-sync
|= hos=kiln-sync
?: (~(has by zyn) hos)
abet:(spam (render "already syncing" [sud her syd ~]:hos) ~)
~> %slog.(fmt "beginning sync into {<syd.hos>} from {<her.hos>}/{<sud.hos>}")
abet:abet:init:(sync hos)
|= sync-record
?: (~(has by zyn) sud her syd)
abet:(spam (render "already syncing" [sud her syd ~]) ~)
=. ..abet
?~ got=(~(get by sources) syd)
..abet
=. ..abet abet:drop:(sync syd u.got)
..abet(zyn (~(del by zyn) syd u.got))
~> %slog.(fmt "beginning sync into {<syd>} from {<her>}/{<sud>}")
abet:abet:init:(sync syd her sud)
::
++ poke-sync-automerge
|= [sync-record auto=(unit ?)]
?~ got=(~(get by zyn) syd her sud)
=+ msg="kiln: no syncs from {(scow %p her)}/{(trip sud)} to {<syd>}"
((slog leaf+msg ~) abet)
=. zyn (~(put by zyn) [syd her sud] u.got(nit auto))
?~ hav.u.got
abet
?. |(?=([~ %.y] auto) &(mer ?=(~ auto)))
abet
abet:abet:(merg /main syd):(sync [syd her sud])
::
++ poke-syncs :: print sync config
|= ~
@ -813,7 +984,7 @@
?: =(0 ~(wyt by zyn))
[%leaf "no syncs configured"]~
%+ turn ~(tap by zyn)
|= [kiln-sync sync-state]
|= [sync-record sync-state]
(render "sync configured" sud her syd kid)
::
++ poke-uninstall
@ -841,9 +1012,10 @@
:: Don't need to cancel anything because new syncs will get a new nonce
::
++ poke-unsync
|= hus=kiln-unsync
|= hus=sync-record
?~ got=(~(get by zyn) hus)
abet:(spam (render "not syncing" [sud her syd ~]:hus) ~)
=. ..abet abet:drop:(sync hus)
=. zyn (~(del by zyn) hus)
abet:(spam (render "cancelling sync" sud.hus her.hus syd.hus kid.u.got) ~)
:: +peer: handle %watch
@ -851,10 +1023,26 @@
++ peer
|= =path
?> (team:title our src)
?: =(0 1) abet :: avoid mint-vain
?+ path ~|(kiln-path/path !!)
[%vats ~]
(mean leaf+"kiln: old subscription to /kiln/vats failed" ~)
::
[%jumps ~]
abet:(emit %give %fact ~ %kiln-jump !>([%all hop]))
::
[%updates ~]
=< abet
%- emit
:^ %give %fact ~
:- %kiln-sync-update
!> ^- sync-update
:- %pending
%- ~(gas by *(set [sync-record @ud]))
^- (list [sync-record @ud])
%+ murn ~(tap by zyn)
|= [sync-record sync-state]
?~ hav ~
(some [syd her sud] u.hav)
==
::
++ take-agent
@ -864,6 +1052,8 @@
~? ?=(^ p.sign) [%kiln-poke-nack u.p.sign]
abet
~|([%kiln-bad-take-agent wire -.sign] !!)
::
[%change-publisher ~] abet
::
[%fancy *]
?> ?=(%poke-ack -.sign)
@ -1078,15 +1268,30 @@
abet:abet:(take:(sync syd her sud) t.t.t.wire sign-arvo)
::
++ sync
|= kiln-sync
|= sync-record
=/ got (~(get by zyn) syd her sud)
=+ `sync-state`(fall got [(scot %uv nyz) ~ *@ud])
=+ `sync-state`(fall got [(scot %uv nyz) ~ *@ud ~ ~ |])
=? nyz ?=(~ got) +(nyz)
|%
++ abet ..sync(zyn (~(put by zyn) [syd her sud] nun kid let))
++ abet ..sync(zyn (~(put by zyn) [syd her sud] nun kid let nit hav yea))
++ apex |=(nex=(unit desk) ..abet(kid nex))
++ emit |=(card:agent:gall ..abet(kiln (^emit +<)))
++ emil |=((list card:agent:gall) ..abet(kiln (^emil +<)))
++ okay ..abet(yea &)
++ gain
=. hav `(dec let)
=/ upd=sync-update [%new [syd her sud] (dec let)]
(emit %give %fact ~[/update] %kiln-sync-update !>(upd))
++ drop
=? ..abet ?=(^ hav)
=/ upd=sync-update [%drop [syd her sud] u.hav]
(emit %give %fact ~[/updates] %kiln-sync-update !>(upd))
..abet(hav ~, yea |)
++ tada
=? ..abet ?=(^ hav)
=/ upd=sync-update [%done [syd her sud] u.hav]
(emit %give %fact ~[/updates] %kiln-sync-update !>(upd))
..abet(hav ~, yea |)
++ here "{<syd>} from {<her>}/{<sud>}"
++ ware
|= =wire
@ -1101,7 +1306,6 @@
%merg desk her sud
ud+(dec let) (get-germ desk)
==
::
:: (re)Start a sync from scratch by finding what version the source
:: desk is at
::
@ -1129,8 +1333,8 @@
?> ?=(^ riot)
:: The syncs may have changed, so get the latest
::
;< zyx=(map kiln-sync sync-state) bind:m
(scry:strandio (map kiln-sync sync-state) /gx/hood/kiln/syncs/noun)
;< zyx=(map sync-record sync-state) bind:m
(scry:strandio (map sync-record sync-state) /gx/hood/kiln/syncs/noun)
?. (~(has by zyx) syd her sud)
(pure:m !>(%done))
~> %slog.(fmt "downloading update for {here}")
@ -1175,6 +1379,7 @@
?: ?=(%| -.p.sign-arvo)
:: ~> %slog.(fmt "download failed into {here}; retrying sync")
:: %- (slog p.p.sign-arvo)
=. ..abet drop
init
::
~> %slog.(fmt "finished downloading update for {here}")
@ -1182,7 +1387,7 @@
:: If nothing changed, just ensure %kids is up-to-date and advance
::
?. (get-remote-diff our syd now [her sud (dec let)])
=< next
=< next:drop
?~ kid
~> %slog.(fmt "remote is identical to {here}, skipping")
..abet
@ -1191,15 +1396,22 @@
..abet
~> %slog.(fmt "remote is identical to {here}, merging into {<u.kid>}")
(merg /kids u.kid)
:: wait for approval if can't automerge & signal available update
::
?. |(=(our her) yea =([~ &] nit) &(=(~ nit) mer))
=. ..abet gain
next
:: Else start merging, but also immediately start listening to
:: the next revision. Now, all errors should no-op -- we're
:: already waiting for the next revision.
::
=. yea |
=. ..abet (merg /main syd)
next
::
%main
%main
?> ?=(%mere +<.sign-arvo)
=< tada
?: ?=(%| -.p.sign-arvo)
=+ "kiln: merge into {here} failed, waiting for next revision"
%- (slog leaf/- p.p.sign-arvo)

4
pkg/arvo/lib/test/ames-gall.hoon
View File

@ -213,7 +213,7 @@
=< q
%- need %- need
%- scry:(ames-gate now eny roof)
[~ / %x [[our %$ da+now] /peers/(scot %p her)]]
[[~ ~] / %x [[our %$ da+now] /peers/(scot %p her)]]
::
++ gall-scry-nonce
|= $: =gall-gate
@ -227,7 +227,7 @@
=< q
%- need %- need
%- scry:(gall-gate now eny roof)
[~ / %n [[our dude da+now] [%$ (scot %p ship.sub) [term wire]:sub]]]
[[~ ~] / %n [[our dude da+now] [%$ (scot %p ship.sub) [term wire]:sub]]]
::
++ load-agent
|= [=ship =gall-gate =dude:gall =agent:gall]

1
pkg/arvo/mar/kiln/approve-merge.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/mar/kiln/approve-merge.hoon

1
pkg/arvo/mar/kiln/jump-ask.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/mar/kiln/jump-ask.hoon

1
pkg/arvo/mar/kiln/jump-opt.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/mar/kiln/jump-opt.hoon

1
pkg/arvo/mar/kiln/jump.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/mar/kiln/jump.hoon

1
pkg/arvo/mar/kiln/sync-update.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/mar/kiln/sync-update.hoon

2
pkg/arvo/sys.kelvin
View File

@ -1 +1 @@
[%zuse 412]
[%zuse 411]

4
pkg/arvo/sys/arvo.hoon
View File

@ -352,7 +352,9 @@
?~ dat=(rof lyc pov u.mon) ~
?~ u.dat [~ ~]
=* vax q.u.u.dat
?. ?& ?=(^ ref)
?. => [ref=ref vax=p=p.vax hoon-version=hoon-version wa=wa worm=worm]
~> %memo./arvo/look :: with memoization
?& ?=(^ ref)
=(hoon-version -.ref)
-:(~(nets wa *worm) +.ref p.vax)
==

266
pkg/arvo/sys/hoon.hoon
View File

@ -2,11 +2,11 @@
:::: /sys/hoon ::
:: ::
=< ride
=> %139 =>
=> %138 =>
:: ::
:::: 0: version stub ::
:: ::
~% %k.139 ~ ~ ::
~% %k.138 ~ ~ ::
|%
++ hoon-version +
-- =>
@ -217,6 +217,7 @@
:: computes the axis of {b} within axis {a}.
|= [a=@ b=@]
?< =(0 a)
?< =(0 b)
:: a composed axis
^- @
?- b
@ -1394,23 +1395,19 @@
::
++ bif :: splits a by b
~/ %bif
|* [b=* c=*]
^+ [l=a r=a]
=< +
|- ^+ a
|* b=*
|- ^+ [l=a r=a]
?~ a
[[b c] ~ ~]
[~ ~]
?: =(b p.n.a)
?: =(c q.n.a)
a
a(n [b c])
+.a
?: (gor b p.n.a)
=+ d=$(a l.a)
?> ?=(^ d)
d(r a(l r.d))
[l.d a(l r.d)]
=+ d=$(a r.a)
?> ?=(^ d)
d(l a(r l.d))
[a(r l.d) r.d]
::
++ del :: delete at key b
~/ %del
@ -1435,7 +1432,7 @@
|- ^+ a
?~ b
a
=+ c=(bif p.n.b q.n.b)
=+ c=(bif p.n.b)
?> ?=(^ c)
=+ d=$(a l.c, b l.b)
=+ e=$(a r.c, b r.b)
@ -1592,12 +1589,6 @@
?~ a a
[n=[p=p.n.a q=(b q.n.a)] l=$(a l.a) r=$(a r.a)]
::
++ rut :: apply gate to nodes
|* b=gate
|-
?~ a a
[n=[p=p.n.a q=(b p.n.a q.n.a)] l=$(a l.a) r=$(a r.a)]
::
++ tap :: listify pairs
=< $
~/ %tap
@ -1687,6 +1678,19 @@
|* [b=* c=*]
=+ d=(get b)
(~(put by a) b [c d])
::
++ zip :: listify jar
=< $
~/ %zip
=+ b=`(list _?>(?=([[* ^] *] a) [p=p q=i.q]:n.a))`~
|. ^+ b
?~ a b
%= $
a r.a
b |- ^+ b
?~ q.n.a ^$(a l.a)
[[p i.q]:n.a $(q.n.a t.q.n.a)]
==
--
++ ju :: jug engine
=| a=(tree (pair * (tree))) :: (jug)
@ -1791,6 +1795,12 @@
[b ~ ~]
bal(l.a $(a l.a))
::
++ run :: apply gate to values
|* b=gate
|-
?~ a a
[n=(b n.a) l=$(a l.a) r=$(a r.a)]
::
++ tap :: adds list to end
=+ b=`(list _?>(?=(^ a) n.a))`~
|- ^+ b
@ -1877,17 +1887,17 @@
++ corl :: compose backwards
|* [a=$-(* *) b=$-(* *)]
=< +:|.((a (b))) :: type check
|* c=_+<.b
|* c=_,.+<.b
(a (b c))
::
++ cury :: curry left
|* [a=$-(^ *) b=*]
|* c=_+<+.a
|* c=_,.+<+.a
(a b c)
::
++ curr :: curry right
|* [a=$-(^ *) c=*]
|* b=_+<+.a
|* b=_,.+<-.a
(a b c)
::
++ fore |*(a=$-(* *) |*(b=$-(* *) (pair a b))) :: pair before
@ -3252,7 +3262,8 @@
++ shas :: salted hash
~/ %shas
|= [sal=@ ruz=@]
(shax (mix sal (shax ruz)))
=/ len (max 32 (met 3 sal))
(shay len (mix sal (shax ruz)))
::
++ shax :: sha-256
~/ %shax
@ -7144,7 +7155,10 @@
:: 5a: compiler utilities
+| %compiler-utilities
::
++ bool `type`(fork [%atom %f `0] [%atom %f `1] ~) :: make loobean
++ bool :: make loobean
^- type
(fork [%atom %f `%.y] [%atom %f `%.n] ~)
::
++ cell :: make %cell type
~/ %cell
|= [hed=type tal=type]
@ -7216,11 +7230,10 @@
~/ %cond
|= [pex=nock yom=nock woq=nock]
^- nock
?- pex
[%1 %0] yom
[%1 %1] woq
* [%6 pex yom woq]
==
?: =([%1 &] pex) yom
?: =([%1 |] pex) woq
?: =([%0 0] pex) pex
[%6 pex yom woq]
::
++ cons :: make formula cell
~/ %cons
@ -7253,10 +7266,10 @@
=(0 p.wux)
&(!=(0 p.wux) (lte p.wux p.yoz))
==
|- ?| =(%$ p.yoz)
=(%$ p.wux)
?& =((end 3 p.yoz) (end 3 p.wux))
$(p.yoz (rsh 3 p.yoz), p.wux (rsh 3 p.wux))
|- ?| =(%$ q.yoz)
=(%$ q.wux)
?& =((end 3 q.yoz) (end 3 q.wux))
$(q.yoz (rsh 3 q.yoz), q.wux (rsh 3 q.wux))
==
==
==
@ -7265,43 +7278,44 @@
~/ %flan
|= [bos=nock nif=nock]
^- nock
?: =(bos nif) bos
?: =([%0 0] bos) nif
?: =([%0 0] nif) bos
?- bos
[%1 %1] bos
[%1 %0] nif
*
?- nif
[%1 %1] nif
[%1 %0] bos
* [%6 bos nif [%1 1]]
==
==
?: ?| =(bos nif)
=([%1 |] bos)
=([%1 &] nif)
=([%0 0] bos)
==
bos
?: ?| =([%1 &] bos)
=([%1 |] nif)
=([%0 0] nif)
==
nif
[%6 bos nif [%1 |]]
::
++ flip :: loobean negation
~/ %flip
|= dyr=nock
^- nock
?: =([%1 &] dyr) [%1 |]
?: =([%1 |] dyr) [%1 &]
?: =([%0 0] dyr) dyr
[%6 dyr [%1 1] [%1 0]]
[%6 dyr [%1 |] %1 &]
::
++ flor :: loobean |
~/ %flor
|= [bos=nock nif=nock]
^- nock
?: =(bos nif) bos
?: =([%0 0] bos) nif
?: =([%0 0] nif) bos
?- bos
[%1 %1] nif
[%1 %0] bos
*
?- nif
[%1 %1] bos
[%1 %0] nif
* [%6 bos [%1 0] nif]
==
==
?: ?| =(bos nif)
=([%1 &] bos)
=([%1 |] nif)
=([%0 0] bos)
==
bos
?: ?| =([%1 |] bos)
=([%1 &] nif)
=([%0 0] nif)
==
nif
[%6 bos [%1 &] nif]
::
++ hike
~/ %hike
@ -8302,9 +8316,6 @@
::
[%limb @]
`p.gen
::
:: [%rock *]
:: [%spec %leaf q.gen q.gen]
::
[%note [%help *] *]
(bind $(gen q.gen) |=(=skin [%help p.p.gen skin]))
@ -8779,7 +8790,7 @@
++ fish
|= =axis
^- nock
?@ skin [%1 &]
?@ skin $(skin spec+[[%like [skin]~ ~] [%base %noun]])
?- -.skin
::
%base
@ -8809,8 +8820,8 @@
[%1 &]
[%3 %0 axis]
%+ flan
$(ref (peek(sut ref) %free 2), skin skin.skin)
$(ref (peek(sut ref) %free 3), skin ^skin.skin)
$(ref (peek(sut ref) %free 2), axis (peg axis 2), skin skin.skin)
$(ref (peek(sut ref) %free 3), axis (peg axis 3), skin ^skin.skin)
::
%leaf
?: (~(nest ut [%atom %$ `atom.skin]) | ref)
@ -8820,16 +8831,21 @@
%dbug $(skin skin.skin)
%help $(skin skin.skin)
%name $(skin skin.skin)
%over $(skin skin.skin)
%spec $(skin skin.skin)
%wash [%1 1]
%over ::NOTE might need to guard with +feel, crashing is too strict
=+ ~| %oops-guess-you-needed-feel-after-all
fid=(fend %read wing.skin)
$(sut p.fid, axis (peg axis q.fid), skin skin.skin)
%spec =/ hit (~(play ut sut) ~(example ax spec.skin))
?> (~(nest ut hit) & ref)
$(skin skin.skin)
%wash [%1 &]
==
::
:: +gain: make a $type by restricting .ref to .skin
::
++ gain
|- ^- type
?@ skin [%face skin ref]
?@ skin $(skin spec+[[%like [skin]~ ~] [%base %noun]])
?- -.skin
::
%base
@ -8852,7 +8868,7 @@
q.ref
[%cell *] %void
[%core *] %void
[%face *] (face p.ref $(ref q.ref))
[%face *] $(ref q.ref)
[%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
[%hint *] (hint p.ref $(ref q.ref))
[%hold *] ?: (~(has in gil) ref) %void
@ -8865,7 +8881,9 @@
|- ^- type
?- ref
%void %void
%noun [%cell %noun %noun]
%noun =+ ^$(skin skin.skin)
?: =(%void -) %void
(cell - ^$(skin ^skin.skin))
[%atom *] %void
[%cell *] =+ ^$(skin skin.skin, ref p.ref)
?: =(%void -) %void
@ -8875,7 +8893,7 @@
?. =(%noun ^skin.skin)
(cell - ^$(skin ^skin.skin, ref %noun))
[%core - q.ref]
[%face *] (face p.ref $(ref q.ref))
[%face *] $(ref q.ref)
[%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
[%hint *] (hint p.ref $(ref q.ref))
[%hold *] ?: (~(has in gil) ref) %void
@ -8897,7 +8915,7 @@
`atom.skin
[%cell *] %void
[%core *] %void
[%face *] (face p.ref $(ref q.ref))
[%face *] $(ref q.ref)
[%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
[%hint *] (hint p.ref $(ref q.ref))
[%hold *] ?: (~(has in gil) ref) %void
@ -8908,10 +8926,9 @@
%help (hint [sut %help help.skin] $(skin skin.skin))
%name (face term.skin $(skin skin.skin))
%over $(skin skin.skin, sut (~(play ut sut) %wing wing.skin))
%spec =/ yon $(skin skin.skin)
=/ hit (~(play ut sut) ~(example ax spec.skin))
?> (~(nest ut hit) & yon)
hit
%spec =/ hit (~(play ut sut) ~(example ax spec.skin))
?> (~(nest ut hit) & $(skin skin.skin))
(~(fuse ut ref) hit)
%wash =- $(ref (~(play ut ref) -))
:- %wing
|- ^- wing
@ -8923,13 +8940,13 @@
::
++ lose
|- ^- type
?@ skin [%face skin ref]
?@ skin $(skin spec+[[%like [skin]~ ~] [%base %noun]])
?- -.skin
::
%base
?- base.skin
%cell $(skin [%cell [%base %noun] [%base %noun]])
%flag $(skin [%base %atom %f])
%flag $(ref $(skin [%leaf %f &]), skin [%leaf %f |])
%null $(skin [%leaf %n ~])
%void ref
%noun %void
@ -8955,17 +8972,19 @@
|- ^- type
?- ref
%void %void
%noun [%atom %$ ~]
%noun ?. =([%cell [%base %noun] [%base %noun]] skin)
ref
[%atom %$ ~]
[%atom *] ref
[%cell *] =+ ^$(skin skin.skin, ref p.ref)
?: =(%void -) %void
(cell - ^$(skin ^skin.skin, ref q.ref))
[%cell *] =/ lef ^$(skin skin.skin, ref p.ref)
=/ rig ^$(skin ^skin.skin, ref q.ref)
(fork (cell lef rig) (cell lef q.ref) (cell p.ref rig) ~)
[%core *] =+ ^$(skin skin.skin, ref p.ref)
?: =(%void -) %void
?. =(%noun ^skin.skin)
(cell - ^$(skin ^skin.skin, ref %noun))
[%core - q.ref]
[%face *] (face p.ref $(ref q.ref))
[%face *] $(ref q.ref)
[%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
[%hint *] (hint p.ref $(ref q.ref))
[%hold *] ?: (~(has in gil) ref) %void
@ -8993,8 +9012,11 @@
%dbug $(skin skin.skin)
%help $(skin skin.skin)
%name $(skin skin.skin)
%over $(skin skin.skin)
%spec $(skin skin.skin)
%over ::TODO if we guard in +fish (+feel), we have to guard again here
$(skin skin.skin, sut (~(play ut sut) %wing wing.skin))
%spec =/ hit (~(play ut sut) ~(example ax spec.skin))
?> (~(nest ut hit) & $(skin skin.skin))
(~(crop ut ref) hit)
%wash ref
==
--
@ -9238,21 +9260,21 @@
::
++ mint
|= gol=type
=- ?>(?|(!vet (nest(sut gol) & p.-)) -)
^- (pair type nock)
=+ lug=(find %read hyp)
?: ?=(%| -.lug) ~>(%mean.'hoon' ?>(?=(~ rig) p.lug))
=- ?>(?|(!vet (nest(sut gol) & p.-)) -)
(ergo p.lug rig)
::
++ mull
|= [gol=type dox=type]
^- [type type]
=- ?>(?|(!vet (nest(sut gol) & p.-)) -)
^- (pair type type)
=+ lug=[p=(find %read hyp) q=(find(sut dox) %read hyp)]
?: ?=(%| -.p.lug)
?> &(?=(%| -.q.lug) ?=(~ rig))
[p.p.p.lug p.p.q.lug]
?> ?=(%& -.q.lug)
=- ?>(?|(!vet (nest(sut gol) & p.-)) -)
(endo [p.p.lug p.q.lug] dox rig)
--
::
@ -9472,6 +9494,14 @@
== ==
(fond way hyp)
::
++ fend
|= [way=vial hyp=wing]
^- (pair type axis)
=+ fid=(find way hyp)
~> %mean.'fend-fragment'
?> &(?=(%& -.fid) ?=(%& -.q.p.fid))
[p.q.p.fid (tend p.p.fid)]
::
++ fund
~/ %fund
|= [way=vial gen=hoon]
@ -9690,14 +9720,13 @@
?: ?=([%wtts *] gen)
(cool how q.gen (play ~(example ax p.gen)))
?: ?=([%wthx *] gen)
=+ (play %wing q.gen)
~> %slog.[0 [%leaf "chipping"]]
?: how
=- ~> %slog.[0 (dunk(sut +<) 'chip: gain: ref')]
~> %slog.[0 (dunk(sut -) 'chip: gain: gain')]
-
~(gain ar - p.gen)
~(lose ar - p.gen)
=+ fid=(find %both q.gen)
?- -.fid
%| sut
%& =< q
%+ take p.p.fid
|=(a=type ?:(how ~(gain ar a p.gen) ~(lose ar a p.gen)))
==
?: ?&(how ?=([%wtpm *] gen))
|-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen))))
?: ?&(!how ?=([%wtbr *] gen))
@ -9971,22 +10000,27 @@
::
[%wtcl *]
=+ nor=$(gen p.gen, gol bool)
=+ fex=(gain p.gen)
=+ wux=(lose p.gen)
=+ ^= duy
?: =(%void fex)
?:(=(%void wux) [%0 0] [%1 1])
?:(=(%void wux) [%1 0] q.nor)
=+ [fex=(gain p.gen) wux=(lose p.gen)]
::
:: if either branch is impossible, eliminate it
:: (placing the conditional in a dynamic hint to preserve crashes)
::
=+ ^= [ned duy]
?- -
[%void %void] |+[%0 0]
[%void *] &+[%1 |]
[* %void] &+[%1 &]
* |+q.nor
==
=+ hiq=$(sut fex, gen q.gen)
=+ ran=$(sut wux, gen r.gen)
[(fork p.hiq p.ran ~) (cond duy q.hiq q.ran)]
=+ fol=(cond duy q.hiq q.ran)
[(fork p.hiq p.ran ~) ?.(ned fol [%11 [%toss q.nor] fol])]
::
[%wthx *]
:- (nice bool)
=+ fid=(find %read [[%& 1] q.gen])
~> %mean.'mint-fragment'
?> &(?=(%& -.fid) ?=(%& -.q.p.fid))
(~(fish ar `type`p.q.p.fid `skin`p.gen) (tend p.p.fid))
=+ fid=(fend %read [[%& 1] q.gen])
(~(fish ar `type`p.fid `skin`p.gen) q.fid)
::
[%fits *]
:- (nice bool)
@ -10173,12 +10207,8 @@
::
[%wthx *]
~> %mean.'mull-bonk-x'
=+ :- =+ (find %read [[%& 1] q.gen])
?> &(?=(%& -.-) ?=(%& -.q.p.-))
new=[type=p.q.p.- axis=(tend p.p.-)]
=+ (find(sut dox) %read [%& 1] q.gen)
?> &(?=(%& -.-) ?=(%& -.q.p.-))
old=[type=p.q.p.- axis=(tend p.p.-)]
=+ :- new=[type=p axis=q]:(fend %read [[%& 1] q.gen])
old=[type=p axis=q]:(fend(sut dox) %read [[%& 1] q.gen])
?> =(axis.old axis.new)
?> (nest(sut type.old) & type.new)
(beth bool)
@ -13107,6 +13137,12 @@
|= [%cnhp a=hoon b=spec]
[%make a b ~]
(rune hep %cnhp exqd)
::
:- '.'
%+ cook
|= [%cndt a=spec b=hoon]
[%make b a ~]
(rune dot %cndt exqc)
::
:- ':'
%+ cook

109
pkg/arvo/sys/lull.hoon
View File

@ -764,6 +764,7 @@
:: Messaging Tasks
::
:: %hear: packet from unix
:: %dear: lane from unix
:: %heed: track peer's responsiveness; gives %clog if slow
:: %jilt: stop tracking peer's responsiveness
:: %cork: request to delete message flow
@ -771,6 +772,7 @@
:: %kroc: request to delete specific message flows, from their bones
:: %plea: request to send message
:: %deep: deferred calls to %ames, from itself
:: %stun: STUN response (or failure), from unix
::
:: Remote Scry Tasks
::
@ -794,6 +796,7 @@
+$ task
$+ ames-task
$% [%hear =lane =blob]
[%dear =ship =lane]
[%heed =ship]
[%jilt =ship]
[%cork =ship]
@ -801,10 +804,13 @@
[%kroc bones=(list [ship bone])]
$>(%plea vane-task)
[%deep =deep]
[%stun =stun]
::
[%keen spar]
[%keen sec=(unit [idx=@ key=@]) spar]
[%chum spar]
[%yawn spar]
[%wham spar]
[%plug =path]
::
$>(%born vane-task)
$>(%init vane-task)
@ -826,6 +832,7 @@
:: %done: notify vane that peer (n)acked our message
:: %lost: notify vane that we crashed on %boon
:: %send: packet to unix
:: %nail: lanes to unix
::
:: Remote Scry Gifts
::
@ -834,6 +841,7 @@
:: System and Lifecycle Gifts
::
:: %turf: domain report, relayed from jael
:: %saxo: our sponsor list report
::
+$ gift
$% [%boon payload=*]
@ -841,10 +849,14 @@
[%done error=(unit error)]
[%lost ~]
[%send =lane =blob]
[%nail =ship lanes=(list lane)]
::
[%stub num=@ud key=@]
[%near spar dat=(unit (unit page))]
[%tune spar roar=(unit roar)]
::
[%turf turfs=(list turf)]
[%saxo sponsors=(list ship)]
==
::
:::: :: (1a2)
@ -882,7 +894,7 @@
+$ address @uxaddress
:: $verb: verbosity flag for ames
::
+$ verb ?(%snd %rcv %odd %msg %ges %for %rot %kay %fin)
+$ verb ?(%snd %rcv %odd %msg %ges %for %rot %kay %fin %sun)
:: $blob: raw atom to or from unix, representing a packet
::
+$ blob @uxblob
@ -902,6 +914,12 @@
:: payload: semantic message contents
::
+$ plea [vane=@tas =path payload=*]
::
+$ message
$% [%plea plea]
[%boon payload=*]
[%naxplanation =message-num =error]
==
:: $spar: pair of $ship and $path
::
:: Instead of fully qualifying a scry path, ames infers rift and
@ -911,12 +929,21 @@
:: $deep: deferred %ames call, from self, to keep +abet cores pure
::
+$ deep
$% [%nack =ship =nack=bone =message-blob]
$% [%nack =ship =nack=bone =message]
[%sink =ship =target=bone naxplanation=[=message-num =error]]
[%drop =ship =nack=bone =message-num]
[%cork =ship =bone]
[%kill =ship =bone]
==
:: $stun: STUN notifications, from unix
::
:: .lane is the latest cached lane in vere, from the point of view of .ship
::
+$ stun
$% [%stop =ship =lane] :: succesful STUN response, stop %ping app
[%fail =ship =lane] :: failure to STUN, re-enable %ping app
[%once =ship =lane] :: new lane discovered, notify ping %app
==
:: +| %atomics
::
+$ bone @udbone
@ -930,10 +957,12 @@
:: $hoot: request packet payload
:: $yowl: serialized response packet payload
:: $hunk: a slice of $yowl fragments
:: $lock: keys for remote scry
::
+$ hoot @uxhoot
+$ yowl @uxyowl
+$ hunk [lop=@ len=@]
+$ lock [idx=@ key=@]
::
:: +| %kinetics
:: $dyad: pair of sender and receiver ships
@ -991,7 +1020,9 @@
packets=(set =blob)
heeds=(set duct)
keens=(jug path duct)
chums=(jug path duct)
==
+$ chain ((mop ,@ ,[key=@ =path]) lte)
:: $peer-state: state for a peer with known life and keys
::
:: route: transport-layer destination for packets to peer
@ -1031,6 +1062,7 @@
closing=(set bone)
corked=(set bone)
keens=(map path keen-state)
=chain
==
+$ keen-state
$+ keen-state
@ -1155,7 +1187,7 @@
$+ message-pump-state
$: current=_`message-num`1
next=_`message-num`1
unsent-messages=(qeu message-blob)
unsent-messages=(qeu message)
unsent-fragments=(list static-fragment)
queued-message-acks=(map message-num ack)
=packet-pump-state
@ -2725,6 +2757,64 @@
+$ bitt (map duct (pair ship path)) :: incoming subs
+$ boat (map [=wire =ship =term] [acked=? =path]) :: outgoing subs
+$ boar (map [=wire =ship =term] nonce=@) :: and their nonces
::
+$ fans ((mop @ud (pair @da (each page @uvI))) lte)
+$ plot
$: bob=(unit @ud)
fan=fans
==
+$ stats :: statistics
$: change=@ud :: processed move count
eny=@uvJ :: entropy
time=@da :: current event time
==
+$ hutch [rev=@ud idx=@ud key=@]
::
+$ farm
$+ farm
$~ [%plot ~ ~]
$% [%coop p=hutch q=(map path plot)]
[%plot p=(unit plot) q=(map @ta farm)]
==
::
+$ egg :: migratory agent state
$% [%nuke sky=(map spur @ud) cop=(map coop hutch)] :: see /sys/gall $yoke
$: %live
control-duct=duct
run-nonce=@t
sub-nonce=@
=stats
=bitt
=boat
=boar
code=~
old-state=[%| vase]
=beak
marks=(map duct mark)
sky=farm
ken=(jug spar:ames wire)
pen=(jug spar:ames wire)
gem=(jug coop [path page])
== ==
+$ egg-any $%([%15 egg-15] [%16 egg])
+$ egg-15
$% [%nuke sky=(map spur @ud)]
$: %live
control-duct=duct
run-nonce=@t
sub-nonce=@
=stats
=bitt
=boat
=boar
code=~
old-state=[%| vase]
=beak
marks=(map duct mark)
sky=(map spur plot)
ken=(jug spar:ames wire)
== ==
::
+$ bowl :: standard app state
$: $: our=ship :: host
src=ship :: guest
@ -2733,9 +2823,7 @@
== ::
$: wex=boat :: outgoing subs
sup=bitt :: incoming subs
$= sky :: scry bindings
%+ map path ::
((mop @ud (pair @da (each page @uvI))) lte) ::
sky=(map path fans) :: scry bindings
== ::
$: act=@ud :: change number
eny=@uvJ :: entropy
@ -2763,6 +2851,7 @@
:: TODO: add more flags?
::
+$ verb ?(%odd)
+$ coop spur
::
:: +agent: app core
::
@ -2779,6 +2868,12 @@
[%grow =spur =page]
[%tomb =case =spur]
[%cull =case =spur]
::
[%tend =coop =path =page]
[%germ =coop]
[%snip =coop]
::
[%keen secret=? spar:ames]
==
+$ task
$% [%watch =path]

1258
pkg/arvo/sys/vane/ames.hoon
View File

File diff suppressed because it is too large Load Diff

3
pkg/arvo/sys/vane/behn.hoon
View File

@ -243,11 +243,12 @@
=* lot=coin $/r.bem
=* tyl s.bem
::
:: only respond for the local identity, %$ desk, current timestamp
:: only respond for the local identity, %$ desk, current timestamp, root gang
::
?. ?& =(&+our why)
=([%$ %da now] lot)
=(%$ syd)
=([~ ~] lyc)
==
~
:: /bx//whey (list mass) memory usage labels

3
pkg/arvo/sys/vane/clay.hoon
View File

@ -1518,7 +1518,7 @@
[%c care (scot case) desk path]
:- [time path]
%- emil
:~ [hen %pass wire %a %keen ship path]
:~ [hen %pass wire %a %keen ~ ship path]
[hen %pass wire %b %wait time]
==
::
@ -5934,6 +5934,7 @@
::
=/ for=(unit ship) ?~(lyc ~ ?~(u.lyc ~ `n.u.lyc))
?: &(=(our his) ?=(?(%d %x) ren) =(%$ syd) =([%da now] u.luk))
?. =([~ ~] lyc) ~
?- ren
%d (read-buc-d tyl)
%x (read-buc-x tyl)

5
pkg/arvo/sys/vane/dill.hoon
View File

@ -146,7 +146,7 @@
++ sponsor
^- ship
=/ dat=(unit (unit cage))
(rof `[our ~ ~] /dill j/[[our sein/da/now] /(scot %p our)])
(rof [~ ~] /dill j/[[our sein/da/now] /(scot %p our)])
;;(ship q.q:(need (need dat)))
::
++ init :: initialize
@ -490,11 +490,12 @@
?. ?=(%& -.why) ~
=* his p.why
::
:: only respond for the local identity, %$ desk, current timestamp
:: only respond for the local identity, %$ desk, current timestamp, root gang
::
?. ?& =(&+our why)
=([%$ %da now] lot)
=(%$ syd)
=([~ ~] lyc)
==
~
:: /%x//whey (list mass) memory usage labels

415
pkg/arvo/sys/vane/eyre.hoon
View File

@ -366,6 +366,8 @@
}
button[type=submit] {
margin-top: 1rem;
}
button[type=submit], a.button {
font-size: 1rem;
padding: 0.5rem 1rem;
border-radius: 0.5rem;
@ -373,6 +375,7 @@
color: var(--white);
border: none;
font-weight: 600;
text-decoration: none;
}
input:invalid ~ button[type=submit] {
border-color: currentColor;
@ -380,7 +383,7 @@
color: var(--gray-400);
pointer-events: none;
}
span.guest {
span.guest, span.guest a {
color: var(--gray-400);
}
span.failed {
@ -456,8 +459,6 @@
name.focus();
}
function doEauth() {
console.log('mb get value from event', event);
console.log('compare', name.value, our);
if (name.value == our) {
event.preventDefault();
goLocal();
@ -468,15 +469,16 @@
;body
=class "{?:(=(`& eauth) "eauth" "local")}"
=onload "setup({?:(=(`& eauth) "true" "false")})"
;nav
;div.local(onclick "goLocal()"):"Local"
;div.eauth(onclick "goEauth()"):"EAuth"
==
;div#local
;p:"Urbit ID"
;input(value "{(scow %p our)}", disabled "true", class "mono");
;p:"Access Key"
;+ ?: =(%ours -.identity)
;div
;p:"Already authenticated"
;a.button/"{(trip (fall redirect-url '/'))}":"Continue"
==
;form(action "/~/login", method "post", enctype "application/x-www-form-urlencoded")
;p:"Access Key"
;input
=type "password"
=name "password"
@ -519,14 +521,12 @@
;button(name "eauth", type "submit"):"Continue"
==
==
;* ?. ?=(%fake -.identity) ~
=+ id=(trim 29 (scow %p who.identity))
;* ?: ?=(%ours -.identity) ~
=+ as="proceed as{?:(?=(%fake -.identity) " guest" "")}"
;+ ;span.guest.mono
; Current guest identity:
;br;
; {p.id}
;br;
; {q.id}
; Or try to
;a/"{(trip (fall redirect-url '/'))}":"{as}"
; .
==
==
;script:'''
@ -789,8 +789,7 @@
%. (~(put by connections.state) duct connection)
(trace 2 |.("{<duct>} creating local"))
::
:_ state
(subscribe-to-app [%ours ~] app.act inbound-request.connection)
(request-to-app [%ours ~] app.act inbound-request.connection)
:: +request: starts handling an inbound http request
::
++ request
@ -899,6 +898,15 @@
=- (fall - '*')
(get-header:http 'access-control-request-headers' headers)
==
:: handle HTTP scries
::
:: TODO: ideally this would look more like:
::
:: ?^ p=(parse-http-scry url.request)
:: (handle-http-scry authenticated p request)
::
?: =('/_~_/' (end [3 5] url.request))
(handle-http-scry authenticated request)
:: handle requests to the cache
::
=/ entry (~(get by cache.state) url.request)
@ -909,12 +917,12 @@
%gen
=/ bek=beak [our desk.generator.action da+now]
=/ sup=spur path.generator.action
=/ ski (rof ~ /eyre %ca bek sup)
=/ ski (rof [~ ~] /eyre %ca bek sup)
=/ cag=cage (need (need ski))
?> =(%vase p.cag)
=/ gat=vase !<(vase q.cag)
=/ res=toon
%- mock :_ (look rof ~ /eyre)
%- mock :_ (look rof ?.(authenticated ~ [~ ~]) /eyre)
:_ [%9 2 %0 1] |.
%+ slam
%+ slam gat
@ -964,8 +972,7 @@
==
::
%app
:_ state
(subscribe-to-app identity app.action inbound-request.connection)
(request-to-app identity app.action inbound-request.connection)
::
%authentication
(handle-request:authentication secure host address [suv identity] request)
@ -1005,6 +1012,44 @@
=/ nom=@p
?+(-.identity who.identity %ours our)
(as-octs:mimes:html (scot %p nom))
:: +handle-http-scry: respond with scry result
::
++ handle-http-scry
|= [authenticated=? =request:http]
|^ ^- (quip move server-state)
?. authenticated (error-response 403 ~)
?. =(%'GET' method.request)
(error-response 405 "may only GET scries")
=/ req (parse-request-line url.request)
=/ fqp (fully-qualified site.req)
=/ mym (scry-mime now rof ext.req site.req)
?: ?=(%| -.mym) (error-response 500 p.mym)
=* mime p.mym
%- handle-response
:* %start
:- status-code=200
^= headers
:~ ['content-type' (rsh 3 (spat p.mime))]
['content-length' (crip (format-ud-as-integer p.q.mime))]
['cache-control' ?:(fqp 'max-age=31536000' 'no-cache')]
==
data=[~ q.mime]
complete=%.y
==
::
++ fully-qualified
|= a=path
^- ?
?. ?=([%'_~_' @ @ @ *] a) %.n
=/ vez (vang | (en-beam [our %base da+now] ~))
?= [~ [^ ^ ^ *]] (rush (spat t.t.a) ;~(pfix fas gash:vez))
::
++ error-response
|= [status=@ud =tape]
^- (quip move server-state)
%^ return-static-data-on-duct status 'text/html'
(error-page status authenticated url.request tape)
--
:: +handle-cache-req: respond with cached value, 404 or 500
::
++ handle-cache-req
@ -1092,7 +1137,7 @@
++ do-scry
|= [care=term =desk =path]
^- (unit (unit cage))
(rof ~ /eyre care [our desk da+now] path)
(rof [~ ~] /eyre care [our desk da+now] path)
::
++ error-response
|= [status=@ud =tape]
@ -1100,11 +1145,24 @@
%^ return-static-data-on-duct status 'text/html'
(error-page status authenticated url.request tape)
--
:: +subscribe-to-app: subscribe to app and poke it with request data
:: +request-to-app: subscribe to app and poke it with request data
::
++ subscribe-to-app
++ request-to-app
|= [=identity app=term =inbound-request:eyre]
^- (list move)
^- (quip move server-state)
:: if the agent isn't running, we synchronously serve a 503
::
?. !<(? q:(need (need (rof [~ ~] /eyre %gu [our app da+now] /$))))
%^ return-static-data-on-duct 503 'text/html'
%: error-page
503
?=(%ours -.identity)
url.request.inbound-request
"%{(trip app)} not running"
==
:: otherwise, subscribe to the agent and poke it with the request
::
:_ state
:~ %+ deal-as
/watch-response/[eyre-id]
[identity our app %watch /http-response/[eyre-id]]
@ -1184,33 +1242,14 @@
=/ with-eauth=(unit ?)
?: =(~ eauth-url:eauth) ~
`?=(^ (get-header:http 'eauth' args.request-line))
:: if we received a simple get: redirect if logged in, otherwise
:: show login page
:: if we received a simple get: show the login page
::
::NOTE we never auto-redirect, to avoid redirect loops with apps that
:: send unprivileged users to the login screen
::
?: =('GET' method.request)
?. (request-is-logged-in request)
%^ return-static-data-on-duct 200 'text/html'
(login-page redirect our identity with-eauth %.n)
=/ session-id (session-id-from-request request)
:: session-id should always be populated here since we are logged in
?~ session-id
%^ return-static-data-on-duct 200 'text/html'
(login-page redirect our identity with-eauth %.n)
=/ cookie-line=@t
(session-cookie-string u.session-id &)
=/ actual-redirect
?~ redirect '/'
?:(=(u.redirect '') '/' u.redirect)
%- handle-response
:* %start
:- status-code=303
^= headers
:~ ['location' actual-redirect]
['set-cookie' cookie-line]
==
data=~
complete=%.y
==
%^ return-static-data-on-duct 200 'text/html'
(login-page redirect our identity with-eauth %.n)
:: if we are not a post, return an error
::
?. =('POST' method.request)
@ -1506,7 +1545,7 @@
++ code
^- @ta
=/ res=(unit (unit cage))
(rof ~ /eyre %j [our %code da+now] /(scot %p our))
(rof [~ ~] /eyre %j [our %code da+now] /(scot %p our))
(rsh 3 (scot %p ;;(@ q.q:(need (need res)))))
:: +session-cookie-string: compose session cookie
::
@ -1717,7 +1756,7 @@
=/ =wire /eauth/keen/(scot %p ship)/(scot %uv nonce)
=. time (sub time (mod time ~h1))
=/ =spar:ames [ship /e/x/(scot %da time)//eauth/url]
[duct %pass wire %a ?-(kind %keen keen+spar, %yawn yawn+spar)]
[duct %pass wire %a ?-(kind %keen keen+[~ spar], %yawn yawn+spar)]
::
++ send-boon
|= boon=eauth-boon
@ -2112,7 +2151,7 @@
duct-to-key.channel-state
(~(del by duct-to-key.channel-state.state) duct)
==
:: +set-timeout-timer-for: sets a timeout timer on a channel
:: +update-timeout-timer-for: sets a timeout timer on a channel
::
:: This creates a channel if it doesn't exist, cancels existing timers
:: if they're already set (we cannot have duplicate timers), and (if
@ -2180,62 +2219,84 @@
[%b %rest expiration-time]
:: +on-get-request: handles a GET request
::
:: GET requests open a channel for the server to send events to the
:: client in text/event-stream format.
:: GET requests connect to a channel for the server to send events to
:: the client in text/event-stream format.
::
++ on-get-request
|= [channel-id=@t [session-id=@uv =identity] =request:http]
^- [(list move) server-state]
:: if there's no channel-id, we must 404
::TODO but arm description says otherwise?
:: if the channel doesn't exist, we cannot serve it.
:: this 404 also lets clients know if their channel was reaped since
:: they last connected to it.
::
?~ maybe-channel=(~(get by session.channel-state.state) channel-id)
?. (~(has by session.channel-state.state) channel-id)
%^ return-static-data-on-duct 404 'text/html'
(error-page 404 | url.request ~)
:: find the channel creator's identity, make sure it matches
::
?. =(identity identity.u.maybe-channel)
%^ return-static-data-on-duct 403 'text/html'
(error-page 403 | url.request ~)
:: find the requested "mode" and make sure it doesn't conflict
::
=/ mode=?(%json %jam)
(find-channel-mode %'GET' header-list.request)
?. =(mode mode.u.maybe-channel)
%^ return-static-data-on-duct 406 'text/html'
=; msg=tape (error-page 406 %.y url.request msg)
"channel already established in {(trip mode.u.maybe-channel)} mode"
:: when opening an event-stream, we must cancel our timeout timer
:: if there's no duct already bound. Else, kill the old request
:: and replace it
::
=^ cancel-moves state
?. ?=([%| *] state.u.maybe-channel)
:_ state
(cancel-timeout-move channel-id p.state.u.maybe-channel)^~
=/ cancel-heartbeat
?~ heartbeat.u.maybe-channel ~
:_ ~
%+ cancel-heartbeat-move channel-id
[date duct]:u.heartbeat.u.maybe-channel
=- [(weld cancel-heartbeat -<) ->]
(handle-response(duct p.state.u.maybe-channel) [%cancel ~])
:: the request may include a 'Last-Event-Id' header
::
=/ maybe-last-event-id=(unit @ud)
?~ maybe-raw-header=(get-header:http 'last-event-id' header-list.request)
~
(rush u.maybe-raw-header dum:ag)
:: flush events older than the passed in 'Last-Event-ID'
::
=? state ?=(^ maybe-last-event-id)
(acknowledge-events channel-id u.maybe-last-event-id)
:: combine the remaining queued events to send to the client
::
=/ event-replay=wall
=^ [exit=? =wall moves=(list move)] state
:: the request may include a 'Last-Event-Id' header
::
=/ maybe-last-event-id=(unit @ud)
?~ maybe-raw-header=(get-header:http 'last-event-id' header-list.request)
~
(rush u.maybe-raw-header dum:ag)
=/ channel
(~(got by session.channel-state.state) channel-id)
:: we put some demands on the get request, and may need to do some
:: cleanup for prior requests.
::
:: find the channel creator's identity, make sure it matches
::
?. =(identity identity.channel)
=^ mos state
%^ return-static-data-on-duct 403 'text/html'
(error-page 403 | url.request ~)
[[& ~ mos] state]
:: make sure the request "mode" doesn't conflict with a prior request
::
::TODO or could we change that on the spot, given that only a single
:: request will ever be listening to this channel?
?. =(mode mode.channel)
=^ mos state
%^ return-static-data-on-duct 406 'text/html'
=; msg=tape (error-page 406 %.y url.request msg)
"channel already established in {(trip mode.channel)} mode"
[[& ~ mos] state]
:: when opening an event-stream, we must cancel our timeout timer
:: if there's no duct already bound. else, kill the old request,
:: we will replace its duct at the end of this arm
::
=^ cancel-moves state
?: ?=([%& *] state.channel)
:_ state
(cancel-timeout-move channel-id p.state.channel)^~
=. duct-to-key.channel-state.state
(~(del by duct-to-key.channel-state.state) p.state.channel)
=/ cancel-heartbeat
?~ heartbeat.channel ~
:_ ~
%+ cancel-heartbeat-move channel-id
[date duct]:u.heartbeat.channel
=- [(weld cancel-heartbeat -<) ->]
(handle-response(duct p.state.channel) [%cancel ~])
:: flush events older than the passed in 'Last-Event-ID'
::
=? state ?=(^ maybe-last-event-id)
(acknowledge-events channel-id u.maybe-last-event-id)
::TODO that did not remove them from the channel queue though!
:: we may want to account for maybe-last-event-id, for efficiency.
:: (the client _should_ ignore events it heard previously if we do
:: end up re-sending them, but _requiring_ that feels kinda risky)
::
:: combine the remaining queued events to send to the client
::
=; event-replay=wall
[[| - cancel-moves] state]
%- zing
%- flop
=/ queue events.u.maybe-channel
=/ queue events.channel
=| events=(list wall)
|-
^+ events
@ -2247,9 +2308,10 @@
:: since conversion failure also gets caught during first receive.
:: we can't do anything about this, so consider it unsupported.
=/ said
(channel-event-to-tape u.maybe-channel request-id channel-event)
(channel-event-to-tape channel request-id channel-event)
?~ said $
$(events [(event-tape-to-wall id +.u.said) events])
?: exit [moves state]
:: send the start event to the client
::
=^ http-moves state
@ -2260,7 +2322,7 @@
['cache-control' 'no-cache']
['connection' 'keep-alive']
==
(wall-to-octs event-replay)
(wall-to-octs wall)
complete=%.n
==
:: associate this duct with this session key
@ -2290,7 +2352,7 @@
heartbeat (some [heartbeat-time duct])
==
::
[[heartbeat :(weld http-moves cancel-moves moves)] state]
[[heartbeat :(weld http-moves moves)] state]
:: +acknowledge-events: removes events before :last-event-id on :channel-id
::
++ acknowledge-events
@ -2311,6 +2373,8 @@
::
:: PUT requests send commands from the client to the server. We receive
:: a set of commands in JSON format in the body of the message.
:: channels don't exist until a PUT request is sent. it's valid for
:: this request to contain an empty list of commands.
::
++ on-put-request
|= [channel-id=@t =identity =request:http]
@ -2338,11 +2402,6 @@
?: ?=(%| -.maybe-requests)
%^ return-static-data-on-duct 400 'text/html'
(error-page 400 & url.request (trip p.maybe-requests))
:: while weird, the request list could be empty
::
?: =(~ p.maybe-requests)
%^ return-static-data-on-duct 400 'text/html'
(error-page 400 %.y url.request "empty list of actions")
:: check for the existence of the channel-id
::
:: if we have no session, create a new one set to expire in
@ -2687,7 +2746,7 @@
?~ sub
((trace 0 |.("no subscription for request-id {(scow %ud request-id)}")) ~)
=/ des=(unit (unit cage))
(rof ~ /eyre %gd [our app.u.sub da+now] /$)
(rof [~ ~] /eyre %gd [our app.u.sub da+now] /$)
?. ?=([~ ~ *] des)
((trace 0 |.("no desk for app {<app.u.sub>}")) ~)
`!<(=desk q.u.u.des)
@ -2723,7 +2782,7 @@
=* have=mark mark.event
=/ convert=(unit vase)
=/ cag=(unit (unit cage))
(rof ~ /eyre %cf [our desk.event da+now] /[have]/json)
(rof [~ ~] /eyre %cf [our desk.event da+now] /[have]/json)
?. ?=([~ ~ *] cag) ~
`q.u.u.cag
?~ convert
@ -2903,6 +2962,7 @@
=* session-id session-id.u.connection-state
=* sessions sessions.auth.state
=* inbound inbound-request.u.connection-state
=* headers headers.response-header.http-event
::
?. (~(has by sessions) session-id)
:: if the session has expired since the request was opened,
@ -2913,9 +2973,14 @@
|= =session
session(expiry-time (add now session-timeout))
=- response-header.http-event(headers -)
%^ set-header:http 'set-cookie'
(session-cookie-string session-id &)
headers.response-header.http-event
=/ cookie=(pair @t @t)
['set-cookie' (session-cookie-string session-id &)]
|-
?~ headers
[cookie ~]
?: &(=(key.i.headers p.cookie) =(value.i.headers q.cookie))
headers
[i.headers $(headers t.headers)]
::
=* connection u.connection-state
::
@ -3021,6 +3086,7 @@
::
?: ?| ?=([%'~' *] path.binding) :: eyre
?=([%'~_~' *] path.binding) :: runtime
?=([%'_~_' *] path.binding) :: scries
==
[| bindings.state]
[& (insert-binding [binding duct action] bindings.state)]
@ -3221,6 +3287,69 @@
:: need to issue a %leave after we've forgotten the identity with
:: which the subscription was opened.
/(scot %p ship)/[app]/(scot %p from)
::
++ scry-mime
|= [now=@da rof=roof ext=(unit @ta) pax=path]
|^ ^- (each mime tape)
:: parse
::
=/ u=(unit [view=term bem=beam])
?. ?=([@ @ @ @ *] pax) ~
?~ view=(slaw %tas i.t.pax) ~
?~ path=(expand-path t.t.pax) ~
?~ beam=(de-beam u.path) ~
`[u.view u.beam]
?~ u [%| "invalid scry path"]
:: perform scry
::
?~ res=(rof [~ ~] /eyre u.u) [%| "failed scry"]
?~ u.res [%| "no scry result"]
=* mark p.u.u.res
=* vase q.u.u.res
:: convert to mime via ext
::
=/ dysk (conversion-desk u.u)
?: ?=(%| -.dysk) [%| p.dysk]
=/ ext (fall ext %mime)
=/ mym (convert vase mark ext p.dysk)
?: ?=(%| -.mym) [%| p.mym]
=/ mym (convert p.mym ext %mime p.dysk)
?: ?=(%| -.mym) [%| p.mym]
[%& !<(mime p.mym)]
::
++ expand-path
|= a=path
^- (unit path)
=/ vez (vang | (en-beam [our %base da+now] ~))
(rush (spat a) (sear plex:vez (stag %clsg ;~(pfix fas poor:vez))))
::
++ conversion-desk
|= [view=term =beam]
^- (each desk tape)
?: =(%$ q.beam) [%& %base]
?+ (end 3 view) [%& %base]
%c
[%& q.beam]
%g
=/ res (rof [~ ~] /eyre %gd [our q.beam da+now] /$)
?. ?=([~ ~ *] res)
[%| "no desk for app {<q.beam>}"]
[%& !<(=desk q.u.u.res)]
==
::
++ convert
|= [=vase from=mark to=mark =desk]
^- (each ^vase tape)
?: =(from to) [%& vase]
=/ tub (rof [~ ~] /eyre %cc [our desk da+now] /[from]/[to])
?. ?=([~ ~ %tube *] tub)
[%| "no tube from {(trip from)} to {(trip to)}"]
=/ tube !<(tube:clay q.u.u.tub)
=/ res (mule |.((tube vase)))
?: ?=(%| -.res)
[%| "failed tube from {(trip from)} to {(trip to)}"]
[%& +.res]
--
--
:: end the =~
::
@ -3987,12 +4116,41 @@
[~ ~]
?. =(our who)
?. =([%da now] p.lot)
[~ ~]
~
~& [%r %scry-foreign-host who]
~
::
?: ?=([%eauth %url ~] tyl)
?. &(?=(%x ren) ?=(%$ syd)) ~
=* endpoint endpoint.auth.server-state.ax
?. ?=(%da -.p.lot) [~ ~]
:: we cannot answer for something prior to the last set time,
:: or something beyond the present moment.
::
?: ?| (lth q.p.lot time.endpoint)
(gth q.p.lot now)
==
~
:^ ~ ~ %noun
!> ^- (unit @t)
=< eauth-url:eauth:authentication
(per-server-event [eny *duct now rof] server-state.ax)
::
?: ?=([%cache @ @ ~] tyl)
?. &(?=(%x ren) ?=(%$ syd)) ~
=, server-state.ax
?~ aeon=(slaw %ud i.t.tyl) [~ ~]
?~ url=(slaw %t i.t.t.tyl) [~ ~]
?~ entry=(~(get by cache) u.url) ~
?. =(u.aeon aeon.u.entry) ~
?~ val=val.u.entry ~
?: &(auth.u.val !=([~ ~] lyc)) ~
``noun+!>(u.val)
:: private endpoints
?. ?=([~ ~] lyc) ~
?: &(?=(%x ren) ?=(%$ syd))
=, server-state.ax
?+ tyl [~ ~]
?+ tyl ~
[%$ %whey ~] =- ``mass+!>(`(list mass)`-)
:~ bindings+&+bindings.server-state.ax
auth+&+auth.server-state.ax
@ -4014,21 +4172,6 @@
%approved ``noun+!>((~(has in approved.cors-registry) u.origin))
%rejected ``noun+!>((~(has in rejected.cors-registry) u.origin))
==
::
[%eauth %url ~]
=* endpoint endpoint.auth.server-state.ax
?. ?=(%da -.p.lot) [~ ~]
:: we cannot answer for something prior to the last set time,
:: or something beyond the present moment.
::
?: ?| (lth q.p.lot time.endpoint)
(gth q.p.lot now)
==
~
:^ ~ ~ %noun
!> ^- (unit @t)
=< eauth-url:eauth:authentication
(per-server-event [eny *duct now rof] server-state.ax)
::
[%authenticated %cookie @ ~]
?~ cookies=(slaw %t i.t.t.tyl) [~ ~]
@ -4038,22 +4181,18 @@
(per-server-event [eny *duct now rof] server-state.ax)
%*(. *request:http header-list ['cookie' u.cookies]~)
::
[%cache @ @ ~]
?~ aeon=(slaw %ud i.t.tyl) [~ ~]
?~ url=(slaw %t i.t.t.tyl) [~ ~]
?~ entry=(~(get by cache) u.url) [~ ~]
?. =(u.aeon aeon.u.entry) [~ ~]
?~ val=val.u.entry [~ ~]
``noun+!>(u.val)
[%'_~_' *]
=/ mym (scry-mime now rof (deft:de-purl:html tyl))
?: ?=(%| -.mym) [~ ~]
``noun+!>(p.mym)
==
?. ?=(%$ ren)
[~ ~]
?+ syd [~ ~]
?. ?=(%$ ren) ~
?+ syd ~
%bindings ``noun+!>(bindings.server-state.ax)
%connections ``noun+!>(connections.server-state.ax)
%authentication-state ``noun+!>(auth.server-state.ax)
%channel-state ``noun+!>(channel-state.server-state.ax)
::
::
%host
%- (lift (lift |=(a=hart:eyre [%hart !>(a)])))
^- (unit (unit hart:eyre))

853
pkg/arvo/sys/vane/gall.hoon
View File

File diff suppressed because it is too large Load Diff

2
pkg/arvo/sys/vane/iris.hoon
View File

@ -395,7 +395,7 @@
::
?. ?=(%& -.why) ~
=* his p.why
?: &(?=(%x ren) =(tyl //whey))
?: &(?=(%x ren) =(tyl //whey) =([~ ~] lyc))
=/ maz=(list mass)
:~ nex+&+next-id.state.ax
outbound+&+outbound-duct.state.ax

7
pkg/arvo/sys/vane/jael.hoon
View File

@ -654,7 +654,10 @@
++ public-keys-give
|= [yen=(set duct) =public-keys-result]
|^
=+ yez=(sort ~(tap in yen) sorter)
=/ yaz %+ skid ~(tap in yen)
|= d=duct
&(?=([[%ames @ @ *] *] d) !=(%public-keys i.t.i.d))
=/ yez (weld p.yaz (sort q.yaz sorter))
|- ^+ this-su
?~ yez this-su
=* d i.yez
@ -1065,7 +1068,7 @@
::
:: XX review for security, stability, cases other than now
::
?. =(lot [%$ %da now]) ~
?. &(=(lot [%$ %da now]) =([~ ~] lyc)) ~
::
?: &(?=(%x ren) =(tyl //whey))
=/ maz=(list mass)

4
pkg/arvo/sys/vane/khan.hoon
View File

@ -72,7 +72,7 @@
++ get-dais
|= [=beak =mark rof=roof]
^- dais:clay
?~ ret=(rof ~ /khan %cb beak /[mark])
?~ ret=(rof [~ ~] /khan %cb beak /[mark])
~|(mark-unknown+mark !!)
?~ u.ret
~|(mark-invalid+mark !!)
@ -82,7 +82,7 @@
++ get-tube
|= [=beak =mark =out=mark rof=roof]
^- tube:clay
?~ ret=(rof ~ /khan %cc beak /[mark]/[out-mark])
?~ ret=(rof [~ ~] /khan %cc beak /[mark]/[out-mark])
~|(tube-unknown+[mark out-mark] !!)
?~ u.ret
~|(tube-invalid+[mark out-mark] !!)

3
pkg/arvo/sys/vane/lick.hoon
View File

@ -88,11 +88,12 @@
|= [lyc=gang pov=path car=term bem=beam]
^- (unit (unit cage))
|^
:: only respond for the local identity, current timestamp
:: only respond for the local identity, current timestamp, root gang
::
?. ?& =(our p.bem)
=(%$ q.bem)
=([%da now] r.bem)
=([~ ~] lyc)
==
~
?+ car ~

13
pkg/arvo/sys/zuse.hoon
View File

@ -4,7 +4,7 @@
=> ..lull
~% %zuse ..part ~
|%
++ zuse %412
++ zuse %411
:: :: ::
:::: :: :: (2) engines
:: :: ::
@ -4298,8 +4298,11 @@
~&(%base-64-padding-err-two ~)
=/ len (sub (mul 3 (div (add lat dif) 4)) dif)
:+ ~ len
%+ swp 3
(rep [0 6] (flop (weld dat (reap dif 0))))
=/ res (rsh [1 dif] (rep [0 6] (flop dat)))
=/ amt (met 3 res)
:: left shift trailing zeroes in after byte swap
=/ trl ?: (lth len amt) 0 (sub len amt)
(lsh [3 trl] (swp 3 res))
--
--
::
@ -4777,7 +4780,7 @@
=+ spa=;~(pose comt whit)
%+ knee *manx |. ~+
%+ ifix
[;~(plug (punt decl) (star spa)) (star spa)]
[;~(plug (more spa decl) (star spa)) (star spa)]
;~ pose
%+ sear |=([a=marx b=marl c=mane] ?.(=(c n.a) ~ (some [a b])))
;~(plug head many tail)
@ -5253,7 +5256,7 @@
|= [rof=roof pov=path our=ship now=@da who=ship]
;; ship
=< q.q %- need %- need
(rof ~ pov %j `beam`[[our %sein %da now] /(scot %p who)])
(rof [~ ~] pov %j `beam`[[our %sein %da now] /(scot %p who)])
--
:: middle core: stateless queries for default numeric sponsorship
::

10
pkg/arvo/ted/aqua/ames.hoon
View File

@ -26,11 +26,13 @@
^- (list card:agent:gall)
=/ rcvr=ship (lane-to-ship lan)
=/ hear-lane (ship-to-lane sndr)
=/ [ames=? =packet] (decode-packet pac)
?: &(!ames !resp==(& (cut 0 [2 1] pac)))
=/ [=peep =purr] (decode-request-info `@ux`(rsh 3^64 content.packet))
=/ =shot (sift-shot pac)
?: &(!sam.shot req.shot) :: is fine request
=/ [%0 =peep] (sift-wail `@ux`content.shot)
%+ emit-aqua-events our
[%read [rcvr path.peep] [hear-lane num.peep]]~
:_ ~
:- %read
[[[rcvr rcvr-tick.shot] path.peep] [hear-lane sndr-tick.shot] num.peep]
%+ emit-aqua-events our
[%event rcvr /a/newt/0v1n.2m9vh %hear hear-lane pac]~
:: +lane-to-ship: decode a ship from an aqua lane

32
pkg/arvo/ted/aqua/dill.hoon
View File

@ -14,20 +14,24 @@
|= [who=@p way=wire %blit blits=(list blit:dill)]
^- (list card:agent:gall)
=/ last-line
%+ roll blits
|= [b=blit:dill line=tape]
?- -.b
%put (tape p.b)
%klr (tape (zing (turn p.b tail)))
%nel ~& "{<who>}: {line}" ""
%hop line
%bel line
%clr ""
%sag ~& [%save-jamfile-to p.b] line
%sav ~& [%save-file-to p.b] line
%url ~& [%activate-url p.b] line
%wyp ""
==
|^ (roll blits ha-blit)
::
++ ha-blit
|= [b=blit:dill line=tape]
?- -.b
%put (tape p.b)
%klr (tape (zing (turn p.b tail)))
%mor `tape`(roll p.b ha-blit)
%nel ~& "{<who>}: {line}" ""
%hop line
%bel line
%clr ""
%sag ~& [%save-jamfile-to p.b] line
%sav ~& [%save-file-to p.b] line
%url ~& [%activate-url p.b] line
%wyp ""
==
--
~? !=(~ last-line) last-line
~
--

27
pkg/arvo/ted/keen-shut.hoon Normal file
View File

@ -0,0 +1,27 @@
/- spider
/+ strandio
=, strand=strand:spider
^- thread:spider
|= arg=vase
=/ m (strand ,vase)
^- form:m
=+ !<([~ =spar:ames] arg)
;< ~ bind:m
(keen-shut:strandio /keen spar)
;< [* dat=(unit (unit page))] bind:m
(take-near:strandio /keen)
?~ dat
~& mysterious/~
(pure:m !>(~))
?~ u.dat
~& non-existent/~
(pure:m !>(~))
::
;< =bowl:spider bind:m get-bowl:strandio
=+ .^ =dais:clay %cb
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[p.u.u.dat]
==
=/ res (mule |.((vale.dais q.u.u.dat)))
?. ?=(%| -.res)
(pure:m p.res)
~|(%keen-mark-fail (mean leaf+"-keen: ames vale fail {<mark>}" p.res))

67
pkg/arvo/ted/ph/group-rejoin.hoon
View File

@ -1,67 +0,0 @@
/- spider
/+ *ph-io
=>
|%
++ wait-for-agent-start
|= [=ship agent=term]
=/ m (strand:spider ,~)
^- form:m
=* loop $
;< [her=^ship =unix-effect] bind:m take-unix-effect
?: (is-dojo-output:util ship her unix-effect "activated app base/{(trip agent)}")
(pure:m ~)
loop
::
++ start-agent
|= [=ship agent=term]
=/ m (strand:spider ,~)
^- form:m
=* loop $
;< ~ bind:m (dojo ship "|start {<agent>}")
;< ~ bind:m (wait-for-agent-start ship agent)
(pure:m ~)
::
++ wait-for-goad
|= =ship
=/ m (strand:spider ,~)
^- form:m
=* loop $
;< [her=^ship =unix-effect] bind:m take-unix-effect
?: (is-dojo-output:util ship her unix-effect "p=%hood q=%bump")
(pure:m ~)
loop
::
++ start-group-agents
|= =ship
=/ m (strand:spider ,~)
^- form:m
;< ~ bind:m (start-agent ship %group-store)
(pure:m ~)
--
=, strand=strand:spider
^- thread:spider
|= args=vase
=/ m (strand ,vase)
;< ~ bind:m start-azimuth
;< ~ bind:m (spawn ~bud)
;< ~ bind:m (spawn ~marbud)
;< ~ bind:m (spawn ~zod)
;< ~ bind:m (spawn ~marzod)
;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m (init-ship ~marbud |)
;< ~ bind:m (wait-for-goad ~marbud)
;< ~ bind:m (init-ship ~zod |)
;< ~ bind:m (init-ship ~marzod |)
;< ~ bind:m (wait-for-goad ~marzod)
;< ~ bind:m (start-group-agents ~marbud)
;< ~ bind:m (start-group-agents ~marzod)
;< ~ bind:m (dojo ~marbud ":group-store|create 'test-group'")
;< ~ bind:m (wait-for-output ~marbud ">=")
;< ~ bind:m (sleep ~s1)
;< ~ bind:m (breach-and-hear ~marzod ~marbud)
;< ~ bind:m (init-ship ~marzod |)
;< ~ bind:m (wait-for-goad ~marzod)
;< ~ bind:m (start-group-agents ~marzod)
;< ~ bind:m (sleep ~s3)
;< ~ bind:m end
(pure:m *vase)

4
pkg/arvo/ted/ph/keen.hoon
View File

@ -7,7 +7,7 @@
;< ~ bind:m start-simple
;< ~ bind:m (init-ship ~bud &)
;< ~ bind:m (init-ship ~dev &)
;< ~ bind:m (dojo ~bud "-keen /cx/~dev/kids/1/desk/bill")
;< ~ bind:m (wait-for-output ~bud "[ ~")
;< ~ bind:m (dojo ~bud "-keen ~dev /c/x/1/kids/sys/kelvin")
;< ~ bind:m (wait-for-output ~bud "kal=[lal=%zuse num={(scow %ud zuse)}]")
;< ~ bind:m end
(pure:m *vase)

66
pkg/arvo/ted/ph/lib-hooks.hoon
View File

@ -1,66 +0,0 @@
/- spider
/+ io=ph-io, *strandio
=>
=, io
|%
++ strand strand:spider
++ start-agents
|= =ship
=/ m (strand ,~)
;< ~ bind:m (dojo ship "|start %graph-store")
;< ~ bind:m (dojo ship "|start %graph-push-hook")
;< ~ bind:m (dojo ship "|start %graph-pull-hook")
;< ~ bind:m (dojo ship "|start %group-store")
;< ~ bind:m (dojo ship "|start %group-push-hook")
;< ~ bind:m (dojo ship "|start %group-pull-hook")
;< ~ bind:m (dojo ship "|start %metadata-store")
;< ~ bind:m (dojo ship "|start %metadata-hook")
;< ~ bind:m (sleep `@dr`300)
(pure:m ~)
::
++ make-link
|= [title=@t url=@t]
=/ m (strand ,~)
;< ~ bind:m (dojo ~bud ":graph-store|add-post [~bud %test] ~[[%text '{(trip title)}'] [%url '{(trip url)}']]")
(pure:m ~)
--
^- thread:spider
|= vase
=/ m (strand ,vase)
;< ~ bind:m start-azimuth
;< ~ bind:m (spawn ~bud)
;< ~ bind:m (spawn ~dev)
;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m (init-ship ~dev |)
;< ~ bind:m (start-agents ~bud)
;< ~ bind:m (start-agents ~dev)
;< ~ bind:m (send-hi ~bud ~dev)
;< ~ bind:m (dojo ~bud "-graph-create [%create [~bud %test] 'test' '' `%graph-validator-link [%policy [%open ~ ~]] 'link']")
;< ~ bind:m (sleep ~s5)
;< ~ bind:m (dojo ~dev "-graph-join [%join [~bud %test] ~bud]")
;< ~ bind:m (sleep ~s5)
;< ~ bind:m (send-hi ~bud ~dev)
;< ~ bind:m (poke-our %aqua noun+!>([%pause-events ~[~dev]]))
;< ~ bind:m (make-link 'one' 'one')
;< ~ bind:m (make-link 'two' 'one')
;< ~ bind:m (make-link 'thre' 'one')
;< ~ bind:m (make-link 'four' 'one')
;< ~ bind:m (make-link 'five' 'one')
;< ~ bind:m (make-link 'six' 'one')
;< ~ bind:m (make-link 'seven' 'one')
;< ~ bind:m (sleep ~s40)
:: five unacked events is sufficent to cause a clog, and by extension a
:: %kick
;< ~ bind:m (poke-our %aqua noun+!>([%unpause-events ~[~dev]]))
;< ~ bind:m (sleep ~s10)
;< ~ bind:m (make-link 'eight' 'one')
;< ~ bind:m (make-link 'nine' 'one')
;< ~ bind:m (sleep ~s10)
;< ~ bind:m (dojo ~dev ":graph-pull-hook +dbug %bowl")
;< ~ bind:m (dojo ~dev ":graph-store +dbug")
;< ~ bind:m (dojo ~bud ":graph-push-hook +dbug %bowl")
;< ~ bind:m (dojo ~bud ":graph-store +dbug")
;< ~ bind:m end
(pure:m *vase)
::(pure:m *vase)

70
pkg/arvo/ted/ph/tend.hoon Normal file
View File

@ -0,0 +1,70 @@
/- spider
/+ *ph-io, strandio
/* tend-agent %hoon /tests/app/tend/hoon
=, strand=strand:spider
=< all
|%
++ tend
|= zuse=@ud
=/ m (strand ,~)
;< ~ bind:m (dojo ~bud ":tend [%tend /foo /baz %kelvin %zuse {(scow %ud zuse)}]")
;< ~ bind:m (sleep:strandio ~s2)
;< ~ bind:m (dojo ~bud ":tend +dbug %bowl")
(pure:m ~)
::
++ keen-wait-for-result
|= [cas=@ud zuse=@ud]
=/ m (strand ,~)
;< ~ bind:m (dojo ~dev ":tend [%keen ~bud {(scow %ud cas)} /tend//foo/baz]")
;< ~ bind:m (wait-for-output ~dev "kal=[lal=%zuse num={(scow %ud zuse)}]")
(pure:m ~)
::
++ setup
=/ m (strand ,~)
;< ~ bind:m start-simple
:: testing usual case
;< ~ bind:m (init-ship ~bud &)
;< ~ bind:m (init-ship ~dev &)
;< ~ bind:m (dojo ~bud "|mount %base")
;< ~ bind:m (dojo ~dev "|mount %base")
;< ~ bind:m (copy-file ~bud /app/tend/hoon tend-agent)
;< ~ bind:m (copy-file ~dev /app/tend/hoon tend-agent)
;< ~ bind:m (dojo ~bud "|start %tend")
;< ~ bind:m (dojo ~dev "|start %tend")
(pure:m ~)
::
++ all
^- thread:spider
|= vase
=/ m (strand ,vase)
;< ~ bind:m test-normal
;< ~ bind:m test-larval-ames
(pure:m *vase)
::
++ test-larval-ames
=/ m (strand ,~)
;< ~ bind:m setup
;< ~ bind:m (dojo ~bud ":tend [%germ /foo]")
;< ~ bind:m (sleep:strandio ~s2)
;< ~ bind:m (tend zuse)
;< ~ bind:m (keen-wait-for-result 0 zuse)
=/ zuse (dec zuse)
;< ~ bind:m (tend zuse)
;< ~ bind:m (keen-wait-for-result 1 zuse)
;< ~ bind:m end
(pure:m ~)
::
++ test-normal
=/ m (strand ,~)
;< ~ bind:m setup
;< ~ bind:m (send-hi ~bud ~dev) :: make sure both ames have metamorphosed
;< ~ bind:m (dojo ~bud ":tend [%germ /foo]")
;< ~ bind:m (sleep:strandio ~s2)
;< ~ bind:m (tend zuse)
;< ~ bind:m (keen-wait-for-result 0 zuse)
=/ zuse (dec zuse)
;< ~ bind:m (tend zuse)
;< ~ bind:m (keen-wait-for-result 1 zuse)
;< ~ bind:m end
(pure:m ~)
--

17
pkg/arvo/ted/test.hoon
View File

@ -17,14 +17,14 @@
::
++ run-test
|= [pax=path test=test-func]
^- [ok=? =tang]
^- [ok=? output=tang result=tang]
=+ name=(spud pax)
=+ run=(mule test)
?- -.run
%| |+(welp p.run leaf+"CRASHED {name}" ~)
%| |+[p.run [leaf+"CRASHED {name}" ~]]
%& ?: =(~ p.run)
&+[leaf+"OK {name}"]~
|+(flop `tang`[leaf+"FAILED {name}" p.run])
&+[p.run [leaf+"OK {name}" ~]]
|+[p.run [leaf+"FAILED {name}" ~]]
==
:: +resolve-test-paths: add test names to file paths to form full identifiers
::
@ -105,6 +105,8 @@
~[/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/tests]
:: else cast path to ~[path] if needed
::
?~ +.q.arg
~[/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/tests]
?@ +<.q.arg
[(tail !<([~ path] arg)) ~]
(tail !<([~ (list path)] arg))
@ -119,7 +121,7 @@
?^ fiz
;< cor=(unit vase) bind:m (build-file:strandio beam.i.fiz)
?~ cor
~> %slog.0^leaf+"FAILED {(spud s.beam.i.fiz)} (build)"
~> %slog.3^leaf+"FAILED {(spud s.beam.i.fiz)} (build)"
gather-tests(fiz t.fiz, build-ok |)
~> %slog.0^leaf+"built {(spud s.beam.i.fiz)}"
=/ arms=(list test-arm) (get-test-arms u.cor)
@ -135,5 +137,6 @@
|= [[=path =test-func] ok=_build-ok]
^+ ok
=/ res (run-test path test-func)
%- (slog (flop tang.res))
&(ok ok.res)
%- (%*(. slog pri ?:(ok.res 0 3)) output.res)
%- (%*(. slog pri ?:(ok.res 0 3)) result.res)
&(ok ok.res)

8
pkg/base-dev/lib/ph/io.hoon
View File

@ -256,6 +256,14 @@
;< ~ bind:m (send-events (insert-files:util her desk [pax warped] ~))
(pure:m warped)
::
++ copy-file
=/ m (strand ,~)
|= [her=ship pax=path file=@t]
^- form:m
;< ~ bind:m
(send-events (insert-files:util her %base [pax file] ~))
(sleep ~s1)
::
:: Check /sur/aquarium/hoon on the given has the given contents.
::
++ check-file-touched

23
pkg/base-dev/lib/ph/util.hoon
View File

@ -62,15 +62,26 @@
::TODO should be rename -dill-output
++ is-dojo-output
|= [who=ship her=ship uf=unix-effect what=tape]
|^
?& =(who her)
?=(%blit -.q.uf)
::
%+ lien p.q.uf
|= =blit:dill
?. ?=(%put -.blit)
|
!=(~ (find what p.blit))
(lien p.q.uf handle-blit)
==
::
++ handle-blit
|= =blit:dill
^- ?
?: ?=(%mor -.blit)
(lien p.blit handle-blit)
?+ -.blit |
%put !=(~ (find what p.blit))
::
%klr
%+ lien p.blit
|= [* q=(list @c)]
!=(~ (find what q))
==
--
::
:: Test is successful if +is-dojo-output
::

22
pkg/base-dev/lib/strandio.hoon
View File

@ -197,6 +197,20 @@
`[%done +>.sign-arvo.u.in.tin]
==
::
++ take-near
|= =wire
=/ m (strand ,[spar:ames (unit (unit page))])
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
::
[~ %sign * %ames %near ^ *]
?. =(wire wire.u.in.tin)
`[%skip ~]
`[%done +>.sign-arvo.u.in.tin]
==
::
++ take-poke-ack
|= =wire
=/ m (strand ,~)
@ -335,7 +349,13 @@
|= [=wire =spar:ames]
=/ m (strand ,~)
^- form:m
(send-raw-card %pass wire %arvo %a %keen spar)
(send-raw-card %pass wire %arvo %a %keen ~ spar)
::
++ keen-shut
|= [=wire =spar:ames]
=/ m (strand ,~)
^- form:m
(send-raw-card %pass wire %keen & spar)
::
++ sleep
|= for=@dr

22
pkg/base-dev/mar/kiln/approve-merge.hoon Normal file
View File

@ -0,0 +1,22 @@
::
:::: /hoon/approve-merge/kiln/mar
::
/- h=hood
|_ req=[sync-record:h approve=?]
::
++ grow
|%
++ noun req
--
++ grab
|%
++ noun ,[sync-record:h approve=?]
++ json
=, dejs:format
%- ot
:~ [%sync (ot syd+so her+(se %p) sud+so ~)]
[%approve bo]
==
--
++ grad %noun
--

16
pkg/base-dev/mar/kiln/jump-ask.hoon Normal file
View File

@ -0,0 +1,16 @@
::
:::: /hoon/jump-ask/kiln/mar
::
/? 310
|_ req=[old=dock new=dock]
::
++ grow
|%
++ noun req
--
++ grab
|%
++ noun ,[dock dock]
--
++ grad %noun
--

22
pkg/base-dev/mar/kiln/jump-opt.hoon Normal file
View File

@ -0,0 +1,22 @@
::
:::: /hoon/jump-opt/kiln/mar
::
|_ req=[old=dock new=dock yea=?]
::
++ grow
|%
++ noun req
--
++ grab
|%
++ noun ,[dock dock ?]
++ json
=, dejs:format
%- ot
:~ [%old (ot ship+(se %p) desk+so ~)]
[%new (ot ship+(se %p) desk+so ~)]
[%yea bo]
==
--
++ grad %noun
--

43
pkg/base-dev/mar/kiln/jump.hoon Normal file
View File

@ -0,0 +1,43 @@
::
:::: /hoon/jump/kiln/mar
::
/- h=hood
|_ jum=jump:h
::
++ grow
|%
++ noun jum
++ json
=, enjs:format
|^ ^- ^json
?- -.jum
%add
%+ frond 'add'
(pairs ['old' (en-dock old.jum)] ['new' (en-dock new.jum)] ~)
::
%yea
%+ frond 'yea'
(pairs ['old' (en-dock old.jum)] ['new' (en-dock new.jum)] ~)
::
%nay
%+ frond 'nay'
(pairs ['old' (en-dock old.jum)] ['new' (en-dock new.jum)] ~)
::
%all
%+ frond 'all'
:- %a
%+ turn ~(tap by all.jum)
|= [old=dock new=dock]
(pairs ['old' (en-dock old)] ['new' (en-dock new)] ~)
==
++ en-dock
|= =dock
(pairs ['ship' s+(scot %p p.dock)] ['desk' s+q.dock] ~)
--
--
++ grab
|%
++ noun jump:h
--
++ grad %noun
--

50
pkg/base-dev/mar/kiln/sync-update.hoon Normal file
View File

@ -0,0 +1,50 @@
::
:::: /hoon/sync-update/kiln/mar
::
/- h=hood
|_ upd=sync-update:h
::
++ grow
|%
++ noun upd
++ json
=, enjs:format
|^ ^- ^json
?- -.upd
%new
%+ frond 'new'
(pairs ['for' (en-sync-record for.upd)] ['rev' (numb rev.upd)] ~)
::
%done
%+ frond 'done'
(pairs ['for' (en-sync-record for.upd)] ['rev' (numb rev.upd)] ~)
::
%drop
%+ frond 'drop'
(pairs ['for' (en-sync-record for.upd)] ['rev' (numb rev.upd)] ~)
::
%pending
%+ frond 'pending'
:- %a
%+ turn ~(tap by pending.upd)
|= [for=sync-record:h rev=@ud]
%- pairs
:~ ['for' (en-sync-record for)]
['rev' (numb rev)]
==
==
++ en-sync-record
|= sync-record:h
%- pairs
:~ ['syd' s+syd]
['her' s+(scot %p her)]
['sud' s+sud]
==
--
--
++ grab
|%
++ noun sync-update:h
--
++ grad %noun
--

7
pkg/base-dev/sur/aquarium.hoon
View File

@ -41,7 +41,7 @@
[%pause-events who=ship]
[%snap-ships lab=term hers=(list ship)]
[%restore-snap lab=term]
[%read [from=ship =path] [for=lane:ames num=@ud]]
[%read [from=[=ship life=@ubC] =path] for=[=lane:ames life=@ubC] num=@ud]
[%event who=ship ue=unix-event]
==
::
@ -82,5 +82,10 @@
[%kill ~]
[%init ~]
[%request id=@ud request=request:http]
[%turf p=(list turf)]
:: XX effects seen after running :aqua [%swap-files ~]
[%vega ~]
[%set-config =http-config:eyre]
[%sessions p=(set @t)]
==
--

44
pkg/base-dev/sur/hood.hoon
View File

@ -10,12 +10,41 @@
==
::
+$ pikes (map desk pike)
::
:: $jump: changes to update source change requests
::
+$ jump
$% [%all all=(map dock dock)] :: pending requests
[%add old=dock new=dock] :: new request
[%yea old=dock new=dock] :: approved
[%nay old=dock new=dock] :: denied
==
:: $rung: reference to upstream commit
::
+$ rung [=aeon =weft]
:: #sync-record: source and destination of a kiln sync
::
+$ sync-record ::
$: syd=desk :: local desk
her=ship :: foreign ship
sud=desk :: foreign desk
==
::
+$ sync-state ::
$: nun=@ta :: nonce
kid=(unit desk) :: has kids desk too?
let=@ud :: next revision
nit=(unit ?) :: automerge or default
hav=(unit @ud) :: update available
yea=? :: update approved
==
::
+$ sync-update
$% [%new for=sync-record rev=@ud]
[%done for=sync-record rev=@ud]
[%drop for=sync-record rev=@ud]
[%pending pending=(set [for=sync-record rev=@ud])]
==
::
+$ sync-state [nun=@ta kid=(unit desk) let=@ud]
+$ sink (unit [her=@p sud=desk kid=(unit desk) let=@ud])
:: +truncate-hash: get last 5 digits of hash and convert to tape
::
@ -51,10 +80,11 @@
=/ deks
?~ desks
%+ sort
(sort ~(tap in -.prep) |=([[a=@ *] b=@ *] !(aor a b)))
(sort ~(tap by -.prep) |=([[a=@ *] b=@ *] !(aor a b)))
|=([[a=@ *] [b=@ *]] ?|(=(a %kids) =(b %base)))
%+ skip ~(tap in -.prep)
%+ skip ~(tap by -.prep)
|=([syd=@tas *] =(~ (find ~[syd] desks)))
=. deks (skim deks |=([=desk *] ((sane %tas) desk)))
?: =(filt %blocking)
=/ base-wic
%+ sort ~(tap by wic:(~(got by -.prep) %base))
@ -101,7 +131,7 @@
:: +report-vat: report on a single desk installation
::
++ report-vat
|= $: $: tyr=rock:tire =cone sor=(map desk [ship desk])
|= $: $: tyr=rock:tire =cone sor=(map desk (pair ship desk))
zyn=(map [desk ship desk] sync-state)
==
our=ship now=@da syd=desk verb=?
@ -118,6 +148,8 @@
^- tank
=/ ego (scot %p our)
=/ wen (scot %da now)
?. ((sane %tas) syd)
leaf+"insane desk: {<syd>}"
=+ .^(=cass %cw /[ego]/[syd]/[wen])
?: =(ud.cass 0)
leaf+"desk does not yet exist: {<syd>}"
@ -137,7 +169,7 @@
~
?~ z=(~(get by zyn) syd u.s)
~
`[-.u.s +.u.s +.u.z]
`[p.u.s q.u.s [kid let]:u.z]
=/ meb=(list @uv)
?~ sink [hash]~
(mergebase-hashes our syd now her.u.sink sud.u.sink)

19
pkg/interface/dbug/src/js/views/ames.js
View File

@ -153,8 +153,12 @@ export class Ames extends Component {
snd['packet-pump-state'].live.length > 0 )
? 'active, '
: '';
const color = snd['closing'] ? 'lightyellow': snd['corked'] ? 'lightred' : 'transparent';
return {key: 'snd ' + active + snd.bone + ', ' + renderDuct(snd.duct), jsx: (
<Summary summary={summary} details={details} />
<div style={{backgroundColor: color}}>
<Summary summary={summary} details={details} />
</div>
)};
}
@ -198,8 +202,12 @@ export class Ames extends Component {
{nax}<br/>
{liveMessages}
</>);
const color = rcv['closing'] ? 'ligthyellow': rcv['corked'] ? 'lightred' : 'transparent';
return {key: 'rcv ' + rcv.bone + ', ' + renderDuct(rcv.duct), jsx: (
<Summary summary={summary} details={details} />
<div style={{backgroundColor: color}}>
<Summary summary={summary} details={details} />
</div>
)};
}
@ -330,6 +338,13 @@ export class Ames extends Component {
last contact {msToDa(p.qos['last-contact'])}
</td>
</tr>
<tr>
<td class="inter">Bones </td>
<td>
closing: {p.closing.length},
corked: {p.corked.length}
</td>
</tr>
</tbody></table>
</>);

2
pkg/landscape/app/graph-store.hoon
View File

@ -88,7 +88,7 @@
-.old %6
::
update-logs.old
%- ~(rut by update-logs.old)
%- ~(urn by update-logs.old)
|= [=resource:store =update-log:store]
^- update-log:store
?: =(our.bowl entity.resource)

74
tests/app/tend.hoon Normal file
View File

@ -0,0 +1,74 @@
/+ verb, default-agent, dbug
|%
+$ state-0 [%0 ~]
+$ card card:agent:gall
+$ coop coop:gall
+$ action
$% [%tend =coop =path =page]
[%germ =coop]
[%snip =coop]
[%keen =ship case=@ud =path]
==
--
::
=| state-0
=* state -
%+ verb |
%- agent:dbug
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card:agent:gall _this)
[~ this]
::
++ on-save !>([%0 ~])
++ on-load
|= old=vase
^- (quip card:agent:gall _this)
[~ this(state [%0 ~])]
::
++ on-poke
|= [=mark =vase]
~| mark/mark
?> =(%noun mark)
=+ ;;(=action q.vase)
:_ this
?: ?=(%keen -.action)
=/ =path
%+ welp /g/x/(scot %ud case.action)/[dap.bowl]//1
path.action
[%pass /keen %keen & ship.action path]~
[%pass /foo action]~
++ on-peek
|= =path
^- (unit (unit cage))
~& peek-path/path
~& eny/eny.bowl
?. ?=([%c *] path)
[~ ~]
``noun+!>(&)
++ on-watch on-watch:def
++ on-arvo
|= [=wire syn=sign-arvo]
^- (quip card _this)
?: =(/keen wire)
?: ?=([%ames %near *] syn)
?. ?=([~ ~ *] dat.syn)
~& no-item/dat.syn
`this
=/ =path /(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[p.u.u.dat.syn]
=+ .^ =dais:clay %cb
path
==
:_ this
[%pass /flog %arvo %d %flog %text (noah ;;(vale.dais q.u.u.dat.syn))]~
`this
`this
::
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-fail on-fail:def
--

13
tests/bug/wtcl-crash.hoon Normal file
View File

@ -0,0 +1,13 @@
:: miscompilation: crashing conditional expression compiled out
::
/+ *test
|%
::
++ test-wtcl-cond-crash
%- expect-fail
|. %. %foo
|= sam=$@(?(%foo %bar) [%baz @])
^- [%baz @]
?> ?=(%baz -.sam)
sam
--

39
tests/sys/fine.hoon
View File

@ -3,6 +3,7 @@
/+ *test, v=test-ames-gall
/* kelvin %hoon /sys/kelvin
=> |%
++ dbug `?`|
++ kelvin-roof
^- roof
::
@ -55,7 +56,7 @@
=/ fine-behn-wire=wire (weld /fine/behn/wake/~bud scry-path)
=/ future-path=path /c/x/5/kids/sys/kelvin
=/ future-behn=wire (weld /fine/behn/wake/~bud future-path)
=/ =task:ames [%keen ~bud scry-path]
=/ =task:ames [%keen ~ ~bud scry-path]
::
=/ request=shot:ames
:* [sndr=~nec rcvr=~bud]
@ -65,7 +66,7 @@
origin=~
content=(etch-request-content ~nec (weld /~bud/1/1 scry-path) 1)
==
~& > 'poke requester %ames with a %keen task'
~? > dbug 'poke requester %ames with a %keen task'
=^ t1 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.1 0xdead.beef *roof]
@ -76,7 +77,7 @@
==
==
::
~& > 'poke requester %ames with a second %keen task'
~? > dbug 'poke requester %ames with a second %keen task'
:- t1 |. :- %|
=^ t2 ames.nec
%: ames-check-call:v ames.nec
@ -92,14 +93,14 @@
?~ keen=(~(get by keens.peer) scry-path)
~
listeners:u.keen
~& > 'checks two listeners for the requested scry path'
~? > dbug 'checks two listeners for the requested scry path'
=/ t3=tang
%+ expect-eq
!>((sy ~[~[/keen-duct-1] ~[/keen-duct-2]]))
!>(listeners)
::
:- t3 |. :- %|
~& > 'gives a remote scry response to listeners'
~? > dbug 'gives a remote scry response to listeners'
=/ [sig=@ux meows=(list @ux)]
%: ames-scry-hunk:v ames.bud
[~1111.1.2 0xbeef.dead kelvin-roof]
@ -143,18 +144,18 @@
origin=~
content=(etch-request-content ~nec (weld /~bud/1/1 future-path) 1)
==
~& > 'poke requester %ames with a %keen task for a future case'
~? > dbug 'poke requester %ames with a %keen task for a future case'
=^ t5 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.1 0xdead.beef *roof]
[~[/keen-duct-3] %keen ~bud future-path]
[~[/keen-duct-3] %keen ~ ~bud future-path]
:~ [~[//unix] [%give %send [%& ~bud] (etch-shot:ames request)]]
[~[//unix] %pass future-behn %b %wait ~1111.1.1..00.00.01]
==
==
::
:- t5 |. :- %|
~& > 'cancel %keen task, from requester'
~? > dbug 'cancel %keen task, from requester'
=^ t6 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.1 0xdead.beef *roof]
@ -163,26 +164,26 @@
==
::
:- t6 |. :- %|
~& > 'poke requester %ames with a new %keen task for a future case'
~? > dbug 'poke requester %ames with a new %keen task for a future case'
=^ t7 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.1 0xdead.beef *roof]
[~[/keen-duct-4] %keen ~bud future-path]
[~[/keen-duct-4] %keen ~ ~bud future-path]
:~ [~[//unix] [%give %send [%& ~bud] (etch-shot:ames request)]]
[~[//unix] %pass future-behn %b %wait ~1111.1.1..00.00.01]
==
==
::
:- t7 |. :- %|
~& > 'poke requester %ames with a second %keen task for a future case'
~? > dbug 'poke requester %ames with a second %keen task for a future case'
=^ t8 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.1 0xdead.beef *roof]
[~[/keen-duct-5] %keen ~bud future-path]
[~[/keen-duct-5] %keen ~ ~bud future-path]
~
==
:- t8 |. :- %|
~& > 'cancel scry for all listeners (%wham)'
~? > dbug 'cancel scry for all listeners (%wham)'
=^ t9 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.1 0xdead.beef *roof]
@ -199,7 +200,7 @@
?~ keen=(~(get by keens.peer) scry-path)
~
listeners:u.keen
~& > 'checks no more listeners'
~? > dbug 'checks no more listeners'
(expect-eq !>(~) !>(listeners))
::
++ test-fine-misordered
@ -213,7 +214,7 @@
:: (ames-call:v ames.bud ~[/none] [%spew ~[%msg %snd %rcv %odd]] *roof)
=/ scry-path=path /g/x/0/dap//some/data/atom
=/ fine-behn-wire=wire (weld /fine/behn/wake/~bud scry-path)
=/ =task:ames [%keen ~bud scry-path]
=/ =task:ames [%keen ~ ~bud scry-path]
::
=/ requests=(list shot:ames)
%+ turn (gulf 1 3)
@ -229,7 +230,7 @@
=+ ^= [req1 req2 req3]
?> ?=([^ ^ ^ *] requests)
[i i.t i.t.t]:requests
~& > 'poke requester %ames with a %keen task'
~? > dbug 'poke requester %ames with a %keen task'
=^ t1 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.1 0xdead.beef *roof]
@ -265,7 +266,7 @@
[[~bud [1 sig]] ~ ~]
::
:- t1 |. :- %|
~& > 'hear first response fragment'
~? > dbug 'hear first response fragment'
=^ t2 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.2 0xbeef.dead *roof]
@ -282,7 +283,7 @@
==
::
:- t2 |. :- %|
~& > 'hear third response fragment'
~? > dbug 'hear third response fragment'
=^ t3 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.2 0xbeef.dead *roof]
@ -294,7 +295,7 @@
~
==
:- t3 |. :- %&
~& > 'hear second response fragment'
~? > dbug 'hear second response fragment'
=^ t4 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.3 0xbeef.dead *roof]

69
tests/sys/grq.hoon
View File

@ -2,6 +2,7 @@
::
/+ *test, v=test-ames-gall
|%
++ dbug `?`|
++ test-watch
%- run-chain
|. :- %|
@ -12,7 +13,7 @@
::=^ * ames.bud
:: (ames-call:v ames.bud ~[/none] [%spew ~[%msg %snd %rcv %odd]] *roof)
:: poke %sub to tell it to subscribe
~& > 'poke %sub to tell it to subscribe'
~? > dbug 'poke %sub to tell it to subscribe'
=/ =task:gall [%deal [~nec ~nec /] %sub %poke watch+!>(~bud)]
=^ t1 gall.nec
%: gall-check-call:v gall.nec
@ -26,7 +27,7 @@
==
:- t1 |. :- %|
:: handle gall passing the %watch to itself, which passes to ames
~& > 'handle gall passing the %watch to itself, which passes to ames'
~? > dbug 'handle gall passing the %watch to itself, which passes to ames'
=^ t2 gall.nec
%: gall-check-call:v gall.nec
[~1111.1.1 0xdead.beef *roof]
@ -40,7 +41,7 @@
==
:- t2 |. :- %|
:: subscriber ames handles %plea from gall, gives a packet to vere
~& > 'subscriber ames handles %plea from gall, gives a packet to vere'
~? > dbug 'subscriber ames handles %plea from gall, gives a packet to vere'
=^ t3 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.1 0xdead.beef *roof]
@ -60,7 +61,7 @@
==
:- t3 |. :- %|
:: publisher ames hears %watch, passes to gall
~& > 'publisher ames hears %watch, passes to gall'
~? > dbug 'publisher ames hears %watch, passes to gall'
=^ t4 ames.bud
%: ames-check-call:v ames.bud
[~1111.1.2 0xbeef.dead *roof]
@ -77,7 +78,7 @@
==
:- t4 |. :- %|
:: publisher gall hears %watch from ames, passes to itself
~& > 'publisher gall hears %watch from ames, passes to itself'
~? > dbug 'publisher gall hears %watch from ames, passes to itself'
=^ t5 gall.bud
%: gall-check-call:v gall.bud
[~1111.1.2 0xbeef.dead *roof]
@ -91,7 +92,7 @@
==
:- t5 |. :- %|
:: publisher gall runs %pub with %watch, gives ack to itself
~& > 'publisher gall runs %pub with %watch, gives ack to itself'
~? > dbug 'publisher gall runs %pub with %watch, gives ack to itself'
=^ t6 gall.bud
%: gall-check-call:v gall.bud
[~1111.1.2 0xbeef.dead *roof]
@ -103,7 +104,7 @@
==
:- t6 |. :- %|
:: gall gives ack to ames
~& > 'gall gives ack to ames'
~? > dbug 'gall gives ack to ames'
=^ t7 gall.bud
%: gall-check-take:v gall.bud
[~1111.1.2 0xbeef.dead *roof]
@ -114,7 +115,7 @@
==
:- t7 |. :- %|
:: publisher ames hears ack from gall, sends over the network
~& > 'publisher ames hears ack from gall, sends over the network'
~? > dbug 'publisher ames hears ack from gall, sends over the network'
=^ t8 ames.bud
%: ames-check-take:v ames.bud
[~1111.1.2 0xbeef.dead *roof]
@ -128,7 +129,7 @@
==
:- t8 |. :- %|
:: subscriber ames hears watch-ack packet, gives to gall
~& > 'subscriber ames hears watch-ack packet, gives to gall'
~? > dbug 'subscriber ames hears watch-ack packet, gives to gall'
=^ t9 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.3 0xdead.beef *roof]
@ -148,7 +149,7 @@
==
:- t9 |. :- %|
:: gall gives %done to itself
~& > 'gall gives %done to itself'
~? > dbug 'gall gives %done to itself'
=^ t10 gall.nec
%: gall-check-take:v gall.nec
[~1111.1.3 0xdead.beef *roof]
@ -161,7 +162,7 @@
==
:- t10 |. :- %|
:: gall gives watch-ack to itself
~& > 'gall gives watch-ack to itself'
~? > dbug 'gall gives watch-ack to itself'
=^ t11 gall.nec
%: gall-check-take:v gall.nec
[~1111.1.3 0xdead.beef *roof]
@ -172,7 +173,7 @@
==
:- t11 |. :- %|
:: start the clog and kick process; give clog to publisher gall
~& > 'start the clog and kick process; give clog to publisher gall'
~? > dbug 'start the clog and kick process; give clog to publisher gall'
=^ t12 gall.bud
%: gall-check-take:v gall.bud
[~1111.1.4 0xbeef.dead *roof]
@ -184,7 +185,7 @@
==
:- t12 |. :- %|
:: gall gives %kick %boon to ames
~& > 'gall gives %kick %boon to ames'
~? > dbug 'gall gives %kick %boon to ames'
=^ t13 gall.bud
%: gall-check-take:v gall.bud
[~1111.1.4 0xbeef.dead *roof]
@ -195,7 +196,7 @@
==
:- t13 |. :- %|
:: ames gives kick over the network
~& > 'ames gives kick over the network'
~? > dbug 'ames gives kick over the network'
=^ t14 ames.bud
%: ames-check-take:v ames.bud
[~1111.1.4 0xbeef.dead *roof]
@ -211,7 +212,7 @@
==
:- t14 |. :- %|
:: subscriber ames receives kick, gives to gall and gives ack to unix
~& > 'subscriber ames receives kick, gives to gall and gives ack to unix'
~? > dbug 'subscriber ames receives kick, gives to gall and gives ack to unix'
=^ t15 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.5 0xdead.beef *roof]
@ -233,7 +234,7 @@
==
:- t15 |. :- %|
:: subscriber gall receives kick %boon from ames, gives to self
~& > 'subscriber gall receives kick %boon from ames, gives to self'
~? > dbug 'subscriber gall receives kick %boon from ames, gives to self'
=^ t16 gall.nec
%: gall-check-take:v gall.nec
[~1111.1.5 0xdead.beef *roof]
@ -247,7 +248,7 @@
==
==
:: subscriber gall receives %kick from itself
~& > 'subscriber gall receives %kick from itself'
~? > dbug 'subscriber gall receives %kick from itself'
=^ t17 gall.nec
%: gall-check-take:v gall.nec
[~1111.1.5 0xdead.beef *roof]
@ -261,7 +262,7 @@
==
:- t17 |. :- %|
:: gall receives %deal %watch from itself, passes to ames
~& > 'gall receives %deal %watch from itself, passes to ames'
~? > dbug 'gall receives %deal %watch from itself, passes to ames'
=^ t18 gall.nec
%: gall-check-call:v gall.nec
[~1111.1.5 0xdead.beef *roof]
@ -273,7 +274,7 @@
==
:- t18 |. :- %|
:: subscriber ames sends new %watch
~& > 'subscriber ames sends new %watch'
~? > dbug 'subscriber ames sends new %watch'
=^ t19 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.5 0xdead.beef *roof]
@ -292,7 +293,7 @@
==
:- t19 |. :- %|
:: subscriber ames sends %cork
~& > 'subscriber ames sends %cork'
~? > dbug 'subscriber ames sends %cork'
=^ t20 ames.nec
%: ames-check-call:v ames.nec
[~1111.1.5 0xdead.beef *roof]
@ -310,7 +311,7 @@
==
==
:: publisher ames hears %kick ack
~& > 'publisher ames hears %kick ack'
~? > dbug 'publisher ames hears %kick ack'
:- t20 |. :- %|
=^ t21 ames.bud
%: ames-check-call:v ames.bud
@ -324,7 +325,7 @@
==
==
:: publisher ames hears new %watch
~& > 'publisher ames hears new %watch'
~? > dbug 'publisher ames hears new %watch'
:- t21 |. :- %|
=^ t22 ames.bud
%: ames-check-call:v ames.bud
@ -339,7 +340,7 @@
==
==
:: publisher gall hears new %watch, passes to self
~& > 'publisher gall hears new %watch, passes to self'
~? > dbug 'publisher gall hears new %watch, passes to self'
:- t22 |. :- %|
=^ t23 gall.bud
%: gall-check-call:v gall.bud
@ -351,7 +352,7 @@
==
==
:: publisher gall runs :pub's +on-watch, gives ack to self
~& > 'publisher gall runs :pub\'s +on-watch, gives ack to self'
~? > dbug 'publisher gall runs :pub\'s +on-watch, gives ack to self'
:- t23 |. :- %|
=^ t24 gall.bud
%: gall-check-call:v gall.bud
@ -363,7 +364,7 @@
==
==
:: publisher gall hears %watch-ack, gives to ames
~& > 'publisher gall hears %watch-ack, gives to ames'
~? > dbug 'publisher gall hears %watch-ack, gives to ames'
:- t24 |. :- %|
=^ t25 gall.bud
%: gall-check-take:v gall.bud
@ -374,7 +375,7 @@
==
==
:: publisher ames hears done from gall, sends over the network
~& > 'publisher ames hears done from gall, sends over the network'
~? > dbug 'publisher ames hears done from gall, sends over the network'
:- t25 |. :- %|
=^ t26 ames.bud
%: ames-check-take:v ames.bud
@ -388,7 +389,7 @@
== ==
==
:: publisher ames hears %cork, passes to itself
~& > 'publisher ames hears %cork, passes to itself'
~? > dbug 'publisher ames hears %cork, passes to itself'
:- t26 |. :- %|
=^ t27 ames.bud
%: ames-check-call:v ames.bud
@ -403,7 +404,7 @@
==
:- t27 |. :- %|
:: publisher ames hear cork plea from self, give %done to self
~& > 'publisher ames hear cork plea from self, give %done to self'
~? > dbug 'publisher ames hear cork plea from self, give %done to self'
=^ t28 ames.bud
%: ames-check-call:v ames.bud
[~1111.1.8 0xbeef.dead *roof]
@ -413,7 +414,7 @@
==
==
:: publisher ames hears cork done from self, sends ack and $cork to self
~& > 'publisher ames hears cork done from self, sends ack and $cork to self'
~? > dbug 'publisher ames hears cork done from self, sends ack and $cork to self'
:- t28 |. :- %|
=^ t29 ames.bud
%: ames-check-take:v ames.bud
@ -428,7 +429,7 @@
== ==
==
:: subscriber ames hears %watch-ack, gives to gall
~& > 'subscriber ames hears %watch-ack, gives to gall'
~? > dbug 'subscriber ames hears %watch-ack, gives to gall'
:- t29 |. :- %|
=^ t30 ames.nec
%: ames-check-call:v ames.nec
@ -447,7 +448,7 @@
==
==
:: subscriber gall hears new %watch-ack from ames, gives to self
~& > 'subscriber gall hears new %watch-ack from ames, gives to self'
~? > dbug 'subscriber gall hears new %watch-ack from ames, gives to self'
:- t30 |. :- %|
=^ t31 gall.nec
%: gall-check-take:v gall.nec
@ -464,7 +465,7 @@
==
==
:: subscriber gall hears new %watch-ack from self, tells :sub
~& > 'subscriber gall hears new %watch-ack from self, tells :sub'
~? > dbug 'subscriber gall hears new %watch-ack from self, tells :sub'
:- t31 |. :- %|
=^ t32 gall.nec
%: gall-check-take:v gall.nec
@ -475,7 +476,7 @@
~
==
:: subscriber ames hears %cork ack, sends $kill to self
~& > 'subscriber ames hears %cork ack, sends $kill to self'
~? > dbug 'subscriber ames hears %cork ack, sends $kill to self'
:- t32 |. :- %|
=^ t33 ames.nec
%: ames-check-call:v ames.nec
@ -493,7 +494,7 @@
==
==
:: subscriber ames hears $kill from self, deletes the flow
~& > 'subscriber ames hears $kill from self, deletes the flow'
~? > dbug 'subscriber ames hears $kill from self, deletes the flow'
:- t33 |. :- %|
=^ t34 ames.nec
%: ames-check-call:v ames.nec

23
tests/sys/hoon/func.hoon Normal file
View File

@ -0,0 +1,23 @@
:: Tests for currying gates and ++corl
::
/+ *test
|%
++ test-func
;: weld
%+ expect-eq
!> `(list)`~[0 1 2]
!> ((curr oust `(list)`~[0 1 2]))
%+ expect-eq
!> `@`6
!> ((curr roll add) (gulf 1 3))
%+ expect-eq
!> `@`6
!> ((cury roll (gulf 1 3)) add)
:: check that ++corl strips face from b's subject
::
%+ expect-eq
!> `@`15
!> ((corl same (cury roll (gulf 1 5))) add)
==
::
--

76
tests/sys/hoon/hashes.hoon
View File

@ -211,6 +211,82 @@
::
==
::
:: input chosen as follows:
::
:: > =|(i=@ud |-(?.(=(32 (met 3 (shax i))) i $(i +(i)))))
:: 507
:: > =/(i=@ud 508 |-(?.(=(32 (met 3 (shax i))) i $(i +(i)))))
:: 653
::
++ test-shas-smol
^- tang
;: weld
%+ expect-eq
!> 0x5e64.27b4.df50.8044.0556.ea06.d5b7.cc22.35db.d62a.ebeb.6bc5.cfb8.
26de.2e31.6920
!> `@ux`(shas %foo 0)
::
%+ expect-eq
!> 0xecb1.6c06.c8e6.9572.7202.a8f6.cbd8.7b3c.a1ab.4670.2b31.2b36.dabd.
4bcb.ebf2.bc4f
!> `@ux`(shas %foo 1)
::
%+ expect-eq
!> 0x9a02.666a.9860.0575.8996.2929.cbf5.863b.392e.7692.f95b.d591.6508.
0e76.5cca.149f
!> `@ux`(shas %foo 506)
::
%+ expect-eq
!> 0xe0d6.a881.1621.f8fc.deb5.8794.e059.6937.8b74.03d3.d6c7.d140.ced4.
3ec2.d935.bbc4
!> `@ux`(shas %foo 507)
::
%+ expect-eq
!> 0xf184.dab8.34ff.dd4c.6a57.7f49.ac3f.c6d5.4e41.e9e7.30cd.c665.8c51.
d2ae.3989.439a
!> `@ux`(shas %foo 652)
::
%+ expect-eq
!> 0xd7ed.4f04.146d.db1a.604b.6b8e.61a2.83a5.d4dc.7efc.c9e1.5bc6.45ba.
7363.b297.0691
!> `@ux`(shas %foo 653)
==
::
++ test-shas-long
^- tang
;: weld
::
%+ expect-eq
!> 0x1f88.2572.f898.a8b6.75c6.c660.6315.19a6.dacc.2934.0caa.ee11.b338.
1588.1a5d.aee8
!> `@ux`(shas %foobarbazbud-abcdefghijklmnopqrstuvwxyz 0)
::
%+ expect-eq
!> 0x3f91.8587.1fe4.480a.1cad.0a4f.6feb.e73f.3313.bf21.4dc6.e059.3b72.
1227.47ea.70f5
!> `@ux`(shas %foobarbazbud-abcdefghijklmnopqrstuvwxyz 1)
::
%+ expect-eq
!> 0xfe84.9453.f7f7.2637.25da.8327.e71f.c4c1.baaf.dec5.e790.0d06.83aa.
61b2.5e52.5330
!> `@ux`(shas %foobarbazbud-abcdefghijklmnopqrstuvwxyz 506)
::
%+ expect-eq
!> 0xacd3.eaec.97cc.b5db.4b4f.b055.ad97.7e29.b767.2434.b7de.6193.6616.
6852.174a.cb4e
!> `@ux`(shas %foobarbazbud-abcdefghijklmnopqrstuvwxyz 507)
::
%+ expect-eq
!> 0x911e.59e5.065a.6693.63de.e265.abab.514a.ca11.519b.236c.ebf8.d162.
7d16.02e7.0782
!> `@ux`(shas %foobarbazbud-abcdefghijklmnopqrstuvwxyz 652)
::
%+ expect-eq
!> 0x3912.6b8d.98e1.528a.c9f6.a6ae.1dbe.d496.448e.d5fd.5dda.daaa.e7e8.
f01f.06ba.09db
!> `@ux`(shas %foobarbazbud-abcdefghijklmnopqrstuvwxyz 653)
==
::
++ test-shax
=/ a ''
=/ b 'abc'

10
tests/sys/hoon/map.hoon
View File

@ -177,14 +177,14 @@
:: in both maps are the same as before, and that both returned
:: maps are correct
::
=/ splits-a=[(map) (map)] (~(bif by m-des) [99 99])
=/ splits-b=[(map) (map)] (~(bif by m-des) [6 12])
=/ splits-a=[(map) (map)] (~(bif by m-des) 99)
=/ splits-b=[(map) (map)] (~(bif by m-des) 6)
;: weld
:: Checks with empty map
::
%+ expect-eq
!> [~ ~]
!> (~(bif by m-nul) [1 2])
!> (~(bif by m-nul) 1)
:: Checks bifurcating by non-existing element
::
%+ expect-eq
@ -594,12 +594,12 @@
::
%+ expect-eq
!> ~
!> (~(rut by m-nul) add)
!> (~(urn by m-nul) add)
:: Checks success
::
%+ expect-eq
!> (my ~[[1 3] [2 6] [3 9] [4 12] [5 15] [6 18] [7 21]])
!> (~(rut by m-asc) add)
!> (~(urn by m-asc) add)
==
::
:: Test listify pairs

41
tests/sys/hoon/nest.hoon Normal file
View File

@ -0,0 +1,41 @@
/+ *test
|%
++ test-fitz
;: weld
%+ expect-eq
!> %.y
!> (fitz ~. ~.tas)
::
%+ expect-eq
!> %.y
!> (fitz ~.ud ~.)
::
%+ expect-eq
!> %.n
!> (fitz ~.p ~.q)
::
%+ expect-eq
!> %.n
!> (fitz ~.ux ~.ud)
::
%+ expect-eq
!> %.y
!> (fitz ~.tas ~.ta)
::
%+ expect-eq
!> %.n
!> (fitz 'uvD' 'uvE')
::
%+ expect-eq
!> %.y
!> (fitz 'uvE' 'uvD')
::
%+ expect-eq
!> %.n
!> (fitz 'AD' 'CB')
::
%+ expect-eq
!> %.n
!> (fitz 'AC' 'CB')
==
--

28
tests/sys/vane/ames.hoon
View File

@ -442,7 +442,7 @@
%+ expect-eq
!> =- [~[//unix] %pass /qos %d %flog %text -]
"; {<our-comet>} is your neighbor"
!> (snag 0 `(list move:ames)`moves7)
!> (snag 1 `(list move:ames)`moves7)
::
%+ expect-eq
!> [~[/g/talk] %give %boon post]
@ -473,11 +473,11 @@
;: weld
%+ expect-eq
!> [~[//unix] %pass /qos %d %flog %text "; {<our-comet>} is your neighbor"]
!> (snag 0 `(list move:ames)`moves4)
!> (snag 1 `(list move:ames)`moves4)
::
%+ expect-eq
!> [~[//unix] %pass /qos %d %flog %text "; {<our-comet2>} is your neighbor"]
!> (snag 0 `(list move:ames)`moves7)
!> (snag 1 `(list move:ames)`moves7)
::
%+ expect-eq
!> [~[/g/talk] %give %boon [%post 'first1!!']]
@ -539,7 +539,7 @@
++ test-fine-request
^- tang
=/ want=path /c/z/1/kids/sys
=^ moves1 nec (call nec ~[/g/talk] %keen ~bud want)
=^ moves1 nec (call nec ~[/g/talk] %keen ~ ~bud want)
=/ req=hoot:ames
%+ snag 0
%+ murn ;;((list move:ames) moves1)
@ -697,4 +697,24 @@
!> [~[/g/talk] %give %boon [%post '¡hola!']]
!> (snag 0 `(list move:ames)`moves7)
==
::
++ test-plug ^- tang
=^ moves nec
(call nec ~[/g/talk] %plug /foo)
=/ expected-key
3.782.450.905.364.316.746.465.724.430.826.633.339.627.682.402.565.789.971.442.035.627.125.517.743.962.901.817.756.764.395.497.041.697.150.935.487.420.935.470.530.023.121.462.879.251.503.082.973.208.842.762
%- zing
:-
%+ expect-eq !>(moves)
!> ^- (list move:ames)
:~ [~[/g/talk] %give %stub 1 expected-key]
==
=^ moves2 bud
(call bud ~[/g/talk] %keen `[1 expected-key] ~nec /foo/bar)
:_ ~
%+ expect-eq !>(moves2)
!> ^- (list move:ames)
:~ [~[/g/talk] [%pass /fine/shut/1 [%a [%keen sec=~ ship=~nec path=/a/x/1//fine/shut/1/0v1.vvaek.7boon.0tp04.21q1h.be1i0.494an.qimof.e2fku.ern01]]]]
==
::
--

55
tests/sys/vane/eyre.hoon
View File

@ -262,7 +262,7 @@
==
::
++ ex-channel-response
|= body=@t
|= body=(unit @t)
|= mov=move
^- tang
?. ?=([[[%http-blah ~] ~] %give %response %start * * %.n] mov)
@ -273,7 +273,7 @@
['connection' 'keep-alive']
['set-cookie' cookie-string]
==
=/ body `(as-octs:mimes:html body)
=/ body (bind body as-octs:mimes:html)
;: weld
(expect-eq !>(200) !>(status-code.response-header.http-event.p.card.mov))
(expect-eq !>(body) !>(data.http-event.p.card.mov))
@ -375,6 +375,7 @@
|= [gang pov=path =view =beam]
^- (unit (unit cage))
?: =(%gd view) ``noun+!>(%base)
?: =(%gu view) ``noun+!>(=(%app1 q.beam))
?: &(=(%ca view) =(/gen/handler/hoon s.beam))
:+ ~ ~
vase+!>(!>(|=(* |=(* [[%404 ~] ~]))))
@ -553,6 +554,21 @@
(take /watch-response/[eyre-id] ~[/http-blah] sign)
=/ headers ['content-type' 'text/html']~
(expect-moves mos (ex-continue-response `[3 'ya!'] %.n) ~)
::
++ test-dead-app-request
%- eval-mare
=/ m (mare ,~)
;< ~ bind:m perform-init-wo-timer
;< ~ bind:m (wait ~d1)
:: dead-app binds successfully
::
;< ~ bind:m (connect %dead-app /)
;< ~ bind:m (wait ~d1)
:: outside requests a path that dead-app has bound to
::
;< mos=(list move) bind:m (get '/' ~)
=/ body `(error-page:eyre-gate 503 %.n '/' "%dead-app not running")
(expect-moves mos (ex-response 503 ['content-type' 'text/html']~ body) ~)
:: tests an app redirecting to the login handler, which then receives a post
:: and redirects back to app
::
@ -727,6 +743,31 @@
=/ wire /channel/subscription/'0123456789abcdef'/1/~nul/two/~nul
(expect-moves mos (ex-gall-deal wire ~nul %two %leave ~) ~)
::
++ test-channel-open-with-get
%- eval-mare
=/ m (mare ,~)
;< ~ bind:m perform-init-wo-timer
;< ~ bind:m perform-born
;< ~ bind:m (wait ~d1)
;< mos=(list move) bind:m
(get '/~/channel/0123456789abcdef' cookie)
;< now=@da bind:m get-now
=/ headers ['content-type' 'text/html']~
=/ body `(error-page:eyre-gate 404 %.n '/~/channel/0123456789abcdef' ~)
(expect-moves mos (ex-response 404 headers body) ~)
::
++ test-channel-put-zero-requests
%- eval-mare
=/ m (mare ,~)
;< ~ bind:m perform-init-start-channel-2
;< ~ bind:m (wait ~m1)
;< mos=(list move) bind:m
(put '/~/channel/0123456789abcdef' cookie '[]')
=/ mov-1 ex-204
=/ mov-2 (ex-rest /channel/timeout/'0123456789abcdef' ~1111.1.2..12.00.00)
=/ mov-3 (ex-wait /channel/timeout/'0123456789abcdef' ~1111.1.2..12.01.00)
(expect-moves mos mov-1 mov-2 mov-3 ~)
::
++ test-channel-results-before-open
%- eval-mare
=/ m (mare ,~)
@ -760,7 +801,7 @@
;< now=@da bind:m get-now
=/ mov-1 (ex-wait /channel/heartbeat/'0123456789abcdef' (add now ~s20))
=/ mov-2
%- ex-channel-response
%+ ex-channel-response ~
'''
id: 0
data: {"ok":"ok","id":0,"response":"poke"}
@ -904,7 +945,7 @@
;< now=@da bind:m get-now
=/ mov-1 (ex-wait /channel/heartbeat/'0123456789abcdef' (add now ~s20))
=/ mov-2
%- ex-channel-response
%+ ex-channel-response ~
'''
id: 0
data: {"ok":"ok","id":0,"response":"poke"}
@ -1006,7 +1047,7 @@
=/ heartbeat (add now ~s20)
=/ mov-1 (ex-wait /channel/heartbeat/'0123456789abcdef' heartbeat)
=/ mov-2
%- ex-channel-response
%+ ex-channel-response ~
'''
id: 0
data: {"ok":"ok","id":0,"response":"poke"}
@ -1076,7 +1117,7 @@
=/ heartbeat (add now ~s20)
=/ mov-1 (ex-wait /channel/heartbeat/'0123456789abcdef' heartbeat)
=/ mov-2
%- ex-channel-response
%+ ex-channel-response ~
'''
id: 2
data: {"json":[1],"id":1,"response":"diff"}
@ -1272,7 +1313,7 @@
|= =time
%+ ex ~[/http-blah]
=. time (sub time (mod time ~h1))
[%pass wire %a %keen ~sampel /e/x/(scot %da time)//eauth/url]
[%pass wire %a %keen ~ ~sampel /e/x/(scot %da time)//eauth/url]
::
++ ex-yawn
|= =time

29
tests/sys/vane/gall.hoon
View File

@ -1,46 +1,33 @@
/+ *test
/= gall-raw /sys/vane/gall
::
=/ gall-gate (gall-raw ~nec)
=/ nec (gall-raw ~nec)
::
|%
++ time ~1111.1.1
:: +test-init: test %init
::
++ test-init
^- tang
::
=/ time ~1111.1.1
::
=/ call-args
=/ =duct ~[/init]
=/ =task:gall [%init ~]
[duct task]
::
=/ expected-moves=(list move:gall-gate) ~
::
=/ res
(gall-call gall-gate time *roof call-args expected-moves)
::
-.res
=^ moves nec
(gall-call nec time *roof call-args)
(expect-eq !>(moves) !>(*(list move:nec)))
:: +gall-call: have %gall run a +task and assert it produces expected-moves
::
++ gall-call
|= $: gall-gate=_gall-gate
|= $: nec=_nec
now=@da
scry=roof
call-args=[=duct wrapped-task=(hobo task:gall)]
expected-moves=(list move:gall-gate)
==
=/ gall-core (gall-gate now=now eny=`@`0xdead.beef scry=scry)
::
=/ res
=/ =type -:!>(*task:gall)
(call:gall-core duct.call-args dud=~ wrapped-task.call-args)
::
=/ output=tang
%+ expect-eq
!> expected-moves
!> -.res
::
[output +.res]
=/ gall-core (nec now=now eny=`@`0xdead.beef scry=scry)
(call:gall-core duct.call-args dud=~ wrapped-task.call-args)
--

71
tests/tend.hoon Normal file
View File

@ -0,0 +1,71 @@
/+ verb, default-agent, dbug
|%
+$ state-0 [%0 ~]
+$ card card:agent:gall
+$ coop coop:gall
+$ action
$% [%tend =coop =path =page]
[%germ =coop]
[%snip =coop]
[%keen case=@ud =path]
==
--
::
=| state-0
=* state -
%+ verb |
%- agent:dbug
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card:agent:gall _this)
[~ this]
::
++ on-save !>([%0 ~])
++ on-load
|= old=vase
^- (quip card:agent:gall _this)
[~ this(state [%0 ~])]
::
++ on-poke
|= [=mark =vase]
~| mark/mark
?> =(%noun mark)
=+ ;;(=action q.vase)
:_ this
?: ?=(%keen -.action)
=/ =path
%+ welp /g/x/(scot %ud case.action)
path.action
[%pass /keen %keen & ?:(=(our.bowl ~met) ~hex ~met) path]~
[%pass /foo action]~
++ on-peek
|= =path
^- (unit (unit cage))
~& peek-path/path
~& eny/eny.bowl
?. ?=([%c *] path)
[~ ~]
``noun+!>(&)
++ on-watch on-watch:def
++ on-arvo
|= [=wire syn=sign-arvo]
^- (quip card _this)
~& syn
?: =(/keen wire)
?: ?=([%ames %near *] syn)
?. ?=([~ ~ *] dat.syn)
~& no-item/dat.syn
`this
~& ;;([@tas @tas] q.u.u.dat.syn)
`this
`this
`this
::
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-fail on-fail:def
--