Merge pull request #6478 from silnem2/vats-again

gen: extend +vats and |suspend to take lists of desks

pkg/arvo/gen/hood/suspend.hoon

@@ -1,5 +1,3 @@
 :-  %say
-|=  $:  [now=@da eny=@uvJ bec=beak]
+|=  [[now=@da eny=@uvJ bec=beak] desks=(list desk) ~]
-        [[=desk ~] ~]
+[%kiln-suspend-many desks]
-    ==
-[%kiln-suspend desk]

pkg/arvo/gen/vat.hoon

@@ -1,11 +1,7 @@
 /-  *hood
 :-  %say
-|=  $:  [now=@da eny=@uvJ bec=beak]
+|=  [[now=@da eny=@uvJ bec=beak] [syd=desk ~] verb=_&]
-        [syd=desk ~]
+:~  %tang
-        verb=?
+    leaf+"Notice: +vat is deprecated as +vats now takes lists of one or more desks"
-    ==
+    (report-vat (report-prep p.bec now) p.bec now syd verb)
-=+  ~(abed report-vats p.bec now)
+==
-=+  %+  report-vat
-      verb
-    %-  vat-info  syd
-[%tang -]

pkg/arvo/gen/vats.hoon

@@ -1,20 +1,21 @@
+::  Print diagnostic information about desks. 
+::
+::  Accepts an optional argument of a list of one or more desks, returns info  
+::  on all desks if no desks are specified.
+::
+::  Keyword arguments include =filt and =verb. =filt takes one of %running, 
+::  %suspended, %exists, %exists-not, or %blocking; =verb takes either & or |
+:: 
+::  If both a list of desks and a filter are provided, the output will include
+::  the desks from the list that match the filter, with the exception of the 
+::  %blocking filter which always returns all desks that match.
+::
 /-  *hood
 :-  %say
-|=  $:  [now=@da eny=@uvJ bec=beak]
+|=  [[now=@da * bec=beak] deks=$@(~ (list desk)) filt=@tas verb=_|]
-        $@(~ [?(%suspended %running %blocking %nonexistent) ~])
+?:  &(=(~ deks) =(%$ filt))  
-        $:  verb=?
+  :-  %tang 
-            show-suspended=?
+  %+  turn  
-            show-running=?
+    ~(tap in .^((set desk) %cd /(scot %p p.bec)/base/(scot %da now))) 
-            show-blocking=?
+  |=(syd=desk (report-vat (report-prep p.bec now) p.bec now syd verb))
-            show-nonexistent=?
+[%tang (report-vats p.bec now deks filt verb)] 
-        ==
-    ==
-=+  :-  verb
-    ?~  +<+<        +<+>+
-    ?-  -.+<+<
-      %suspended    [& | | |]
-      %running      [| & | |]
-      %blocking     [| | & |]
-      %nonexistent  [| | | &]
-    ==
-tang+((report-vats p.bec now) -)

pkg/arvo/lib/hood/kiln.hoon

@@ -551,6 +551,7 @@
     %kiln-rm                 =;(f (f !<(_+<.f vase)) poke-rm)
     %kiln-schedule           =;(f (f !<(_+<.f vase)) poke-schedule)
     %kiln-suspend            =;(f (f !<(_+<.f vase)) poke-suspend)
+    %kiln-suspend-many       =;(f (f !<(_+<.f vase)) poke-suspend-many)
     %kiln-sync               =;(f (f !<(_+<.f vase)) poke-sync)
     %kiln-syncs              =;(f (f !<(_+<.f vase)) poke-syncs)
     %kiln-uninstall          =;(f (f !<(_+<.f vase)) poke-uninstall)
@@ -785,7 +786,19 @@
 ::
 ++  poke-suspend
   |=  =desk
-  abet:(emit %pass /kiln/suspend %arvo %c %zest desk %dead)
+  (poke-suspend-many ~[desk])
+::
+++  poke-suspend-many
+  |=  desks=(list desk)
+  =<  abet
+  %-  emil
+  %+  turn
+    %+  skim  desks
+    |=  dek=desk
+    ?:  (~(has in .^((set desk) %cd /(scot %p our)/base/(scot %da now))) dek)
+      &  
+    ~>  %slog.(fmt "desk does not yet exist: {<dek>}")  |   
+  |=(=desk [%pass /kiln/suspend %arvo %c %zest desk %dead])
 ::
 ++  poke-sync
   |=  hos=kiln-sync

pkg/base-dev/sur/hood.hoon

@@ -16,155 +16,163 @@
 ::
 +$  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
+  |=  [our=@p now=@da desks=(list desk) filt=@tas verb=?]
-          sor=(map desk [ship desk])
+  =/  ego  (scot %p our)
-          zyn=(map [desk ship desk] sync-state)
+  =/  wen  (scot %da now)
-          desks=(set desk)
+  =/  prep  (report-prep our now) 
-          =pikes
+  ?~  filt
-          =rock:tire:clay
+    %+  turn  (flop desks)
-          kel=weft
+    |=(syd=@tas (report-vat prep our now syd verb))
-      ==
+  =/  deks  
-  |_  [our=@p now=@da]
+    ?~  desks  ~(tap in -.prep)
-  +*  ego  (scot %p our)
+    %+  skip  ~(tap in -.prep)                                      
-      wen  (scot %da now)
+    |=([syd=@tas *] =(~ (find ~[syd] desks)))
-  ++  $
+  ?:  =(filt %blocking)  
-    |=  [? ? ? ? ?]
+    =/  base-wic
-     (report-vats:abed +<)
+      %+  sort  ~(tap by wic:(~(got by -.prep) %base))
-  ::
+      |=([[* a=@ud] [* b=@ud]] (gth a b))  
-  ++  kel-path
+    ?~  base-wic  ~[leaf+"%base already up-to-date"]  
-    |=  =desk
+    =/  blockers=(list desk)
-    ^-  path
+      %+  turn
-    /[ego]/[desk]/[wen]/sys/kelvin
+        %+  skip  ~(tap in -.prep)
-  ::
+        |=  [* [zest=@tas wic=(set weft)]]  
-  ++  desk-exists
+        ?.  =(zest %live)  & 
-    |=  =desk
+        (~(has in wic) i.base-wic)    
-    ?&  !=(ud.cass 0):.^(=cass %cw /[ego]/[desk]/[wen])
+      |=([syd=desk *] syd)  
-        .^(? %cu (kel-path desk))
+    ?~  blockers  ~[leaf+"No desks blocking upgrade, run |bump to apply"]
-    ==
+    :-  [%rose [" %" "To unblock upgrade run |suspend %" ""] blockers]
-  ::
+    %+  turn  (flop blockers)
-  ++  abed 
+    |=(syd=desk (report-vat prep our now syd verb)) 
-    %=    ..abed
+  %+  turn
-      cone  .^(^cone %cx /[ego]//[wen]/domes)
+    ?+    filt  !!    
-      sor  .^((map desk [ship desk]) %gx /[ego]/hood/[wen]/kiln/sources/noun)
+    ::  
-      zyn  .^  (map [desk ship desk] sync-state)  %gx
+          %exists      
-             /[ego]/hood/[wen]/kiln/syncs/noun
+        %+  skip  deks
-           ==
+        |=([syd=desk *] =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0))
-      desks  .^((set desk) %cd /[ego]/base/[wen])
+    ::  
-      pikes  .^(^pikes %gx /[ego]/hood/[wen]/kiln/pikes/kiln-pikes)
+        %running       
-      rock  .^(rock:tire:clay %cx /[ego]//[wen]/tire)
+      %+  skim  deks  
-      kel  (weft .^(* cx/(en-beam [our %base da+now] /sys/kelvin)))  
+      |=([* [zest=@tas *]] =(zest %live))
-    ==
+    ::  
-  ++  vat-info
+        %suspended       
-    |=  desk=_`desk`%base
+      %+  skip  deks  
-    =/  pike  (~(got by pikes) desk)
+      |=  [syd=@tas [zest=@tas *]] 
-    =/  zest  -:(~(got by rock) desk)
+      ?|  =(syd %kids) 
-    =/  kel-path  (kel-path desk)
+          =(zest %live)
-    =/  sink=sink
+          =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0)
-      ?~  s=(~(get by sor) desk)
+      ==    
-        ~
+    ::  
-      ?~  z=(~(get by zyn) desk u.s)
+        %exists-not      
-        ~
+      %+  skim  deks
-      `[-.u.s +.u.s +.u.z]
+      |=([syd=desk *] =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0))
-    =/  hash  .^(@uv %cz /[ego]/[desk]/[wen])
+    ==                                  
-    =/  dek  (~(got by rock) desk)
+  |=([syd=desk *] (report-vat prep our now syd verb))
-    =/  =dome  (~(got by cone) our desk)
+::  +report-vat: report on a single desk installation
-    =+  .^(=waft %cx kel-path)
+::
-    :*  &1  &2  &3  &4  &5  &6  &7  &8
+++  report-vat
-        desk=desk
+  |=  $:  $:  tyr=rock:tire  =cone  sor=(map desk [ship desk])
-        ^=  running  =(%live zest)
+              zyn=(map [desk ship desk] sync-state)
-        ^=  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"
           ==
-        ^-  kul=tape
+          our=ship  now=@da  syd=desk  verb=?
-          %+  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: {<desk>}"))
-    %+  turn
-      %+  skim  (turn real vat-info)
-      |=  vat-info
-      ?|  &(suspended show-suspended)
-          &(running show-running)
-          &(blocking show-blocking)
       ==
-    |=  =vat-info
+  ^-  tank
-    ^-  tank
+  =/  ego  (scot %p our)
-    :+  %rose  [" " " " "::"]
+  =/  wen  (scot %da now)
-    :-  leaf+"{<desk.vat-info>}"
+  =+  .^(=cass %cw /[ego]/[syd]/[wen])
-    %-  flop
+  ?:  =(ud.cass 0)
-    %-  report-vat
+    leaf+"desk does not yet exist: {<syd>}"
-    [verb vat-info]
+  ?:  =(%kids syd)
-  ::
+    =+  .^(hash=@uv %cz /[ego]/[syd]/[wen])
-  ++  report-vat
+    leaf+"%kids %cz hash:     {<hash>}"
-    |=  [verb=? vat-info]
+  =/  kel-path
-    ^-  tang
+    /[ego]/[syd]/[wen]/sys/kelvin
-    ?:  =(%kids desk)
+  ?.  .^(? %cu kel-path)
-      ~[leaf+"%kids %cz hash:     {<hash>}"]
+    leaf+"bad desk: {<syd>}"
-    %-  flop
+  =+  .^(=waft %cx kel-path)
-    ?.  verb
+  :+  %rose  ["" "{<syd>}" "::"]
-      :~  leaf/"/sys/kelvin:     {kul}"
+  ^-  tang
-          leaf/"app status:       {sat}"
+  =/  hash  .^(@uv %cz /[ego]/[syd]/[wen])
-          leaf/"publishing ship:  {?~(sink <~> <(get-publisher our desk now)>)}"
+  =/  =sink
-          leaf/"pending updates:  {<`(list [@tas @ud])`~(tap in wic.dek)>}"
+    ?~  s=(~(get by sor) syd)
-      ==
+      ~
-    :~  leaf/"/sys/kelvin:     {kul}"
+    ?~  z=(~(get by zyn) syd u.s)
-        leaf/"base hash:        {?.(=(1 (lent meb)) <meb> <(head meb)>)}"
+      ~
-        leaf/"%cz hash:         {<hash>}"
+    `[-.u.s +.u.s +.u.z]
-        ::
+  =/  meb=(list @uv)
-        leaf/"app status:       {sat}"
+    ?~  sink  [hash]~
-        leaf/"force on:         {?:(=(~ on) "~" <on>)}"
+    (mergebase-hashes our syd now her.u.sink sud.u.sink)
-        leaf/"force off:        {?:(=(~ of) "~" <of>)}"
+  =/  dek  (~(got by tyr) syd)
-        ::
+  =/  =dome  (~(got by cone) our syd)
-        leaf/"publishing ship:  {?~(sink <~> <(get-publisher our desk now)>)}"
+  =/  [on=(list [@tas ?]) of=(list [@tas ?])]
-        leaf/"updates:          {?~(sink "local" "remote")}"
+    (skid ~(tap by ren.dome) |=([* ?] +<+))
-        leaf/"source ship:      {?~(sink <~> <her.u.sink>)}"
+  =/  sat
-        leaf/"source desk:      {?~(sink <~> <sud.u.sink>)}"
+    ?-  zest.dek
-        leaf/"source aeon:      {?~(sink <~> <let.u.sink>)}"
+      %live  "running"
-        leaf/"kids desk:        {?~(sink <~> ?~(kid.u.sink <~> <u.kid.u.sink>))}"
+      %dead  "suspended"
-        leaf/"pending updates:  {<`(list [@tas @ud])`~(tap in wic.dek)>}"
+      %held  "suspended until next update"
     ==
-  ++  report-kids
+  =/  kul=tape
-    ^-  tank
+    %+  roll
-    ?.  (~(has in .^((set desk) %cd /[ego]//[wen])) %kids)
+      %+  sort
-      leaf/"no %kids desk"
+        ~(tap in (waft-to-wefts:clay waft))
-    =+  .^(hash=@uv %cz /[ego]/kids/[wen])
+      |=  [a=weft b=weft]
-    leaf/"%kids %cz hash:     {<hash>}"
+      ?:  =(lal.a lal.b)
-  --
+        (lte num.a num.b)
+      (lte lal.a lal.b)
+    |=  [=weft =tape]
+    (welp " {<[lal num]:weft>}" tape)
+  ?.  verb
+    =/  base-hash  ?.(=(1 (lent meb)) <meb> <(head meb)>)
+    :~  leaf/"/sys/kelvin:          {kul}"
+        leaf/"base hash ends in:     {(slag (sub (lent base-hash) 5) base-hash)}"
+        leaf/"%cz hash ends in:      {(slag (sub (lent <hash>) 5) <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)) <meb> <(head meb)>)}"
+      leaf/"%cz hash:         {<hash>}"
+      ::
+      leaf/"app status:       {sat}"
+      leaf/"force on:         {?:(=(~ on) "~" <on>)}"
+      leaf/"force off:        {?:(=(~ of) "~" <of>)}"
+      ::
+      leaf/"publishing ship:  {?~(sink <~> <(get-publisher our syd now)>)}"
+      leaf/"updates:          {?~(sink "local" "remote")}"
+      leaf/"source ship:      {?~(sink <~> <her.u.sink>)}"
+      leaf/"source desk:      {?~(sink <~> <sud.u.sink>)}"
+      leaf/"source aeon:      {?~(sink <~> <let.u.sink>)}"
+      leaf/"kids desk:        {?~(sink <~> ?~(kid.u.sink <~> <u.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:     {<hash>}"
 ::  +read-bill-foreign: read /desk/bill from a foreign desk
 ::
 ++  read-bill-foreign