diff --git a/pkg/base-dev/sur/hood.hoon b/pkg/base-dev/sur/hood.hoon index f0ec60624..156ebf471 100644 --- a/pkg/base-dev/sur/hood.hoon +++ b/pkg/base-dev/sur/hood.hoon @@ -16,155 +16,161 @@ :: +$ 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 /[ego]//[wen]/tire) + .^(=cone %cx /[ego]//[wen]/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 - =| $: =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 +<) - :: - ++ kel-path - |= =desk - ^- path - /[ego]/[desk]/[wen]/sys/kelvin - :: - ++ desk-exists - |= =desk - ?& !=(ud.cass 0):.^(=cass %cw /[ego]/[desk]/[wen]) - .^(? %cu (kel-path desk)) - == - :: - ++ 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 (kel-path desk) - =/ 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) - ^= 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=@p now=@da desks=(list desk) filt=@tas verb=?] + =/ ego (scot %p our) + =/ wen (scot %da now) + =/ prep (report-prep our now) + ?~ filt + %+ turn (flop desks) + |=(syd=@tas (report-vat prep our now syd verb)) + =/ deks + ?~ desks ~(tap in -.prep) + %+ skip ~(tap in -.prep) + |=([syd=@tas *] =(~ (find ~[syd] desks))) + ?: =(filt %blocking) + =/ base-wic + %+ sort ~(tap by wic:(~(got by -.prep) %base)) + |=([[* a=@ud] [* b=@ud]] (gth a b)) + ?~ base-wic ~[leaf+"%base already up-to-date"] + =/ blockers=(list desk) + %+ turn + %+ skip ~(tap in -.prep) + |= [* [zest=@tas wic=(set weft)]] + ?. =(zest %live) & + (~(has in wic) i.base-wic) + |=([syd=desk *] syd) + ?~ blockers ~[leaf+"No desks blocking upgrade, run |bump to apply"] + :- [%rose [" %" "To unblock upgrade run |suspend %" ""] blockers] + %+ turn (flop blockers) + |=(syd=desk (report-vat prep our now syd verb)) + %+ turn + ?+ filt !! + :: + %exists + %+ skip deks + |=([syd=desk *] =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0)) + :: + %running + %+ skim deks + |=([* [zest=@tas *]] =(zest %live)) + :: + %suspended + %+ skip deks + |= [syd=@tas [zest=@tas *]] + ?| =(syd %kids) + =(zest %live) + =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0) + == + :: + %exists-not + %+ skim deks + |=([syd=desk *] =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0)) + == + |=([syd=desk *] (report-vat prep our now syd verb)) +:: +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) == - ^- 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=? - == - =/ [real=(list desk) fake=(list desk)] - (skid ~(tap in desks) desk-exists) - =; reals=tang - ?. show-nonexistent - reals - %+ weld reals - `tang`(turn fake |=(=desk leaf+"nonexistent desk: {}")) - %+ turn - %+ skim (turn real vat-info) - |= vat-info - ?| &(suspended show-suspended) - &(running show-running) - &(blocking show-blocking) + our=ship now=@da syd=desk verb=? == - |= =vat-info - ^- tank - :+ %rose [" " " " "::"] - :- leaf+"{}" - %- flop - %- report-vat - [verb vat-info] - :: - ++ report-vat - |= [verb=? vat-info] - ^- tang - ?: =(%kids desk) - ~[leaf+"%kids %cz hash: {}"] - %- 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)>}" + ^- 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" == - ++ 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: {}" - -- + =/ 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) + ?. verb + :~ leaf/"/sys/kelvin: {kul}" + leaf/"%cz hash ends in: {(slag (sub (lent ) 5) )}" + leaf/"app status: {sat}" + 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 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: {}" :: +read-bill-foreign: read /desk/bill from a foreign desk :: ++ read-bill-foreign @@ -175,7 +181,7 @@ =/ syd (scot %tas desk) =/ yon (scot %ud aeon) :: - =/ dom .^(domo cv/~[her syd yon]) + =/ dom .^(dome cv/~[her syd yon]) =/ tak ~| aeons=~(key by hit.dom) (scot %uv (~(got by hit.dom) aeon)) =/ yak .^(yaki cs/~[her syd yon %yaki tak])