Merge branch 'jm/spider-gall' into dist

pkg/arvo/app/spider.hoon

@@ -1,5 +1,5 @@
 /-  spider
-/+  libstrand=strand, default-agent, verb, server
+/+  libstrand=strand, default-agent, verb, server, dbug
 =,  strand=strand:libstrand
 ~%  %spider-top  ..part  ~
 |%
@@ -18,7 +18,7 @@
   $:  starting=(map yarn [=trying =vase])
       running=trie
       tid=(map tid yarn)
-      serving=(map tid [@ta =mark =desk])
+      serving=(map tid [(unit @ta) =mark =desk])
   ==
 ::
 +$  clean-slate-any
@@ -26,10 +26,19 @@
   $%  clean-slate-sig
       clean-slate-1
       clean-slate-2
+      clean-slate-3
       clean-slate
   ==
 ::
 +$  clean-slate
+  $:  %4
+      starting=(map yarn [=trying =vase])
+      running=(list yarn)
+      tid=(map tid yarn)
+      serving=(map tid [(unit @ta) =mark =desk])
+  ==
+::
++$  clean-slate-3
   $:  %3
       starting=(map yarn [=trying =vase])
       running=(list yarn)
@@ -144,6 +153,7 @@
   (welp next-1 next-2)
 --
 ::
+%-  agent:dbug
 ^-  agent:gall
 =|  =state
 =<
@@ -156,7 +166,7 @@
       def          ~(. (default-agent this %|) bowl)
       bec          byk.bowl(r da+now.bowl)
   ::
-  ++  on-init   
+  ++  on-init
     ^-  (quip card _this)
     :_  this
     ~[bind-eyre:sc]
@@ -167,10 +177,11 @@
     =+  !<(any=clean-slate-any old-state)
     =?  any  ?=(^ -.any)  (old-to-1 any)
     =?  any  ?=(~ -.any)  (old-to-1 any)
-    =^  upgrade-cards  any  
+    =^  upgrade-cards  any
       (old-to-2 any)
     =.  any  (old-to-3 any)
-    ?>  ?=(%3 -.any)
+    =.  any  (old-to-4 any)
+    ?>  ?=(%4 -.any)
     ::
     =.  tid.state  tid.any
     =/  yarns=(list yarn)
@@ -193,8 +204,8 @@
     ++  old-to-2
       |=  old=clean-slate-any
       ^-  (quip card clean-slate-any)
-      ?>  ?=(?(%1 %2 %3) -.old)
+      ?>  ?=(?(%1 %2 %3 %4) -.old)
-      ?:  ?=(?(%2 %3) -.old)
+      ?:  ?=(?(%2 %3 %4) -.old)
         `old
       :-  ~[bind-eyre:sc]
       :*  %2
@@ -206,9 +217,9 @@
     ::
     ++  old-to-3
       |=  old=clean-slate-any
-      ^-  clean-slate
+      ^-  clean-slate-any
-      ?>  ?=(?(%2 %3) -.old)
+      ?>  ?=(?(%2 %3 %4) -.old)
-      ?:  ?=(%3 -.old)
+      ?:  ?=(?(%3 %4) -.old)
         old
       :*  %3
         starting.old
@@ -216,6 +227,18 @@
         tid.old
         (~(run by serving.old) |=([id=@ta =mark] [id mark q.byk.bowl]))
       ==
+    ++  old-to-4
+      |=  old=clean-slate-any
+      ^-  clean-slate
+      ?>  ?=(?(%3 %4) -.old)
+      ?:  ?=(%4 -.old)
+        old
+      :*  %4
+        starting.old
+        running.old
+        tid.old
+        (~(run by serving.old) |=([id=@ta =mark =desk] [`id mark q.byk.bowl]))
+      ==
     --
   ::
   ++  on-poke
@@ -230,7 +253,7 @@
         %spider-start  (handle-start-thread:sc !<(start-args vase))
         %spider-stop   (handle-stop-thread:sc !<([tid ?] vase))
       ::
-          %handle-http-request   
+          %handle-http-request
         (handle-http-request:sc !<([@ta =inbound-request:eyre] vase))
       ==
     [cards this]
@@ -309,7 +332,7 @@
   |=  [eyre-id=@ta =inbound-request:eyre]
   ^-  (quip card _state)
   ::?>  authenticated.inbound-request
-  =/  url 
+  =/  url
     (parse-request-line:server url.request.inbound-request)
   ?>  ?=([%spider @t @t @t @t ~] site.url)
   =*  desk         i.t.site.url
@@ -318,14 +341,10 @@
   =*  output-mark  i.t.t.t.t.site.url
   =/  =tid         (new-thread-id thread)
   =.  serving.state
-    (~(put by serving.state) tid [eyre-id output-mark desk])
+    (~(put by serving.state) tid [`eyre-id output-mark desk])
   ::  TODO: speed this up somehow. we spend about 15ms in this arm alone
   ::
-  =+  .^
+  =/  tube  (convert-tube %json input-mark desk bowl)
-      =tube:clay
-      %cc 
-      /(scot %p our.bowl)/[desk]/(scot %da now.bowl)/json/[input-mark]
-    ==
   ?>  ?=(^ body.request.inbound-request)
   =/  body=json  (need (de-json:html q.u.body.request.inbound-request))
   =/  input=vase  (slop !>(~) (tube !>(body)))
@@ -384,7 +403,8 @@
   ::
   =:  starting.state  (~(put by starting.state) yarn [%build vase])
       tid.state       (~(put by tid.state) new-tid yarn)
-    ==
+      serving.state  (~(put by serving.state) new-tid [~ %noun q.beak])
+  ==
   =/  pax=path
     ~|  no-file-for-thread+file
     (need (get-fit:clay beak %ted file))
@@ -453,7 +473,7 @@
   ^-  (quip card ^state)
   =/  m  (strand ,vase)
   ?.  (has-yarn running.state yarn)
-    %-  (slog leaf+"spider got input for non-existent {<yarn>} 2" ~)
+    %-  (slog leaf+"spider got input for non-existent {<yarn>}" ~)
     `state
   =/  =eval-form:eval:m
     thread-form:(need (get-yarn running.state yarn))
@@ -511,11 +531,13 @@
   |=  [=tid =term =tang]
   ^-  (quip card ^state)
   =-  (fall - `state)
-  %+  bind  
+  %+  bind
     (~(get by serving.state) tid)
-  |=  [eyre-id=@ta output=mark =desk]
+  |=  [eyre-id=(unit @ta) output=mark =desk]
   :_  state(serving (~(del by serving.state) tid))
-  %+  give-simple-payload:app:server  eyre-id
+  ?~  eyre-id
+    ~
+  %+  give-simple-payload:app:server  u.eyre-id
   ^-  simple-payload:http
   :_  ~  :_  ~
   ?.  ?=(http-error:spider term)
@@ -541,16 +563,14 @@
   |=  [=tid =vase]
   ^-  (quip card ^state)
   =-  (fall - `state)
-  %+  bind  
+  %+  bind
     (~(get by serving.state) tid)
-  |=  [eyre-id=@ta output=mark =desk]
+  |=  [eyre-id=(unit @ta) output=mark =desk]
-  =+    .^
+  ?~  eyre-id
-      =tube:clay
+    `state
-      %cc
+  =/  tube  (convert-tube output %json desk bowl)
-      /(scot %p our.bowl)/[desk]/(scot %da now.bowl)/[output]/json
-    ==
   :_  state(serving (~(del by serving.state) tid))
-  %+  give-simple-payload:app:server  eyre-id
+  %+  give-simple-payload:app:server  u.eyre-id
   (json-response:gen:server !<(json (tube vase)))
 ::
 ++  thread-done
@@ -581,6 +601,7 @@
     =/  =tid  (yarn-to-tid yarn)
     =:  running.state  (del-yarn running.state yarn)
         tid.state      (~(del by tid.state) tid)
+        serving.state      (~(del by serving.state) (yarn-to-tid yarn))
       ==
     :_  state
     %+  murn  ~(tap by wex.bowl)
@@ -597,14 +618,14 @@
   |=  [=yarn =bowl:gall]
   ^-  bowl:spider
   :*  our.bowl
-      src.bowl
+    src.bowl
       (yarn-to-tid yarn)
       (yarn-to-parent yarn)
       wex.bowl
       sup.bowl
       eny.bowl
       now.bowl
-      byk.bowl
+      (yarn-to-byk yarn bowl)
   ==
 ::
 ++  yarn-to-tid
@@ -623,7 +644,25 @@
     ~
   `i.t.nary
 ::
+++  yarn-to-byk
+  |=  [=yarn =bowl:gall]
+
+  =/  [* * =desk]
+    ~|  "no desk associated with {<tid>}"
+     %-  ~(got by serving.state)  (yarn-to-tid yarn)
+  =/  boc  bec
+  boc(q desk)
+::
 ++  clean-state
   !>  ^-  clean-slate
-  3+state(running (turn (tap-yarn running.state) head))
+  4+state(running (turn (tap-yarn running.state) head))
+::
+++  convert-tube
+  |=  [from=mark to=mark =desk =bowl:gall]
+  .^
+    tube:clay
+    %cc
+    /(scot %p our.bowl)/[desk]/(scot %da now.bowl)/[from]/[to]
+  ==
+
 --

pkg/arvo/sys/vane/clay.hoon

@@ -1590,9 +1590,7 @@
     =.  mim.dom  (apply-changes-to-mim mim.dom mim)
     =.  fod.dom  ford-cache.args
     =.  ..park  (emil (print q.old-yaki data))
-    ::
     =?  ..park  &(updated !dist-upgraded.ruf)  migrate-dist
-    ::
     wake:(ergo mim)
     ::
     ++  migrate-dist

pkg/arvo/sys/vane/gall.hoon

@@ -1408,6 +1408,9 @@
         ?.  ?=(%raw-fact -.unto)
           [unto ap-core]
         =/  =case:clay  da+now
+        ?:  ?=(%spider agent-name)
+          :-  [%fact mark.unto !>(noun.unto)]
+          ap-core
         =/  sky  (rof ~ %cb [our q.beak.yoke case] /[mark.unto])
         ?.  ?=([~ ~ *] sky)
           (mean leaf+"gall: ames mark fail {<mark.unto>}" ~)

pkg/base-dev/lib/strand.hoon

@@ -128,6 +128,17 @@
           [%done value=a]
       ==
     ::
+    ++  validate-mark
+      |=  [in=* =mark =bowl]
+      ^-  cage
+      =+  .^  =dais:clay  %cb
+              /(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[mark]
+          ==
+      =/  res  (mule |.((vale.dais in)))
+      ?:  ?=(%| -.res)
+        ~|(%spider-mark-fail (mean leaf+"spider: ames vale fail {<mark>}" p.res))
+      [mark p.res]
+    ::
     ::  Take a new sign and run the strand against it
     ::
     ++  take
@@ -137,6 +148,15 @@
       |=  [=eval-form =strand-input]
       ^-  [[(list card) =eval-result] _eval-form]
       =*  take-loop  $
+      =.  in.strand-input
+        ?~  in.strand-input  ~
+        =/  in  u.in.strand-input
+        ?.  ?=(%agent -.in)      `in
+        ?.  ?=(%fact -.sign.in)  `in
+        ::
+        :-  ~
+        :+  %agent  wire.in
+        [%fact (validate-mark q.cage.sign.in p.cage.sign.in bowl.strand-input)]
       ::  run the strand callback
       ::
       =/  =output  (form.eval-form strand-input)
@@ -165,3 +185,4 @@
     --
   --
 --
+::

pkg/base-dev/mar/glob.hoon

@@ -1,11 +0,0 @@
-|_  gob=(map path mime)
-++  grow
-  |%
-  ++  noun  gob
-  --
-++  grab
-  |%
-  ++  noun  (map path mime)
-  --
-++  grad  ~&(%grid-mar %noun)
---

pkg/garden/app/docket.hoon

@@ -274,54 +274,18 @@
       ?~  p.sign  `state
       ((slog leaf+"Failed to uninstall %{(trip desk)}" u.p.sign) `state)
     ::
-        [%glob @ %ames @ ~]
+        ?([%glob @ %http @ ~] [%glob @ %ames @ ~])
-      ?-  -.sign
-        %kick      `state
-        %poke-ack  ~&([dap.bowl %unexpected-poke-ack] `state)
-      ::
-          %watch-ack
-        ?~  p.sign  `state
-        %-  %-  slog
-            leaf+"docket: failed to fetch glob over ames for {(trip desk)}"
-        =.  charges  (new-chad:cha hung+'failed to fetch glob via ames')
-        [~[add-fact:cha] state]
-      ::
-          %fact
-        ?.  =(%glob p.cage.sign)
-          ~&  [dap.bowl %unexpected-fact from=src.bowl p.cage.sign]
-          `state
-        =+  !<(=glob q.cage.sign)
-        =/  =docket  docket:(~(got by charges) desk)
-        ?.  ?=([%glob @ @ %ames *] href.docket)
-          `state
-        =*  want=@uv  hash.glob-reference.href.docket
-        =/  plea=@uv  (slav %uv i.t.wire)
-        ?.  =(want plea)
-          ::  we requested this at some point but no longer want it
-          ::
-          `state
-        =/  have=@uv  (hash-glob glob)
-        ?.  =(want have)
-          %.  `state
-          %-  slog
-          :~  leaf+"docket: glob hash mismatch on {<desk>} from {<src.bowl>}"
-              leaf+"expected: {<want>}"
-              leaf+"received: {<have>}"
-          ==
-        =.  charges  (new-chad:cha glob+glob)
-        =.  by-base  (~(put by by-base) base.href.docket desk)
-        [~[add-fact:cha] state]
-      ==
-    ::
-        [%glob @ %http @ ~]
       ?-  -.sign
         %kick   `state
       ::
           ?(%poke-ack %watch-ack)
         ?~  p.sign  `state
         =/  act=tape  ?:(?=(%poke-ack -.sign) "start" "listen")
-        =.  charges  (new-chad:cha hung+'glob-failed')
+        =.  charges
-        :-  ~[add-fact:cha]
+          %-  new-chad:cha
+          ?:  ?=(i.t.t.wire %http)
+            hung+'failed to fetch glob via http'
+          hung+'failed to fetch glob via ames'
         ((slog leaf+"docket: couldn't {act} thread; will retry" u.p.sign) state)
       ::
           %fact
@@ -671,12 +635,7 @@
       ?:  =(our.bowl ship.location.ref)
         ~>  %slog.0^leaf/"docket: awaiting manual glob for {<desk>} desk"
         ~
-      ~>  %slog.0^leaf/"docket: fetching ames glob for {<desk>} desk"
+    ~>  %slog.0^leaf/"docket: fetching {<-.location.ref>} glob for {<desk>} desk"
-      :_  ~
-      %+  watch:(pass (glob-wire ref))
-        [ship.location.ref %docket]
-      /glob/[base.href.docket.charge]/(scot %uv hash.ref)
-    ~>  %slog.0^leaf/"docket: fetching http glob for {<desk>} desk"
     =/  =cage  spider-start+!>([~ `tid byk.bowl(r da+now.bowl) %glob !>(`[ref desk])])
     :~  (watch-our:(pass (glob-wire ref)) %spider /thread-result/[tid])
         (poke-our:(pass (glob-wire ref)) %spider cage)

pkg/garden/mar/glob.hoon

@@ -1 +0,0 @@
-../../base-dev/mar/glob.hoon

pkg/garden/mar/glob.hoon

@@ -0,0 +1,11 @@
+|_  gob=(map path mime)
+++  grow
+  |%
+  ++  noun  gob
+  --
+++  grab
+  |%
+  ++  noun  (map path mime)
+  --
+++  grad  ~&(%grid-mar %noun)
+--

pkg/garden/ted/glob.hoon

@@ -9,7 +9,7 @@
 |^
 ?-  -.location.ref
   %http  (fetch-http [url.location hash]:ref)
-  %ames  !!  ::NOTE  done within docket itself
+  %ames  (fetch-ames [ship.location hash]:ref base)
 ==
 ::
 ++  fetch-http
@@ -22,7 +22,16 @@
     %-  pure:n
     %-  mole
     |.
-    =-  ?>(=(hash (sham -)) -)
     ;;(=glob:docket (cue cord))
   (pure:m !>(glob))
+::
+::  download from ship's docket state
+++  fetch-ames
+  |=  [[=ship hash=@uvH] base=term]
+  ^-  form:m
+  ;<  =bowl:spider  bind:m  get-bowl:strandio
+  ;<  =cage  bind:m
+    (watch-one:strandio /glob/(scot %da now.bowl) [ship %docket] /glob/[base]/(scot %uv hash))
+  ?>  ?=(%glob p.cage)
+  (pure:m q.cage)
 --