docket: react to suspension & revival

This commit is contained in:
Liam Fitzgerald 2021-08-23 13:32:22 +10:00
parent 39f6eca798
commit 52fb35227d
3 changed files with 127 additions and 25 deletions

View File

@ -1,5 +1,5 @@
/- *docket, hood, treaty
/+ *server, agentio, default-agent, dbug, verb, hood-kiln=kiln
/+ *server, agentio, default-agent, dbug, verb
|%
+$ card card:agent:gall
+$ state-0
@ -164,10 +164,23 @@
::
%fact
?. ?=(%kiln-vats-diff p.cage.sign) `state
=+ !<(=diff:hood-kiln q.cage.sign)
?. &(?=(%merge -.diff) !(~(has by charges) desk.diff)) `state
:: TODO: kiln states
`state
=+ !<(=diff:hood q.cage.sign)
?. (~(has by charges) desk.diff) `state
=* cha ~(. ch desk.diff)
?+ -.diff `state
::
%suspend
=. charges (new-chad:cha %suspend ~)
:_(state ~[add-fact:cha])
::
%revive
=/ =charge (~(got by charges) desk.diff)
?. ?=(%glob -.href.docket.charge)
=. charges (new-chad:cha %site ~)
:_(state ~[add-fact:cha])
=. charges (new-chad:cha %install ~)
:_(state [add-fact fetch-glob]:cha)
==
==
++ take-charge
|= [=desk =^wire]

View File

@ -22,7 +22,9 @@
pass pass:io
cc ~(. +> bowl)
++ on-init
(on-poke %treaty-ally-diff !>([%add (sein:title [our now our]:bowl)]))
=/ sponsor=ship (sein:title [our now our]:bowl)
?: =(our.bowl sponsor) `this
(on-poke %ally-update-0 !>([%add sponsor]))
++ on-save !>(state)
++ on-load
|= =vase
@ -51,6 +53,7 @@
^- (quip card _this)
=/ upd=card (ally-update:ca:cc diff)
=* ship ship.diff
?< =(ship our.bowl)
=* al ~(. al:cc ship.diff)
?- -.diff
%add [~[watch:al upd] this(allies (~(put by allies) ship *alliance))]
@ -60,11 +63,25 @@
++ alliance-diff
|= =diff:alliance
^- (quip card _this)
:- (alliance-update:ca:cc diff)^~
=- [[(alliance-update:ca:cc diff) -.-] +.-]
^- (quip card _this)
=, diff
?- -.diff
%add this(entente (~(put in entente) [ship desk]:diff))
%del this(entente (~(del in entente) [ship desk]:diff))
==
::
%add
=. entente (~(put in entente) [ship desk])
?. =(our.bowl ship) `this
=/ =docket:docket ~(get-docket so:cc desk)
=/ =treaty (treaty-from-docket:cc desk docket)
=. sovereign (~(put by sovereign) desk treaty)
`this
::
%del
=. entente (~(del in entente) [ship desk])
?. =(our.bowl ship) `this
=. sovereign (~(del by sovereign) desk)
:_(this ~(kick so:cc desk)^~)
==
--
::
++ on-watch

View File

@ -2,6 +2,17 @@
=, clay
=* dude dude:gall
|%
:: $diff: subscription update
::
+$ diff
$% [%block =desk =arak =weft blockers=(set desk)]
[%reset =desk =arak]
[%merge =desk =arak]
[%merge-sunk =desk =arak =tang]
[%merge-fail =desk =arak =tang]
[%suspend =desk =arak]
[%revive =desk =arak]
==
:: $arak: foreign vat tracker
::
:: .next is a list of pending commits with future kelvins
@ -15,11 +26,13 @@
==
:: $rein: diff from desk manifest
::
:: .liv: suspended?
:: .add: agents not in manifest that should be running
:: .sub: agents in manifest that should not be running
::
+$ rein
$: add=(set dude)
$: liv=_&
add=(set dude)
sub=(set dude)
==
::
@ -42,26 +55,19 @@
:+ %rose ["" "{<desk>}" "::"]
^- tang
=- ?: =(~ next.arak) -
(snoc - leaf/"pending: {<next.arak>}")
%+ snoc -
leaf/"pending: {<(turn next.arak |=([@ lal=@tas num=@] [lal num]))>}"
^- tang
=/ meb (mergebase-hashes our desk now arak)
=/ sat ?:(liv.rein.arak "running" "suspended")
:~ leaf/"/sys/kelvin: {<[lal num]:weft>}"
leaf/"base hash: {?.(=(1 (lent meb)) <meb> <(head meb)>)}"
leaf/"%cz hash: {<hash>}"
leaf/"remote aeon: {<aeon.arak>}"
leaf/"status: {sat}"
leaf/"force on: {?:(=(~ add.rein.arak) "~" <add.rein.arak>)}"
leaf/"force off: {?:(=(~ sub.rein.arak) "~" <sub.rein.arak>)}"
==
:: +ankh-to-kelvin: read /sys.kelvin from an $ankh
::
++ ankh-to-kelvin
|= =ankh
!< weft
q:(need (~(get an:cloy ankh) /sys/kelvin))
::
++ read-kelvin-local
|= [our=ship =desk =aeon]
.^(weft cx+/(scot %p our)/[desk]/(scot %ud aeon)/sys/kelvin)
::
++ read-kelvin-foreign
|= [=ship =desk =aeon]
@ -85,7 +91,10 @@
::
++ read-bill
|= [our=ship =desk now=@da]
.^(bill cx+/(scot %p our)/[desk]/(scot %da now)/desk/bill)
=/ pax (en-beam [our desk da+now] /desk/bill)
?~ =<(fil .^(arch cy/pax))
*bill
.^(bill cx/pax)
:: +is-fish: should dill link .dude?
::
++ is-fish |=([=dude =bill] .?((find ~[dude] (read-fish bill))))
@ -120,7 +129,7 @@
^- (list dude)
=/ duz (read-apes bill)
=. duz (skip duz ~(has in sub.rein))
=. duz (weld duz ~(tap in add.rein))
=. duz (weld duz (skip ~(tap in add.rein) ~(has in (sy duz))))
duz
::
++ mergebase-hashes
@ -130,5 +139,68 @@
=/ wen (scot %da now)
%+ turn .^((list tako) %cs ~[ego desk wen %base her desk.arak])
|=(=tako .^(@uv %cs ~[ego desk wen %hash (scot %uv tako)]))
::
++ enjs
=, enjs:format
|%
++ vats
|= v=(list ^vat)
^- json
%- pairs
%+ turn v
|= va=^vat
[desk.va (vat va)]
::
++ tim
|= t=@
^- json
(numb (fall (mole |.((unm:chrono:userlib t))) 0))
::
++ cass
|= c=^cass
%- pairs
:~ ud+(numb ud.c)
da+(tim da.c)
==
::
++ vat
|= v=^vat
%- pairs
:~ desk+s+desk.v
hash+s+(scot %uv hash.v)
cass+(cass cass.v)
arak+(arak arak.v)
==
::
++ weft
|= w=^weft
%- pairs
:~ name+s+lal.w
kelvin+(numb num.w)
==
::
++ woof
|= w=[=aeon =^weft]
%- pairs
:~ aeon+(numb aeon.w)
weft+(weft weft.w)
==
::
++ rein
|= r=^rein
%- pairs
:~ add+a+(turn ~(tap in add.r) (lead %s))
sub+a+(turn ~(tap in sub.r) (lead %s))
==
::
++ arak
|= a=^arak
%- pairs
:~ ship+s+(scot %p ship.a)
desk+s+desk.a
aeon+(numb aeon.a)
next+a+(turn next.a woof)
rein+(rein rein.a)
==
--
--