diff --git a/pkg/arvo/gen/vat.hoon b/pkg/arvo/gen/vat.hoon index 6534d5e240d..0a154b7fab1 100644 --- a/pkg/arvo/gen/vat.hoon +++ b/pkg/arvo/gen/vat.hoon @@ -1,6 +1,11 @@ /- *hood :- %say |= $: [now=@da eny=@uvJ bec=beak] - [[=desk ~] ~] + [syd=desk ~] + verb=? == -[%tang ~[(report-vat (report-prep p.bec now) p.bec now desk)]] +=+ ~(abed report-vats p.bec now) +=+ %+ report-vat + verb + %- vat-info syd +[%tang -] diff --git a/pkg/arvo/gen/vats.hoon b/pkg/arvo/gen/vats.hoon index 67046c4604d..ebc152e1f2a 100644 --- a/pkg/arvo/gen/vats.hoon +++ b/pkg/arvo/gen/vats.hoon @@ -1,6 +1,20 @@ /- *hood :- %say |= $: [now=@da eny=@uvJ bec=beak] - [arg=~ ~] + $@(~ [?(%suspended %running %blocking %nonexistent) ~]) + $: verb=? + show-suspended=? + show-running=? + show-blocking=? + show-nonexistent=? + == == -[%tang (report-vats p.bec now)] +=+ :- verb + ?~ +<+< +<+>+ + ?- -.+<+< + %suspended [& | | |] + %running [| & | |] + %blocking [| | & |] + %nonexistent [| | | &] + == +tang+((report-vats p.bec now) -) diff --git a/pkg/base-dev/sur/hood.hoon b/pkg/base-dev/sur/hood.hoon index 06ce86e5f5b..ece12a30e1a 100644 --- a/pkg/base-dev/sur/hood.hoon +++ b/pkg/base-dev/sur/hood.hoon @@ -16,110 +16,144 @@ :: +$ sync-state [nun=@ta kid=(unit desk) let=@ud] +$ sink (unit [her=@p sud=desk kid=(unit desk) let=@ud]) -:: +report-prep: get data required for reports -:: -++ report-prep - |= [our=@p now=@da] - =/ ego (scot %p our) - =/ wen (scot %da now) - :* .^(rock:tire %cx /(scot %p our)//(scot %da now)/tire) - .^(=cone %cx /(scot %p our)//(scot %da now)/domes) - .^((map desk [ship desk]) %gx /[ego]/hood/[wen]/kiln/sources/noun) - .^ (map [desk ship desk] sync-state) %gx - /[ego]/hood/[wen]/kiln/syncs/noun - == - == -:: +report-vats: report on all desk installations -:: ++ report-vats - |= [our=@p now=@da] - ^- tang - =/ desks .^((set desk) %cd /(scot %p our)/base/(scot %da now)) - =/ prep (report-prep our now) - %+ turn ~(tap in desks) - |=(syd=desk (report-vat prep our now syd)) -:: +report-vat: report on a single desk installation -:: -++ report-vat - |= $: $: tyr=rock:tire =cone sor=(map desk [ship desk]) - zyn=(map [desk ship desk] sync-state) + =| $: =cone + sor=(map desk [ship desk]) + zyn=(map [desk ship desk] sync-state) + desks=(set desk) + =pikes + =rock:tire:clay + kel=weft + == + |_ [our=@p now=@da] + +* ego (scot %p our) + wen (scot %da now) + ++ $ + |= [? ? ? ? ?] + (report-vats:abed +<) + ++ abed + %= ..abed + cone .^(^cone %cx /[ego]//[wen]/domes) + sor .^((map desk [ship desk]) %gx /[ego]/hood/[wen]/kiln/sources/noun) + zyn .^ (map [desk ship desk] sync-state) %gx + /[ego]/hood/[wen]/kiln/syncs/noun + == + desks .^((set desk) %cd /[ego]/base/[wen]) + pikes .^(^pikes %gx /[ego]/hood/[wen]/kiln/pikes/kiln-pikes) + rock .^(rock:tire:clay %cx /[ego]//[wen]/tire) + kel (weft .^(* cx/(en-beam [our %base da+now] /sys/kelvin))) + == + ++ vat-info + |= desk=_`desk`%base + =/ pike (~(got by pikes) desk) + =/ zest -:(~(got by rock) desk) + =/ kel-path /[ego]/[desk]/[wen]/sys/kelvin + =/ sink=sink + ?~ s=(~(get by sor) desk) + ~ + ?~ z=(~(get by zyn) desk u.s) + ~ + `[-.u.s +.u.s +.u.z] + =/ hash .^(@uv %cz /[ego]/[desk]/[wen]) + =/ dek (~(got by rock) desk) + =/ =dome (~(got by cone) our desk) + =+ .^(=waft %cx kel-path) + :* &1 &2 &3 &4 &5 &6 &7 &8 + desk=desk + ^= running =(%live zest) + ^= suspended =(%dead zest) + ^= exists !=(ud.cass 0):.^(=cass %cw /[ego]/[desk]/[wen]) + ^= bad-desk ?!(.^(? %cu kel-path)) + ^= meb :: =(list @uv) + ?~ sink [hash]~ + (mergebase-hashes our desk now her.u.sink sud.u.sink) + ^- [on=(list [@tas ?]) of=(list [@tas ?])] + (skid ~(tap by ren.dome) |=([* ?] +<+)) + ^= sat + ?- zest.dek + %live "running" + %dead "suspended" + %held "suspended until next update" == - our=ship now=@da syd=desk + ^- kul=tape + %+ roll + %+ sort + ~(tap in (waft-to-wefts:clay waft)) + |= [a=weft b=weft] + ?: =(lal.a lal.b) + (lte num.a num.b) + (lte lal.a lal.b) + |= [=weft =tape] + (welp " {<[lal num]:weft>}" tape) + ^= blocking + ?& !=(%base desk) + !=(%live zest.pike) + !(~(has in wic.pike) kel) + == == + ++ report-vats + |= $: verb=? + show-suspended=? + show-running=? + show-blocking=? + show-nonexistent=? + == + %+ turn + %+ skim + %+ turn ~(tap in desks) + |= =desk (vat-info desk) + |= vat-info + :: just unconditionally show "bad" desks, whatever that means + ?| bad-desk + &(suspended show-suspended) + &(running show-running) + &(blocking show-blocking) + &(!exists show-nonexistent) == - ^- tank - =/ ego (scot %p our) - =/ wen (scot %da now) - =+ .^(=cass %cw /[ego]/[syd]/[wen]) - ?: =(ud.cass 0) - leaf+"desk does not yet exist: {}" - ?: =(%kids syd) - =+ .^(hash=@uv %cz /[ego]/[syd]/[wen]) - leaf+"%kids %cz hash: {}" - =/ kel-path - /[ego]/[syd]/[wen]/sys/kelvin - ?. .^(? %cu kel-path) - leaf+"bad desk: {}" - =+ .^(=waft %cx kel-path) - :+ %rose ["" "{}" "::"] - ^- tang - =/ hash .^(@uv %cz /[ego]/[syd]/[wen]) - =/ =sink - ?~ s=(~(get by sor) syd) - ~ - ?~ z=(~(get by zyn) syd u.s) - ~ - `[-.u.s +.u.s +.u.z] - =/ meb=(list @uv) - ?~ sink [hash]~ - (mergebase-hashes our syd now her.u.sink sud.u.sink) - =/ dek (~(got by tyr) syd) - =/ =dome (~(got by cone) our syd) - =/ [on=(list [@tas ?]) of=(list [@tas ?])] - (skid ~(tap by ren.dome) |=([* ?] +<+)) - =/ sat - ?- zest.dek - %live "running" - %dead "suspended" - %held "suspended until next update" + |= =vat-info + :+ %rose [" " " " "::"] + :- leaf+"{}" + %- flop + %- report-vat + [verb vat-info] + ++ report-vat + |= [verb=? vat-info] + ^- tang + ?: !exists + ~[leaf+"desk does not yet exist: {}"] + ?: =(%kids desk) + ~[leaf+"%kids %cz hash: {}"] + ?: bad-desk + ~[leaf+"bad desk: {}"] + %- flop + ?. verb + :~ leaf/"/sys/kelvin: {kul}" + leaf/"app status: {sat}" + leaf/"publishing ship: {?~(sink <~> <(get-publisher our desk now)>)}" + leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}" + == + :~ leaf/"/sys/kelvin: {kul}" + leaf/"base hash: {?.(=(1 (lent meb)) <(head meb)>)}" + leaf/"%cz hash: {}" + :: + leaf/"app status: {sat}" + leaf/"force on: {?:(=(~ on) "~" )}" + leaf/"force off: {?:(=(~ of) "~" )}" + :: + leaf/"publishing ship: {?~(sink <~> <(get-publisher our desk now)>)}" + leaf/"updates: {?~(sink "local" "remote")}" + leaf/"source ship: {?~(sink <~> )}" + leaf/"source desk: {?~(sink <~> )}" + leaf/"source aeon: {?~(sink <~> )}" + leaf/"kids desk: {?~(sink <~> ?~(kid.u.sink <~> ))}" + leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}" == - =/ kul=tape - %+ roll - %+ sort - ~(tap in (waft-to-wefts:clay waft)) - |= [a=weft b=weft] - ?: =(lal.a lal.b) - (lte num.a num.b) - (lte lal.a lal.b) - |= [=weft =tape] - (welp " {<[lal num]:weft>}" tape) - :~ leaf/"/sys/kelvin: {kul}" - leaf/"base hash: {?.(=(1 (lent meb)) <(head meb)>)}" - leaf/"%cz hash: {}" - :: - leaf/"app status: {sat}" - leaf/"force on: {?:(=(~ on) "~" )}" - leaf/"force off: {?:(=(~ of) "~" )}" - :: - leaf/"publishing ship: {?~(sink <~> <(get-publisher our syd now)>)}" - leaf/"updates: {?~(sink "local" "remote")}" - leaf/"source ship: {?~(sink <~> )}" - leaf/"source desk: {?~(sink <~> )}" - leaf/"source aeon: {?~(sink <~> )}" - leaf/"kids desk: {?~(sink <~> ?~(kid.u.sink <~> ))}" - leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}" - == -:: +report-kids: non-vat cz hash report for kids desk -:: -++ report-kids - |= [our=ship now=@da] - ^- tank - =/ syd %kids - =/ ego (scot %p our) - =/ wen (scot %da now) - ?. (~(has in .^((set desk) %cd /[ego]//[wen])) syd) - leaf/"no %kids desk" - =+ .^(hash=@uv %cz /[ego]/[syd]/[wen]) - leaf/"%kids %cz hash: {}" + ++ report-kids + ^- tank + ?. (~(has in .^((set desk) %cd /[ego]//[wen])) %kids) + leaf/"no %kids desk" + =+ .^(hash=@uv %cz /[ego]/kids/[wen]) + leaf/"%kids %cz hash: {}" + -- :: +read-bill-foreign: read /desk/bill from a foreign desk :: ++ read-bill-foreign