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

Merge branch 'next/kelvin/411' into ted/ping

Browse Source
This commit is contained in:
yosoyubik 2023-10-20 09:18:06 +02:00
commit dafa77b1b7
30 changed files with 933 additions and 166 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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>}"

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)

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

166
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 +
-- =>
@ -1394,23 +1394,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 +1431,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 +1588,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 +1677,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)
@ -1877,17 +1880,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 +3255,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 +7148,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]
@ -8302,9 +8309,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 +8783,7 @@
++ fish
|= =axis
^- nock
?@ skin [%1 &]
?@ skin $(skin spec+[[%like [skin]~ ~] [%base %noun]])
?- -.skin
::
%base
@ -8809,8 +8813,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 +8824,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 +8861,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 +8874,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 +8886,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 +8908,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 +8919,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 +8933,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 +8965,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 +9005,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 +9253,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 +9487,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 +9713,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))
@ -9983,10 +10005,8 @@
::
[%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 +10193,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 +13123,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

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

@ -828,6 +828,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
::
@ -844,6 +845,7 @@
[%done error=(unit error)]
[%lost ~]
[%send =lane =blob]
[%nail =ship lanes=(list lane)]
::
[%tune spar roar=(unit roar)]
::

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

@ -107,6 +107,25 @@
~% %ames ..part ~
|%
+| %helpers
:: +get-forward-lanes: get all lanes to send to when forwarding to peer
::
++ get-forward-lanes
|= [our=@p peer=peer-state peers=(map ship ship-state)]
^- (list lane)
=; zar=(trap (list lane))
?~ route.peer $:zar
=* rot u.route.peer
?:(direct.rot [lane.rot ~] [lane.rot $:zar])
::
|. ^- (list lane)
?: ?=(%czar (clan:title sponsor.peer))
?: =(our sponsor.peer)
~
[%& sponsor.peer]~
=/ next (~(get by peers) sponsor.peer)
?. ?=([~ %known *] next)
~
$(peer +.u.next)
:: +trace: print if .verb is set and we're tracking .ship
::
++ trace
@ -2264,11 +2283,17 @@
(on-publ / [%full (my [sndr.shot point]~)])
:: manually add the lane to the peer state
::
=/ =peer-state (gut-peer-state sndr.shot)
=. route.peer-state `[direct=%.n lane]
=. peers.ames-state
=/ =peer-state (gut-peer-state sndr.shot)
=. route.peer-state `[direct=%.n lane]
(~(put by peers.ames-state) sndr.shot %known peer-state)
::
=. event-core
%- emit
:* unix-duct.ames-state %give %nail sndr.shot
(get-forward-lanes our peer-state peers.ames-state)
==
::
event-core
:: +on-hear-shut: handle receipt of encrypted packet
::
@ -2309,6 +2334,7 @@
(sift-shut-packet shot [symmetric-key her-life our-life]:channel)
?~ shut-packet
event-core
=/ old-route route.peer-state
:: non-galaxy: update route with heard lane or forwarded lane
::
=? route.peer-state !=(%czar (clan:title her.channel))
@ -2338,6 +2364,12 @@
route.peer-state
`[direct=%.n |+u.origin.shot]
`[direct=%.n |+u.origin.shot]
::
=? event-core !=(old-route route.peer-state)
%- emit
:* unix-duct.ames-state %give %nail sndr.shot
(get-forward-lanes our peer-state peers.ames-state)
==
:: perform peer-specific handling of packet
::
=< abet
@ -2699,6 +2731,12 @@
=. peers.ames-state
(~(put by peers.ames-state) ship [%known peer-state])
::
=. event-core
%- emit
:* unix-duct.ames-state %give %nail ship
(get-forward-lanes our peer-state peers.ames-state)
==
::
event-core
:: +on-publ-rekey: handle new key for peer
::
@ -2755,6 +2793,12 @@
event-core
=. sponsor.u.state u.sponsor
=. peers.ames-state (~(put by peers.ames-state) ship %known u.state)
=. event-core
%- emit
:* unix-duct.ames-state %give %nail ship
(get-forward-lanes our u.state peers.ames-state)
==
::
event-core
:: +on-publ-full: handle new pki data for peer(s)
::
@ -2881,6 +2925,11 @@
=. peers.ames-state
(~(put by peers.ames-state) ship %known peer-state)
::
=? event-core ?=(%czar (clan:title ship))
%- emit
:* unix-duct.ames-state %give %nail ship
(get-forward-lanes our peer-state peers.ames-state)
==
event-core
--
:: +on-take-turf: relay %turf move from jael to unix
@ -3291,7 +3340,13 @@
=. peer-core (update-qos %ames qos:(is-peer-dead now peer-state))
:: expire direct route if the peer is not responding
::
=/ old-route route.peer-state
=. peer-state (update-peer-route her peer-state)
=? peer-core !=(old-route route.peer-state)
%- pe-emit
:* unix-duct.ames-state %give %nail her
(get-forward-lanes our peer-state peers.ames-state)
==
:: resend comet attestation packet if first message times out
::
:: The attestation packet doesn't get acked, so if we tried to
@ -3343,11 +3398,13 @@
++ on-dear
|= =lane
^+ peer-core
peer-core(route.peer-state `[%.y lane])
%- pe-emit:peer-core(route.peer-state `[%.y lane])
[unix-duct.ames-state %give %nail her ~[lane]]
::
++ on-tame
^+ peer-core
peer-core(route.peer-state ~)
%- pe-emit:peer-core(route.peer-state ~)
[unix-duct.ames-state %give %nail her ~]
:: +on-cork-flow: mark .bone as closing
::
++ on-cork-flow
@ -4824,7 +4881,13 @@
=. peer-core (update-qos %fine qos:(is-peer-dead now peer-state))
:: has the direct route expired?
::
=. peer-state (update-peer-route her peer-state)
=/ old-route route.peer-state
=. peer-state (update-peer-route her peer-state)
=? peer-core !=(old-route route.peer-state)
%- pe-emit
:* unix-duct.ames-state %give %nail her
(get-forward-lanes our peer-state peers.ames-state)
==
=. metrics.keen on-timeout:fi-gauge
=^ want=(unit want) wan.keen
?~ res=(pry:fi-mop wan.keen) `wan.keen
@ -5096,7 +5159,7 @@
|= ames-state=ames-state-5
^- ames-state-6
:_ +.ames-state
%- ~(rut by peers.ames-state)
%- ~(urn by peers.ames-state)
|= [=ship ship-state=ship-state-5]
^- ship-state-6
?. ?=(%known -.ship-state)
@ -5259,7 +5322,7 @@
%= ship-state
snd (~(run by snd.ship-state) message-pump-16-to-17)
keens (~(run by keens.ship-state) keen-state-16-to-17)
rcv (~(rut by rcv.ship-state) remove-outbound-naxplanations)
rcv (~(urn by rcv.ship-state) remove-outbound-naxplanations)
==
::
++ message-pump-16-to-17
@ -5389,28 +5452,15 @@
!> ^- (list lane)
?: =(our u.who)
~
?. ?=([~ %known *] peer)
=/ sax (rof ~ /ames %j `beam`[[our %saxo %da now] /(scot %p u.who)])
?. ?=([~ ~ *] sax)
~
=/ gal (rear ;;((list ship) q.q.u.u.sax))
?: =(our gal)
~
[%& gal]~
=; zar=(trap (list lane))
?~ route.u.peer $:zar
=* rot u.route.u.peer
?:(direct.rot [lane.rot ~] [lane.rot $:zar])
::
|. ^- (list lane)
?: ?=(%czar (clan:title sponsor.u.peer))
?: =(our sponsor.u.peer)
~
[%& sponsor.u.peer]~
=/ next (~(get by peers.ames-state) sponsor.u.peer)
?. ?=([~ %known *] next)
?: ?=([~ %known *] peer)
(get-forward-lanes our +.u.peer peers.ames-state)
=/ sax (rof ~ /ames %j `beam`[[our %saxo %da now] /(scot %p u.who)])
?. ?=([~ ~ *] sax)
~
$(peer next)
=/ gal (rear ;;((list ship) q.q.u.u.sax))
?: =(our gal)
~
[%& gal]~
==
::
[%bones her=@ ~]

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

@ -909,6 +909,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)
@ -1014,6 +1023,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
@ -3044,6 +3091,7 @@
::
?: ?| ?=([%'~' *] path.binding) :: eyre
?=([%'~_~' *] path.binding) :: runtime
?=([%'_~_' *] path.binding) :: scries
==
[| bindings.state]
[& (insert-binding [binding duct action] bindings.state)]
@ -3244,6 +3292,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 =~
::
@ -4068,6 +4179,11 @@
?. =(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)
[~ ~]

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

37
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
::
@ -101,7 +130,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=?
@ -137,7 +166,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)

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)

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

6
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!!']]