=, clay =* dude dude:gall |% +$ pike $: sync=(unit [=ship =desk]) hash=@uv =zest wic=(set weft) == :: +$ pikes (map desk pike) :: :: $rung: reference to upstream commit :: +$ rung [=aeon =weft] :: +$ 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 :: ++ truncate-hash |= hash=@uv ^- tape (slag 2 <`@uv`(mod hash 0v1.00000)>) :: +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 |= [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 %+ sort ~(tap in -.prep) |=([[a=desk *] [b=desk *]] ?|(=(a %kids) =(b %base))) %+ 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) == our=ship now=@da syd=desk verb=? == ^- 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" == =/ 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 =/ cut=(list tape) (turn meb truncate-hash) =/ len (lent cut) =/ base-hash ?: =(0 len) "~" ?: =(1 len) (head cut) "~[{`tape`(zing (join " " `(list tape)`cut))}]" :~ leaf/"/sys/kelvin: {kul}" leaf/"base hash ends in: {base-hash}" leaf/"%cz hash ends in: {(truncate-hash hash)}" 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 |= [=ship =desk =aeon] ^- (list dude) ~| +< =/ her (scot %p ship) =/ syd (scot %tas desk) =/ yon (scot %ud aeon) :: =/ dom .^(domo 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]) =/ fil (~(get by q.yak) /desk/bill) ?~ fil ~ =/ lob (scot %uv u.fil) =/ peg .^(page cs/~[her syd yon %blob lob]) ;;((list dude) q.peg) :: +read-bill: read contents of /desk/bill manifest :: ++ read-bill |= [our=ship =desk now=@da] =/ pax (en-beam [our desk da+now] /desk/bill) ?. .^(? cu/pax) *(list dude) .^((list dude) cx/pax) :: ++ get-remote-diff |= [our=ship here=desk now=@da her=ship there=desk when=aeon] =+ .^(our-hash=@uv cz/[(scot %p our) here (scot %da now) ~]) =+ .^(her-hash=@uv cz/[(scot %p her) there (scot %ud when) ~]) !=(our-hash her-hash) :: ++ get-publisher |= [our=ship =desk now=@da] ^- (unit ship) =/ pax /(scot %p our)/[desk]/(scot %da now)/desk/ship ?. .^(? %cu pax) ~ `.^(ship %cx pax) :: ++ get-apps-live |= [our=ship =desk now=@da] ^- (list dude) %+ murn (get-apps-have our desk now) |=([=dude live=?] ?.(live ~ `dude)) :: +get-apps-have: find which apps Gall is running on a desk :: ++ get-apps-have |= [our=ship =desk now=@da] ^- (list [=dude live=?]) %~ tap in .^((set [=dude live=?]) ge+/(scot %p our)/[desk]/(scot %da now)/$) :: ++ mergebase-hashes |= [our=@p syd=desk now=@da her=ship sud=desk] =/ her (scot %p her) =/ ego (scot %p our) =/ wen (scot %da now) %+ turn .^((list tako) %cs ~[ego syd wen %base her sud]) |=(=tako .^(@uv %cs ~[ego syd wen %hash (scot %uv tako)])) :: ++ enjs =, enjs:format |% ++ tim |= t=@ ^- json (numb (fall (mole |.((unm:chrono:userlib t))) 0)) :: ++ cass |= c=^cass %- pairs :~ ud+(numb ud.c) da+(tim da.c) == :: ++ weft |= w=^weft %- pairs :~ name+s+lal.w kelvin+(numb num.w) == :: ++ rung |= r=^rung %- pairs :~ aeon+(numb aeon.r) weft+(weft weft.r) == -- --