Merge upstream develop into gw/next/kelvin/408

pkg/arvo/app/dbug.hoon

@@ -2,6 +2,8 @@
 ::
 /-  spider
 /+  server, default-agent, verb, dbug
+/=  gall-raw   /sys/vane/gall
+=/  gall-vane  (gall-raw)
 ::
 |%
 +$  state-0  [%0 passcode=(unit @t)]
@@ -1082,7 +1084,7 @@
           %-  tape
           "{<[bone=bone dire=dire]>}"
         ::
-          'scries'^(scries ~(tap by pit))
+          'tip'^(tip-to-json ~(tap by tip))
       ==
     ::
     ++  flow-with-side
@@ -1092,22 +1094,31 @@
       %-  pairs
       :*  'closing'^b+closing
           'corked'^b+corked
+          'halt'^b+halt
           'line'^(numb line)
         ::  %outgoing
         ::
           'next'^(numb next.snd)
         ::
-          :-  'unsent-messages'  ::  as byte sizes
-          =|  loads-set=(set mesa-message)
-          =.  loads-set
-            ^+  loads-set
-            =;  [loads=_loads-set *]
-              loads
-            %^  (dip:mop _loads-set)  loads.snd
-              loads-set
-            |=  [loads=_loads-set seq=@ud req=mesa-message]
-            [~ | (~(put in loads) req)]
-          (set-array loads-set (cork jam (cork (cury met 3) numb)))
+          :-  'acks'
+          =+  mop-acks=((on ,@ud ack) lte)
+          :-  %a
+          %+  turn  (tap:mop-acks acks.snd)
+          |=  [seq=@ud =ack]
+          %-  pairs
+          :~  'seq'^(numb seq)
+              'ack'^s+-.ack
+          ==
+        ::
+          :-  'unsent-messages'
+          :-  %a
+          %+  turn  (tap:mop loads.snd)
+          |=  [seq=@ud msg=mesa-message]
+          %-  pairs
+          :~  'seq'^(numb seq)
+              'size'^(numb (met 3 (jam msg)))
+              'info'^(describe-message msg dire.side)
+          ==
         ::
           'send-window'^(numb send-window.snd)
           'send-window-max'^(numb send-window-max.snd)
@@ -1176,7 +1187,69 @@
           ?:  ?=(%bak dire.side)  ~
           (from-duct (~(got by by-bone) bone.side))
       ==
-    :: ::
+    ::
+    ++  describe-message
+      |=  [msg=mesa-message =dire]
+      ^-  json
+      ?-  -.msg
+        %boon
+          ::  for forward flows, boons are responses (ames-response from gall)
+          ::  for backward flows, boons are what we're sending
+          ::
+          =/  pay  payload.msg
+          ?.  ?=(ames-response:gall-vane pay)  ~
+          ?-  -.pay
+            %d
+              %-  pairs
+              :~  'type'^s+'fact'
+                  'mark'^s+(scot %tas +<.pay)
+              ==
+            %x  s+'kick'
+          ==
+        %plea
+          =/  =plea  +.msg
+          %-  pairs
+          :~  'type'^s+'plea'
+              'vane'^s+vane.plea
+              'path'^(path:enjs:format path.plea)
+              :-  'detail'
+              ?:  ?=([%$ [%flow *] *] plea)
+                (pairs ~['action'^s+'cork'])
+              ?.  =(%g vane.plea)
+                ::  XX TODO %c %j %e
+                ::
+                ~
+              ?.  ?=([%ge *] path.plea)
+                 ::  XX TODO: /gf /gk
+                 ::
+                 ~
+              ::  gall: payload is ames-request-all = [%0 ames-request]
+              ::
+              ::  XX fish loop
+              :: ?>  ?=(ames-request-all:gall-vane payload.plea)
+              ?>  ?=([%0 *] payload.plea)
+              =+  ;;(req=ames-request:gall-vane +.payload.plea)
+              ?-  -.req
+                %m  ::  %poke
+                  %-  pairs
+                  :~  'action'^s+'poke'
+                      'mark'^s+(scot %tas mark.req)
+                  ==
+                %s  ::  %watch
+                  %-  pairs
+                  :~  'action'^s+'watch'
+                      'path'^s+(spat ;;(^path path.req))
+                  ==
+                %l  ::  %watch-as
+                  %-  pairs
+                  :~  'action'^s+'watch-as'
+                      'mark'^s+(scot %tas mark.req)
+                  ==
+                %u  (pairs ~['action'^s+'leave'])
+              ==
+          ==
+      ==
+    ::
     ++  maybe
       |*  [unit=(unit) enjs=$-(* json)]
       ^-  json
@@ -1192,6 +1265,25 @@
       |=  =duct
       a+(turn duct path)
     ::
+    ++  tip-to-json
+      |=  tips=(list [user-path=^path listeners=(set [=duct ames-path=^path])])
+      ^-  json
+      :-  %a
+      %+  turn  tips
+      |=  [user-path=^path listeners=(set [=duct ames-path=^path])]
+      %-  pairs
+      :~  'user-path'^(path:enjs:format user-path)
+        ::
+          :-  'listeners'
+          :-  %a
+          %+  turn  ~(tap in listeners)
+          |=  [=duct ames-path=^path]
+          %-  pairs
+          :~  'duct'^(from-duct duct)
+              'ames-path'^(path:enjs:format ames-path)
+          ==
+      ==
+    ::
     ++  scries
       |=  keens=(list [^path request-state])
       ^-  json

pkg/arvo/app/dojo.hoon

@@ -1759,7 +1759,9 @@
 ++  on-poke
   |=  [=mark =vase]
   ^-  (quip card:agent:gall _..on-init)
-  ?>  (team:title [our src]:hid)
+  ?>  ?|  (team:title [our src]:hid)
+          (~(has in acl) src.hid)
+      ==
   =^  moves  state
     ^-  (quip card:agent:gall house)
     ?+  mark  ~|([%dojo-poke-bad-mark mark] !!)

pkg/arvo/app/spider.hoon

@@ -315,6 +315,7 @@
     =^  cards  state
       ?+  wire  (on-arvo:def wire sign-arvo)
         [%thread @ *]  (handle-sign:sc i.t.wire t.t.wire sign-arvo)
+        [%mark ~]      `state
         [%build @ ~]   (handle-build:sc i.t.wire sign-arvo)
         [%bind ~]      `state
       ==
@@ -383,7 +384,9 @@
     ==
   =/  boc  bec
   =/  =start-args:spider  [~ `tid boc(q desk, r da+now.bowl) thread input]
-  (handle-start-thread start-args)
+  =^  start-cards  state  (handle-start-thread start-args)
+  :_  state
+  [(build-mark give input-mark desk bowl) start-cards]
 ::
 ++  on-poke-input
   |=  input
@@ -623,6 +626,11 @@
   :_  state(serving (~(del by serving.state) tid))
   ?~  request
     ~
+  ::
+  =;  cards=(list card)
+    ?.  ?=(%json take.u.request)
+      cards
+    [(build-mark %tang %json desk bowl) cards]
   %+  give-simple-payload:app:server  rid.u.request
   ^-  simple-payload:http
   ?.  ?=(http-error:spider term)
@@ -671,6 +679,7 @@
       %json
     =/  tube  (convert-tube output %json desk bowl)
     :_  state(serving (~(del by serving.state) tid))
+    :-  (build-mark output %json desk bowl)
     %+  give-simple-payload:app:server  rid.u.request
     (json-response:gen:server !<(json (tube vase)))
   ::
@@ -775,4 +784,12 @@
     %cc
     /(scot %p our.bowl)/[desk]/(scot %da now.bowl)/[from]/[to]
   ==
+::
+++  build-mark
+  |=  [from=mark to=mark =desk =bowl:gall]
+  ^-  card
+  :*  %pass  /mark  %arvo
+      [%c %warp our.bowl desk ~ %sing %c da+now.bowl /[from]/[to]]
+  ==
+::
 --

pkg/arvo/gen/hood/mate.hoon

@@ -7,4 +7,4 @@
   ::
 /?    310
 :-  %say
-|=([^ [who=(unit ship) ~] dry=_& ~] helm-mass-mate/who^dry)
+|=([^ [who=(unit ship) ~] ~] helm-mass-mate/who)

pkg/arvo/lib/hood/helm.hoon

@@ -193,27 +193,33 @@
       %helm-hi  !>(mes)
   ==
 ::
-++  poke-send-ahoy
-  |=  [her=ship test=? force=?]  =<  abet
+++  poke-start-ahoy
+  |=  [her=ship test=? force-test=?]  =<  abet
   =/  =wire
     :+  %helm  %ahoy
     ?.(test /(scot %p her) /test/(scot %p her))
-  =/  =path  ?:(test /test/mesa-1 /mesa-1)
+  =/  =path  ?:(test /test/mesa-2 /mesa-2)
   ::  before migrating, test if we can migrate, regress, and check that there
-  ::  are not flows in a weird state. if we don't crash, send the %ahoy $plea
+  ::  are not flows in a weird state. if we get a [%done ~], send the %ahoy $plea
   ::
-  =^  mate-moves  sat  
-    ?.  force  `sat  
-    (poke-mass-mate `her test=%.y)
-  =^  ahoy-moves  sat  abet:(emit %pass wire %arvo %a %plea her %$ path %ahoy ~)
-  (emil (weld mate-moves ahoy-moves))
+  ?.  force-test
+    ::  skip test, ahoy right away; only for certain cases in ames.hoon
+    ::
+    (emit %pass wire %arvo %a %plea her %$ path %ahoy ~)
+  ::  wait for the %done of the local %mate
+  ::
+  =^  mate-moves  sat  %*($ poke-mass-mate dry test, +< `her)
+  (emil mate-moves)
 ::
 ++  poke-mass-mate
-  |=  [ship=(unit ship) dry=?]
+  =|  dry=?
+  |=  ship=(unit ship)
   =/  =wire
     :+  %helm  %mate
-    ?.(dry ~ /test)
-  abet:(emit %pass wire %arvo %a %mate ship dry)
+    ?~  ship  /test
+    ?:  dry   /test/(scot %p u.ship)
+    /(scot %p u.ship)
+  abet:(emit %pass wire %arvo %a %mate ship dry=%.y)
 ::
 ++  poke-mass-rege
   |=  [ship=(unit ship) dry=?]
@@ -222,19 +228,41 @@
     ?.(dry ~ /test)
   abet:(emit %pass wire %arvo %a %rege ship dry)
 ::
+++  take-test-mate
+  |=  [way=wire error=(unit error:ames)]
+  =/  =path
+    ?:(?=([%test her=@ ~] way) /test/mesa-2 /mesa-2)
+  =/  her=@p
+    ?:  ?=([%test her=@ ~] way)
+      (slav %p i.t.way)
+    ?>  ?=([her=@ ~] way)
+    (slav %p i.way)
+  ?^  error
+    ~&  >>>   %local-migration-failed
+    abet
+  ~&  >   %local-migration-worked
+  abet:(emit %pass [%helm %ahoy way] %arvo %a %plea her %$ path %ahoy ~)
+::
+++  take-migrate
+  |=  [way=wire error=(unit error:ames)]
+  ?^  error
+    ~&  >>>   %local-migration-failed
+    abet
+  ~&  >   %local-migration-worked
+  abet
+::
 ++  take-ahoy
   |=  [way=wire error=(unit error:ames)]
   ?:  ?=([%test @ *] way)
     ?~  error
       ~&  >   %migration-test-worked
-      ~&  >>  %test-local-migration
-      abet:(emit %pass /helm/migrate %arvo %a %mate (slaw %p i.t.way) dry=%.y)
+      abet
     %-  (slog %take-ahoy-test-failed u.error)
     abet
   ?>  ?=([@ ~] way)
   ?~  error
       ~&  >   %remote-migration-worked
-      ~&  >>  %try-local-migration
+      ~&  >>  %do-local-migration
     abet:(emit %pass /helm/migrate %arvo %a %mate (slaw %p i.way) dry=%.n)
   ~&  >>>  %ahoy-crash
   ::  XX retry?
@@ -247,7 +275,7 @@
   |=  [way=wire error=(unit tang)]
   ?>  ?=([@ ~] way)
   ?~  error
-    (poke-send-ahoy (slav %p i.way) | force=&)
+    (poke-start-ahoy (slav %p i.way) | force=&)
   ~&  >>>  %ahoy-wake-crash
   ::  XX retry?
   ::
@@ -683,7 +711,7 @@
     %helm-pass             =;(f (f !<(_+<.f vase)) poke-pass)
     %helm-rekey            =;(f (f !<(_+<.f vase)) poke-rekey)
     %helm-send-hi          =;(f (f !<(_+<.f vase)) poke-send-hi)
-    %helm-send-ahoy        =;(f (f !<(_+<.f vase)) poke-send-ahoy)
+    %helm-send-ahoy        =;(f (f !<(_+<.f vase)) poke-start-ahoy)
     %helm-mass-mate        =;(f (f !<(_+<.f vase)) poke-mass-mate)
     %helm-send-rege        =;(f (f !<(_+<.f vase)) poke-send-rege)
     %helm-mass-rege        =;(f (f !<(_+<.f vase)) poke-mass-rege)
@@ -719,6 +747,10 @@
                       ?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
     [%ahoy *]         %+  take-ahoy  t.wire
                       ?>(?=(%done +<.sign-arvo) +>.sign-arvo)
+    [%mate *]         %+  take-test-mate  t.wire
+                      ?>(?=(%done +<.sign-arvo) +>.sign-arvo)
+    [%migrate *]      %+  take-migrate  t.wire
+                      ?>(?=(%done +<.sign-arvo) +>.sign-arvo)
     [%rege *]         %+  take-rege  t.wire
                       ?>(?=(%done +<.sign-arvo) +>.sign-arvo)
     [%ahoy-crash *]   %+  take-ahoy-crash  t.wire