mall: convert lens

bin/solid.pill

@@ -1,3 +1,3 @@
 version https://git-lfs.github.com/spec/v1
-oid sha256:4c69f15d99dee616721a2c1617d35c5befad3343b918a25a819880546b783b98
+oid sha256:6eba700d43103eaff83a0d58d3656ec11cf0d2ac6a7937293ada967e15fd832e
-size 9017827
+size 8946520

pkg/arvo/age/dojo.hoon

@@ -10,10 +10,11 @@
 ::::                                                    ::  ::::
   ::                                                    ::    ::
 =>  |%                                                  ::  external structures
+    ++  id  @tasession                                  ::  session id
     ++  house                                           ::  all state
       $:  $5
           egg/@u                                        ::  command count
-          hoc/(map bone session)                        ::  conversations
+          hoc/(map id session)                          ::  conversations
       ==                                                ::
     ++  session                                         ::  per conversation
       $:  say/sole-share                                ::  command-line state
@@ -300,7 +301,7 @@
 ++  xsell  `$-(vase tank)`vase-to-tank:pprint
 ::
 ++  he                                                  ::  per session
-  |_  {hid/bowl:mall ost=bone moz/(list card:agent:mall) session}
+  |_  {hid/bowl:mall =id moz/(list card:agent:mall) session}
   ::
   ++  he-beam
     ^-  beam
@@ -795,21 +796,19 @@
     ==
   ::
   ++  he-abet                                           ::  resolve
-    [(flop moz) %_(state hoc (~(put by hoc) ost +<+>+))]
+    [(flop moz) %_(state hoc (~(put by hoc) id +<+>+))]
-  ::
-  ++  he-abut                                           ::  discard
-    =>  he-stop
-    [(flop moz) %_(state hoc (~(del by hoc) ost))]
   ::
   ++  he-card                                           ::  emit gift
     |=  =card:agent:mall
     ^+  +>
+    =?  card  ?=(%pass -.card)
+      card(p [id p.card])
     %_(+> moz [card moz])
   ::
   ++  he-diff                                           ::  emit update
     |=  fec/sole-effect
     ^+  +>
-    (he-card %give %fact `/sole %sole-effect !>(fec))
+    (he-card %give %fact `/sole/[id] %sole-effect !>(fec))
   ::
   ++  he-stop                                           ::  abort work
     ^+  .
@@ -1155,7 +1154,6 @@
     !>([our=our now=now eny=eny]:hid)
   --
 --
-=/  ost=bone  0
 ^-  agent:mall
 |_  hid=bowl:mall
 ++  on-init
@@ -1172,14 +1170,21 @@
 ++  on-poke
   |=  [=mark =vase]
   ^-  (quip card:agent:mall _..on-init)
-  =/  a-session=session  (~(got by hoc) ost)
-  =/  he-full  ~(. he hid ost ~ a-session)
   =^  moves  state
     ^-  (quip card:agent:mall house)
     ?+  mark  ~|([%dojo-poke-bad-mark mark] !!)
-        %sole-action   he-abet:(he-type:he-full !<(sole-action vase))
+        %sole-action
-        %lens-command  he-abet:(he-lens:he-full !<(command:lens vase))
+      =+  !<([=id =sole-action] vase)
-        %json          ~&  jon=!<(json vase)  `state
+      he-abet:(~(he-type he hid id ~ (~(got by hoc) id)) sole-action)
+    ::
+        %lens-command
+      =+  !<([=id =command:lens] vase)
+      he-abet:(~(he-lens he hid id ~ (~(got by hoc) id)) command)
+    ::
+        %json
+      ~&  jon=!<(json vase)
+      `state
+    ::
         %wipe
       ~&  %dojo-wipe
       =.  hoc
@@ -1201,22 +1206,21 @@
   ^-  (quip card:agent:mall _..on-init)
   ~?  !=(our.hid src.hid)  [%dojo-peer-stranger src.hid]
   ?>  (team:title our.hid src.hid)
-  =^  moves-1  state
+  ?>  ?=([%sole @ ~] path)
-    ?.  (~(has by hoc) ost)  [~ state]
+  =/  id  i.t.path
-    ~&  [%dojo-peer-replaced ost]
+  =?  hoc  (~(has by hoc) id)
-    ~(he-abut he hid ost ~ (~(got by hoc) ost))
+    ~&  [%dojo-peer-replaced id]
-  =^  moves-2  state
+    (~(del by hoc) id)
+  =.  hoc
     =/  =session  %*(. *session -.dir [our.hid %home ud+0])
-    ?>  ?=([%sole *] path)
+    (~(put by hoc) id session)
-    he-abet:(~(he-peer he hid ost moves-1 session) t.path)
+  [~ ..on-init]
-  [moves-2 ..on-init]
 ::
 ++  on-leave
-  |=  path
+  |=  =path
-  =^  moves  state
+  ?>  ?=([%sole *] path)
-    ~(he-abut he hid ost ~ (~(got by hoc) ost))
+  =.  hoc  (~(del by hoc) t.path)
-  =.  hoc  (~(del by hoc) ost)
+  [~ ..on-init]
-  [moves ..on-init]
 ::
 ++  on-peek
   |=  path
@@ -1224,27 +1228,29 @@
 ::
 ++  on-agent
   |=  [=wire =sign:agent:mall]
-  =/  =session  (~(got by hoc) ost)
+  ?>  ?=([@ *] wire)
+  =/  =session  (~(got by hoc) i.wire)
   =^  moves  state
-    he-abet:(~(he-unto he hid ost ~ session) wire sign)
+    he-abet:(~(he-unto he hid i.wire ~ session) t.wire sign)
   [moves ..on-init]
 ::
 ++  on-arvo
   |=  [=wire =sign-arvo]
-  =/  =session  (~(got by hoc) ost)
+  ?>  ?=([@ *] wire)
-  =/  he-full  ~(. he hid ost ~ session)
+  =/  =session  (~(got by hoc) i.wire)
+  =/  he-full  ~(. he hid i.wire ~ session)
   =^  moves  state
     =<  he-abet
     ?+    +<.sign-arvo  ~|([%dojo-bad-take +<.sign-arvo] !!)
-        %made           (he-made:he-full wire +>.sign-arvo)
+        %made           (he-made:he-full t.wire +>.sign-arvo)
-        %http-response  (he-http-response:he-full wire +>.sign-arvo)
+        %http-response  (he-http-response:he-full t.wire +>.sign-arvo)
     ==
   [moves ..on-init]
 ::
 ++  on-fail
   |=  [=term =tang]
-  =/  =session  (~(got by hoc) ost)
+  =/  =session  (~(got by hoc) 'drum')
   =^  moves  state
-    he-abet:(~(he-lame he hid ost ~ session) term tang)
+    he-abet:(~(he-lame he hid 'drum' ~ session) term tang)
   [moves ..on-init]
 --

pkg/arvo/age/hood.hoon

@@ -100,7 +100,7 @@
       ++  ably                                          ::  save part
         =+  $:{(list) hood-part}
         |@  ++  $
-              [(flop +<-) (~(put by lac) +<+< +<+)]
+              [+<- (~(put by lac) +<+< +<+)]
         --
       ::                                                ::  ::
       ::::                                              ::  ::  generic handling

pkg/arvo/age/lens.hoon

@@ -0,0 +1,214 @@
+/-  lens, *sole
+/+  base64, *server, default-agent
+/=  lens-mark  /:  /===/mar/lens/command
+                   /!noun/
+=,  format
+|%
+::  +lens-out: json or named octet-stream
+::
++$  lens-out
+  $%  [%json =json]
+      [%mime =mime]
+  ==
++$  state
+  $%  $:  %0
+          job=(unit [eyre-id=@ta com=command:lens])
+      ==
+  ==
+::
+--
+::
+=|  =state
+|_  =bowl:mall
++*  this  .
+    def   ~(. (default-agent this %|) bowl)
+::
+++  on-init   on-init:def
+++  on-save   !>(state)
+++  on-load
+  |=  old=vase
+  `this(state !<(^state old))
+::
+++  on-poke
+  |=  [=mark =vase]
+  ^-  (quip card:agent:mall _this)
+  ?.  ?=(%handle-http-request mark)
+    (on-poke:def mark vase)
+  =+  !<([eyre-id=@ta =inbound-request:eyre] vase)
+  ?>  ?=(~ job.state)
+  ::
+  =/  request-line  (parse-request-line url.request.inbound-request)
+  =/  site  (flop site.request-line)
+  ::
+  =/  jon=json
+    (need (de-json:html q:(need body.request.inbound-request)))
+  =/  com=command:lens
+    (json:grab:lens-mark jon)
+  ::
+  ?:  ?=(%export -.source.com)
+    ~&  [%export app.source.com]
+    :_  this(job.state (some [eyre-id com]))
+    [%pass /export %agent [our.bowl app.source.com] %watch /export]~
+  ::
+  ?:  ?=(%import -.source.com)
+    ?~  enc=(de:base64 base64-jam.source.com)
+      !!
+    ::
+    =/  c=*  (cue q.u.enc)
+    ::
+    :_  this(job.state (some [eyre-id com]))
+    [%pass /import %agent [our.bowl app.source.com] %poke %import !>(c)]~
+  ::
+  :_  this(job.state (some [eyre-id com]))
+  [%pass /sole %agent [our.bowl %dojo] %watch /sole/[eyre-id]]~
+::
+++  on-watch
+  |=  =path
+  ^-  (quip card:agent:mall _this)
+  ?:  ?=([%http-response *] path)
+    `this
+  (on-watch:def path)
+::
+++  on-leave  on-leave:def
+++  on-peek   on-peek:def
+++  on-agent
+  |=  [=wire =sign:agent:mall]
+  ^-  (quip card:agent:mall _this)
+  |^
+  ?+    wire  (on-agent:def wire sign)
+      [%import ~]
+    ?>  ?=(%poke-ack -.sign)
+    ?>  ?=(^ job.state)
+    :_  this(job.state ~)
+    %+  give-simple-payload:app  eyre-id.u.job.state
+    [[200 ~] `(as-octt:mimes:html "\"Imported data\"")]
+  ::
+      [%export ~] 
+    ?+    -.sign  (on-agent:def wire sign)
+        %watch-ack
+      ?~  p.sign
+        `this
+      ?>  ?=(^ job.state)
+      :_  this(job.state ~)
+      (give-simple-payload:app eyre-id.u.job.state not-found:gen)
+    ::
+        %fact
+      =^  cards  this  (take-export !<(* q.cage.sign))
+      :_  this  :_  cards
+      ?>  ?=(^ job.state)
+      ?>  ?=(%export -.source.com.u.job.state)
+      [%pass /export %agent [our.bowl app.source.com.u.job.state] %leave ~]
+    ==
+  ::
+      [%sole ~]
+    ?+    -.sign  (on-agent:def wire sign)
+        %watch-ack
+      ?>  ?=(^ job.state)
+      ?^  p.sign
+        :_  this(job.state ~)
+        (give-simple-payload:app eyre-id.u.job.state not-found:gen)
+      :_  this  :_  ~
+      :*  %pass  /sole
+          %agent  [our.bowl %dojo]
+          %poke  %lens-command  !>
+          [eyre-id.u.job.state com.u.job.state]
+      ==
+    ::
+        %fact
+      ?>  ?=(%sole-effect p.cage.sign)
+      =^  cards  this  (take-sole-effect !<(sole-effect q.cage.sign))
+      [[[%pass /sole %agent [our.bowl %dojo] %leave ~] cards] this]
+    ==
+  ==
+  ::
+  ++  take-export
+    |=  data=*
+    ^-  (quip card:agent:mall _this)
+    ?>  ?=(^ job.state)
+    ?>  ?=(%export -.source.com.u.job.state)
+    =/  app-name=tape  (trip app.source.com.u.job.state)
+    =/  output=@t  (crip "/{app-name}/jam")
+    ::
+    =/  jon=json
+      =/  =atom  (jam data)
+      =/  =octs  [(met 3 atom) atom]
+      =/  enc  (en:base64 octs)
+      (pairs:enjs:format file+s+output data+s+enc ~)
+    ::
+    :_  this(job.state ~)
+    %+  give-simple-payload:app  eyre-id.u.job.state
+    (json-response:gen (json-to-octs jon))
+  ::
+  ++  take-sole-effect
+    |=  fec=sole-effect
+    ^-  (quip card:agent:mall _this)
+    =/  out
+      |-  ^-  (unit lens-out)
+      =*  loop  $
+      ?+  -.fec
+        ~
+      ::
+          %tan
+        %-  some
+        :-  %json
+        %-  wall:enjs:format
+        (turn (flop p.fec) |=(=tank ~(ram re tank)))
+      ::
+          %txt
+        (some %json s+(crip p.fec))
+      ::
+          %sag
+        %-  some
+        [%mime p.fec (as-octs:mimes:html (jam q.fec))]
+      ::
+          %sav
+        ::  XX use +en:base64 or produce %mime a la %sag
+        ::
+        %-  some
+        :-  %json
+        %-  pairs:enjs:format
+        :~  file+s+(crip <`path`p.fec>)
+            data+s+(crip (en-base64:mimes:html q.fec))
+        ==
+      ::
+          %mor
+        =/  all  `(list lens-out)`(murn p.fec |=(a=sole-effect loop(fec a)))
+        ?~  all  ~
+        ~|  [%multiple-effects all]
+        ?>  ?=(~ t.all)
+        (some i.all)
+      ==
+    ::
+    ?~  out
+      [~ this]
+    ::
+    ?>  ?=(^ job.state)
+    :_  this(job.state ~)
+    %+  give-simple-payload:app  eyre-id.u.job.state
+    ?-  -.u.out
+        %json
+      (json-response:gen (json-to-octs json.u.out))
+    ::
+        %mime
+      =/  headers
+        :~  ['content-type' 'application/octet-stream']
+            ?>  ?=([@ @ ~] p.mime.u.out)
+            :-  'content-disposition'
+            ^-  @t
+            %^  cat  3
+              'attachment; filename='
+            (rap 3 '"' i.p.mime.u.out '.' i.t.p.mime.u.out '"' ~)
+        ==
+      [[200 headers] (some q.mime.u.out)]
+    ==
+  --
+::
+++  on-arvo
+  |=  [=wire =sign-arvo]
+  ^-  (quip card:agent:mall _this)
+  ?.  ?=(%bound +<.sign-arvo)
+    (on-arvo:def wire sign-arvo)
+  [~ this]
+::
+++  on-fail   on-fail:def
+--

pkg/arvo/lib/hood/drum-mall.hoon

@@ -287,10 +287,9 @@
   =*  pith  +<+.$
   =.  .  se-subze:se-adze:se-adit
   :_  pith(bin (~(put by bin) ost dev))
-  %-  flop
   ^-  (list card:agent:mall)
-  ?~  biz  moz
+  ?~  biz  (flop moz)
-  :_  moz
+  :_  (flop moz)
   =/  =dill-blit:dill  ?~(t.biz i.biz [%mor (flop biz)])
   [%give %fact `/drum %dill-blit !>(dill-blit)]
 ::
@@ -534,7 +533,7 @@
 ++  se-peer                                           ::  send a peer
   |=  gyl/gill:gall
   %-  se-emit(fug (~(put by fug) gyl ~))
-  [%pass (en-gill gyl) %agent gyl %watch /sole]
+  [%pass (en-gill gyl) %agent gyl %watch /sole/drum]
 ::
 ++  se-pull                                           ::  cancel subscription
   |=  gyl/gill:gall
@@ -561,7 +560,7 @@
   ++  ta-act                                          ::  send action
     |=  act/sole-action
     ^+  +>
-    (ta-poke %sole-action !>(act))
+    (ta-poke %sole-action !>(['drum' act]))
   ::
   ++  ta-aro                                          ::  hear arrow
     |=  key/?($d $l $r $u)

pkg/arvo/mar/sole/effect.hoon

@@ -59,6 +59,7 @@
         $txt  (frond %txt (tape p.sef))
         $tan  (frond %tan (tape (wush 160 p.sef)))
         $det  (frond %det json:~(grow mar-sole-change +.sef))
+        $tab  (frond %tab a+(turn p.sef |=([=cord tan=^tank] (pairs match+s+cord info+(tape ~(ram re tan)) ~))))
     ::
         $pro
       %+  frond  %pro