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 pull request #6793 from urbit/tinnus/kiln-ota-approval

Browse Source 
kiln: OTA merge approval (UIP 114)
This commit is contained in:
Pyry Kovanen 2023-09-20 14:58:29 +03:00 committed by GitHub
commit 9486ada012
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
21 changed files with 534 additions and 56 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 /+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|% |%
+$ state +$ state
$~ [%26 *state:drum *state:helm *state:kiln] $~ [%27 *state:drum *state:helm *state:kiln]
$>(%26 any-state) $>(%27 any-state)
:: ::
+$ any-state +$ any-state
$% [ver=?(%1 %2 %3 %4 %5 %6) lac=(map @tas fin-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] [%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] [%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] [%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 +$ any-state-tuple
$: drum=any-state:drum $: 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>}"

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

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

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) +$ 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: reference to upstream commit
:: ::
+$ rung [=aeon =weft] +$ 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]) +$ sink (unit [her=@p sud=desk kid=(unit desk) let=@ud])
:: +truncate-hash: get last 5 digits of hash and convert to tape :: +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: report on a single desk installation
:: ::
++ report-vat ++ 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) zyn=(map [desk ship desk] sync-state)
== ==
our=ship now=@da syd=desk verb=? our=ship now=@da syd=desk verb=?
@ -137,7 +166,7 @@
~ ~
?~ z=(~(get by zyn) syd u.s) ?~ 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) =/ meb=(list @uv)
?~ sink [hash]~ ?~ sink [hash]~
(mergebase-hashes our syd now her.u.sink sud.u.sink) (mergebase-hashes our syd now her.u.sink sud.u.sink)