From 531630e93a4b040e785753f0a9635c43678adb03 Mon Sep 17 00:00:00 2001
From: Philip Monk <phil@pcmonk.me>
Date: Fri, 20 Mar 2020 15:30:52 -0700
Subject: [PATCH] clay: add %park task and -commit

%park is a plumbing commit task.  It guarantees completion in a single
event, so you have to do much of the work before calling it.  -commit
is an example of how to do this.
---
 bin/solid.pill              |   4 +-
 pkg/arvo/lib/strandio.hoon  |  44 +++++++++----
 pkg/arvo/sys/vane/clay.hoon |  52 +++++++++++++++
 pkg/arvo/sys/zuse.hoon      |  18 +++++-
 pkg/arvo/ted/commit.hoon    | 125 ++++++++++++++++++++++++++++++++++++
 pkg/arvo/ted/up.hoon        |   6 +-
 6 files changed, 231 insertions(+), 18 deletions(-)
 create mode 100644 pkg/arvo/ted/commit.hoon

diff --git a/bin/solid.pill b/bin/solid.pill
index bd5182311..4f588fa91 100644
--- a/bin/solid.pill
+++ b/bin/solid.pill
@@ -1,3 +1,3 @@
 version https://git-lfs.github.com/spec/v1
-oid sha256:4fb8003d603f01ed63813d04b0049fe145be0ee2509fbc8ac16bedf5fca8a335
-size 13073371
+oid sha256:36d204827bdd31705146bd95b1323b86eb037413b6990c10ace14c133d31f010
+size 13099016
diff --git a/pkg/arvo/lib/strandio.hoon b/pkg/arvo/lib/strandio.hoon
index b502340dd..a8bbd7262 100644
--- a/pkg/arvo/lib/strandio.hoon
+++ b/pkg/arvo/lib/strandio.hoon
@@ -410,31 +410,51 @@
 ::  Run several taggged ford builds
 ::
 ++  build-map
-  |=  builds=(map term schematic:ford)
-  =/  m  (strand ,(map term build-result:ford))
+  |=  builds=(map path schematic:ford)
+  =/  m  (strand ,(map path build-result:ford))
   ^-  form:m
   =/  schematics=(list schematic:ford)
     %+  turn  ~(tap by builds)
-    |=  [=term =schematic:ford]
-    [[%$ %noun !>(term)] schematic]
+    |=  [=path =schematic:ford]
+    [[%$ %noun !>(path)] schematic]
   ::
   ;<  =build-result:ford  bind:m  (ford-build %list schematics)
   ?:  ?=(%error -.build-result)
     (strand-fail %ford-error message.build-result)
   ?>  ?=(%list -.+.build-result)
   ::
-  =|  produce=(map term build-result:ford)
+  =|  produce=(map path build-result:ford)
   |-  ^-  form:m
   =*  loop  $
   ?^  results.build-result
     ?>  ?=([[%success %$ %noun *] *] +.i.results.build-result)
     =.  produce
       %+  ~(put by produce)
-        !<(term q.cage.head.i.results.build-result)
+        !<(path q.cage.head.i.results.build-result)
       tail.i.results.build-result
     loop(results.build-result t.results.build-result)
   (pure:m produce)
 ::
+::  Run several taggged ford builds
+::
+++  build-cages
+  |=  builds=(map path schematic:ford)
+  =/  m  (strand ,(map path cage))
+  ^-  form:m
+  ;<  result-map=(map path build-result:ford)  bind:m  (build-map builds)
+  =/  results=(list [=path =build-result:ford])  ~(tap by result-map)
+  =|  produce=(map path cage)
+  |-  ^-  form:m
+  =*  loop  $
+  ?^  results
+    ?:  ?=(%error -.build-result.i.results)
+      (strand-fail %ford-error message.build-result.i.results)
+    =.  produce
+      %+  ~(put by produce)  path.i.results
+      (result-to-cage:ford build-result.i.results)
+    loop(results t.results)
+  (pure:m produce)
+::
 ::  Run ford %core build
 ::
 ++  build-core
@@ -450,17 +470,17 @@
 ::  Run ford %core builds
 ::
 ++  build-cores
-  |=  rails=(map term rail:ford)
-  =/  m  (strand ,(map term vase))
+  |=  rails=(map path rail:ford)
+  =/  m  (strand ,(map path vase))
   ^-  form:m
   =/  builds
     %-  ~(run by rails)
     |=  =rail:ford
     [%core rail]
   ::
-  ;<  result-map=(map term build-result:ford)  bind:m  (build-map builds)
-  =/  results=(list [=term =build-result:ford])  ~(tap by result-map)
-  =|  produce=(map term vase)
+  ;<  result-map=(map path build-result:ford)  bind:m  (build-map builds)
+  =/  results=(list [=path =build-result:ford])  ~(tap by result-map)
+  =|  produce=(map path vase)
   |-  ^-  form:m
   =*  loop  $
   ?^  results
@@ -468,7 +488,7 @@
       (strand-fail %ford-error message.build-result.i.results)
     ?>  ?=(%core -.+.build-result.i.results)
     =.  produce
-      (~(put by produce) term.i.results vase.build-result.i.results)
+      (~(put by produce) path.i.results vase.build-result.i.results)
     loop(results t.results)
   (pure:m produce)
 ::
diff --git a/pkg/arvo/sys/vane/clay.hoon b/pkg/arvo/sys/vane/clay.hoon
index 5bd406df7..0752230ab 100644
--- a/pkg/arvo/sys/vane/clay.hoon
+++ b/pkg/arvo/sys/vane/clay.hoon
@@ -1931,6 +1931,7 @@
   ?-    p.p.rand
       $d  ~|  %totally-temporary-error-please-replace-me  !!
       $p  ~|  %requesting-foreign-permissions-is-invalid  !!
+      $s  ~|  %please-dont-get-your-takos-over-a-network  !!
       $t  ~|  %requesting-foreign-directory-is-vaporware  !!
       $u  ~|  %prolly-poor-idea-to-get-rang-over-network  !!
       $v  ~|  %weird-shouldnt-get-v-request-from-network  !!
@@ -2901,6 +2902,39 @@
       ==
     ==
   ::
+  ::  Plumbing commit
+  ::
+  ::    Guaranteed to finish in one event.
+  ::
+  ::    XX  needs to check that head is ancestor of tako
+  ::    XX  needs to check tako in rang
+  ::
+  ++  park
+    |=  [=tako =rang =ankh mim=(map path (unit mime))]
+    |^
+    ^+  ..park
+    =:  ank.dom  ankh
+        let.dom  +(let.dom)
+        hit.dom  (~(put by hit.dom) +(let.dom) tako)
+        mim.dom  (apply-changes-to-mim:util mim.dom mim)
+        hut.ran  (~(uni by hut.rang) hut.ran)
+        lat.ran  (~(uni by lat.rang) lat.ran)
+      ==
+    ergo
+    ::
+    ++  ergo
+      ^+  ..park
+      =/  must  (must-ergo:util her syd mon (turn ~(tap by mim) head))
+      %-  emil
+      %+  turn  ~(tap by must)
+      |=  [pot=term len=@ud pak=(set path)]
+      :*  (need hez)  %give  %ergo  pot
+          %+  turn  ~(tap in pak)
+          |=  pax=path
+          [(slag len pax) (~(got by mim) pax)]
+      ==
+    --
+  ::
   ::  Set permissions for a node.
   ::
   ++  perm
@@ -3856,6 +3890,17 @@
       ?:  =(%black mod.rul)
         !in-list
       in-list
+    ::  +read-s: produce yaki for given tako
+    ::
+    ++  read-s
+      |=  [yon=aeon pax=path]
+      ^-  (unit (unit [%yaki (hypo yaki)]))
+      ?.  ?=([* ~] pax)
+        `~
+      =/  yak=(unit yaki)  (~(get by hut.ran) (slav %uv i.pax))
+      ?~  yak
+        ~
+      ``yaki+`(hypo yaki)`[-:!>(*yaki) u.yak]
     ::  +read-t: produce the list of paths within a yaki with :pax as prefix
     ::
     ++  read-t
@@ -4031,6 +4076,7 @@
         [~ ~ %& %noun !>(~(key by dos.rom.ruf))]
       ::
         %p  (read-p path.mun)
+        %s  (bind (read-s yon path.mun) (lift |=(a=cage [%& a])))
         %t  (bind (read-t yon path.mun) (lift |=(a=cage [%& a])))
         %u  (read-u yon path.mun)
         %v  (bind (read-v yon path.mun) (lift |=(a/cage [%& a])))
@@ -4315,6 +4361,12 @@
       (skim ~(tap by mon.ruf) (corl (cury test pot) tail))
     |=  {pon/term bem/beam}
     [u.hez.ruf %give %ogre pon]
+  ::
+      %park
+    =^  mos  ruf
+      =/  den  ((de our now ski hen ruf) our des.req)
+      abet:(park:den [tak ran ank mim]:req)
+    [mos ..^$]
   ::
       %perm
     =^  mos  ruf
diff --git a/pkg/arvo/sys/zuse.hoon b/pkg/arvo/sys/zuse.hoon
index 65c3b2a50..d4d814d31 100644
--- a/pkg/arvo/sys/zuse.hoon
+++ b/pkg/arvo/sys/zuse.hoon
@@ -567,6 +567,8 @@
           {$mont des/desk bem/beam}                     ::  mount to unix
           {$dirk des/desk}                              ::  mark mount dirty
           {$ogre pot/$@(desk beam)}                     ::  delete mount point
+          {$park des/desk tak/tako ran/rang ank/ankh mim/(map path (unit mime))}
+                                                        ::  plumbing commit
           {$perm des/desk pax/path rit/rite}            ::  change permissions
           $>(%trim vane-task)                           ::  trim state
           $>(%vega vane-task)                           ::  report upgrade
@@ -591,7 +593,7 @@
     $%  {$delta p/lobe q/{p/mark q/lobe} r/page}        ::  delta on q
         {$direct p/lobe q/page}                         ::  immediate
     ==                                                  ::
-  ++  care  ?($d $p $t $u $v $w $x $y $z)               ::  clay submode
+  ++  care  ?($d $p $s $t $u $v $w $x $y $z)            ::  clay submode
   ++  case                                              ::  ship desk case spur
     $%  {$da p/@da}                                     ::  date
         {$tas p/@tas}                                   ::  label
@@ -697,6 +699,20 @@
         r/tako                                          ::  self-reference
         t/@da                                           ::  date
     ==                                                  ::
+  ::
+  ::  +page-to-lobe: hash a page to get a lobe.
+  ::
+  ++  page-to-lobe  |=(page (shax (jam +<)))
+  ::
+  ::  +make-yaki: make commit out of a list of parents, content, and date.
+  ::
+  ++  make-yaki
+    |=  {p/(list tako) q/(map path lobe) t/@da}
+    ^-  yaki
+    =+  ^=  has
+        %^  cat  7  (sham [%yaki (roll p add) q t])
+        (sham [%tako (roll p add) q t])
+    [p q has t]
   --  ::clay
 ::                                                      ::::
 ::::                    ++dill                            ::  (1d) console
diff --git a/pkg/arvo/ted/commit.hoon b/pkg/arvo/ted/commit.hoon
new file mode 100644
index 000000000..877539ba5
--- /dev/null
+++ b/pkg/arvo/ted/commit.hoon
@@ -0,0 +1,125 @@
+::  Delete `deletes`, insert/change `changes`, and don't touch anything
+::  else.
+::
+/-  spider
+/+  strandio
+=,  strand=strand:spider
+=,  clay
+^-  thread:spider
+|=  arg=vase
+=+  !<([=desk deletes=(set path) changes=(map path cage) ~] arg)
+=/  m  (strand ,vase)
+^-  form:m
+::
+::  Cast to expected marks
+::
+;<  our=@p  bind:m  get-our:strandio
+=/  cast-builds=(map path schematic:ford)
+  %-  ~(urn by changes)
+  |=  [=path =cage]
+  [%cast [our desk] =>((flop path) ?~(. %$ i)) %$ cage]
+;<  cast-results=(map path cage)  bind:m  (build-cages:strandio cast-builds)
+::
+::  Fetch current state
+::
+;<  now=@da  bind:m  get-time:strandio
+=+  .^(=dome %cv /(scot %p our)/[desk]/(scot %da now))
+::
+::  Apply changes to current state to create new yaki
+::
+=/  new-blobs=(map path blob)
+  %-  ~(run by cast-results)
+  |=  =cage
+  =/  =page  [p q.q]:cage
+  [%direct (page-to-lobe page) page]
+::
+=/  parent-tako=tako  (~(got by hit.dome) let.dome)
+=/  all-lobes=(map path lobe)
+  =+  .^  parent-yaki=yaki  %cs
+          /(scot %p our)/[desk]/(scot %da now)/(scot %uv parent-tako)
+      ==
+  =/  after-deletes
+    %-  ~(dif by q.parent-yaki)
+    (malt (turn ~(tap in deletes) |=(=path [path *lobe])))
+  %-  ~(uni by after-deletes)
+  (~(run by new-blobs) |=(=blob p.blob))
+::
+::  XX should we get getting the time later, after all async?
+;<  now=@da  bind:m  get-time:strandio
+=/  new-yaki=yaki  (make-yaki ~[parent-tako] all-lobes now)
+::
+::  Apply new blobs and yaki to rang
+::
+=/  =rang
+  :-  (~(put by hut:*rang) r.new-yaki new-yaki)
+  (malt (turn ~(tap by new-blobs) |=([=path =blob] [p.blob blob])))
+::
+::  Checkout ankh
+::
+=/  =ankh  ank.dome
+=.  ankh
+  =/  dels  ~(tap in deletes)
+  |-  ^-  ^ankh
+  =*  outer-loop  $
+  ?~  dels
+    ankh
+  |-  ^-  ^ankh
+  =*  inner-loop  $
+  ?~  i.dels
+    outer-loop(dels t.dels, fil.ankh ~)
+  %=    ankh
+      dir
+    %+  ~(put by dir.ankh)  i.i.dels
+    %=  inner-loop
+      i.dels  t.i.dels
+      ankh    (~(gut by dir.ankh) i.i.dels *^ankh)
+    ==
+  ==
+=.  ankh
+  =/  blobs=(list [=path =blob])  ~(tap by new-blobs)
+  |-  ^-  ^ankh
+  =*  outer-loop  $
+  ?~  blobs
+    ankh
+  =/  orig-path  path.i.blobs
+  |-  ^-  ^ankh
+  =*  inner-loop  $
+  ?~  path.i.blobs
+    %=    outer-loop
+        blobs     t.blobs
+        fil.ankh
+      ?>  ?=(%direct -.blob.i.blobs)
+      :+  ~  p.blob.i.blobs
+      (~(got by cast-results) orig-path)
+    ==
+  %=    ankh
+      dir
+    %+  ~(put by dir.ankh)  i.path.i.blobs
+    %=  inner-loop
+      path.i.blobs  t.path.i.blobs
+      ankh          (~(gut by dir.ankh) i.path.i.blobs *^ankh)
+    ==
+  ==
+::
+::  Checkout cache
+::
+=/  mim-builds=(map path schematic:ford)
+  %-  ~(run by cast-results)
+  |=  =cage
+  [%cast [our desk] %mime %$ cage]
+;<  mim-results=(map path cage)  bind:m  (build-cages:strandio mim-builds)
+=/  can-mim=(map path (unit mime))
+  %-  ~(run by mim-results)
+  |=  =cage
+  ?>  ?=(%mime p.cage)
+  `!<(mime q.cage)
+=/  del-mim=(map path (unit mime))
+  (malt (turn ~(tap in deletes) |=(=path [path ~])))
+=/  new-mim=(map path (unit mime))
+  (~(uni by del-mim) can-mim)
+::
+::  Send to clay
+::
+=/  args  [desk r.new-yaki rang ankh new-mim]
+;<  ~  bind:m  (send-raw-card:strandio %pass /commit/[desk] %arvo %c %park args)
+(pure:m !>(~))
diff --git a/pkg/arvo/ted/up.hoon b/pkg/arvo/ted/up.hoon
index 381deaf95..9aa5ce3e0 100644
--- a/pkg/arvo/ted/up.hoon
+++ b/pkg/arvo/ted/up.hoon
@@ -7,7 +7,7 @@
 |^
 =/  m  (strand ,vase)
 ^-  form:m
-;<  apps=(map term vase)  bind:m  load-apps
+;<  apps=(map path vase)  bind:m  load-apps
 (pure:m !>((~(run by apps) mug)))
 ::
 ++  scratch-path
@@ -15,7 +15,7 @@
   (weld /(scot %p our.bowl)/[scratch]/(scot %da now.bowl) path)
 ::
 ++  load-apps
-  =/  m  (strand ,(map term vase))
+  =/  m  (strand ,(map path vase))
   ^-  form:m
   ;<  =bowl:spider  bind:m  get-bowl:strandio
   =+  .^(=arch %cy (scratch-path bowl /app))
@@ -28,6 +28,6 @@
     =+  .^(=app=^arch %cy (scratch-path bowl /app/[term]))
     ?.  (~(has by dir.app-arch) %hoon)
       ~
-    `[term our.bowl^scratch /hoon/[term]/app]
+    `[/[term] our.bowl^scratch /hoon/[term]/app]
   (build-cores:strandio rails)
 --