Merge next into master

.travis/pin-parent-pill-pier.url

@@ -1 +1 @@
-https://ci-piers.urbit.org/zod-0838dd9396cc6742e8bdd8dfee2e1bf5a782a50d.tgz
+https://ci-piers.urbit.org/zod-f9000e4ae042dd36f103da8c8f4e997a892b8697.tgz

.travis/test.js

@@ -82,6 +82,26 @@ function barMass(urb) {
   })
 }
 
+function aqua(urb) {
+  return urb.line("|start %ph")
+  .then(function(){
+    return urb.line(":ph %init");
+  })
+  .then(function(){
+    return urb.line(":aqua &pill +solid");
+  })
+  .then(function(){
+    urb.every(/TEST [^ ]* FAILED/, function(arg){
+      throw Error(arg);
+    });
+    return urb.line(":ph [%run-test %hi]");
+  })
+  .then(function(){
+    return urb.expectEcho("ALL TESTS SUCCEEDED")
+    .then(function(){ return urb.resetListeners(); })
+  })
+}
+
 Promise.resolve(urbit)
 .then(actions.safeBoot)
 .then(function(){
@@ -93,6 +113,9 @@ Promise.resolve(urbit)
 .then(function(){
   return barMass(urbit);
 })
+.then(function(){
+  return aqua(urbit);
+})
 .then(function(){
   return rePill(urbit);
 })

app/aqua-ames.hoon

@@ -0,0 +1,83 @@
+::  This needs a better SDN solution.  Every ship should have an IP
+::  address, and we should eventually test changing those IP
+::  addresses.
+::
+::  For now, we broadcast every packet to every ship and rely on them
+::  to drop them.
+::
+/-  aquarium
+=,  aquarium
+=>  |%
+    +$  move  (pair bone card)
+    +$  card
+      $%  [%poke wire dock %aqua-events (list aqua-event)]
+          [%peer wire dock path]
+          [%pull wire dock ~]
+      ==
+    ::
+    +$  state
+      $:  %0
+          subscribed=_|
+      ==
+    --
+=,  gall
+=|  moves=(list move)
+=|  aqua-event-list=(list aqua-event)
+=|  ships=(list ship)
+|_  $:  bowl
+        state
+    ==
+++  this  .
+++  apex  %_(this moves ~, aqua-event-list ~, ships ~)
+++  abet
+  =?  this  !=(~ aqua-event-list)
+    %-  emit-moves
+    [ost %poke /aqua-events [our %aqua] %aqua-events aqua-event-list]~
+  ::  ~?  !?=(~ moves)  [%aqua-ames-moves (lent moves)]
+  [moves this]
+::
+++  emit-moves
+  |=  ms=(list move)
+  %_(this moves (weld moves ms))
+::
+++  emit-aqua-events
+  |=  aes=(list aqua-event)
+  %_(this aqua-event-list (weld aqua-event-list aes))
+::
+++  poke-aqua-vane-control
+  |=  command=?(%subscribe %unsubscribe)
+  :_  this(subscribed =(command %subscribe))
+  (aqua-vane-control-handler our ost subscribed command)
+::
+::  Handle effects from ships.  We only react to %send effects.
+::
+++  diff-aqua-effects
+  |=  [way=wire afs=aqua-effects]
+  ^-  (quip move _this)
+  =.  this  apex  =<  abet
+  |-  ^+  this
+  ?~  ufs.afs
+    this
+  =.  this
+    ?+  -.q.i.ufs.afs  this
+      %restore  (handle-restore who.afs)
+      %send     (handle-send i.ufs.afs)
+    ==
+  $(ufs.afs t.ufs.afs)
+::
+++  handle-restore
+  |=  who=@p
+  %-  emit-aqua-events
+  [%event who [//newt/0v1n.2m9vh %barn ~]]~
+::
+++  handle-send
+  |=  [way=wire %send lan=lane:ames pac=@]
+  ^+  this
+  =/  hear  [//newt/0v1n.2m9vh %hear lan pac]
+  =?  ships  =(~ ships)
+    .^((list ship) %gx /(scot %p our)/aqua/(scot %da now)/ships/noun)
+  %-  emit-aqua-events
+  %+  turn  ships
+  |=  who=ship
+  [%event who hear]
+--

app/aqua-behn.hoon

@@ -0,0 +1,131 @@
+/-  aquarium
+=,  aquarium
+=>  |%
+    +$  move  (pair bone card)
+    +$  card
+      $%  [%poke wire dock %aqua-events (list aqua-event)]
+          [%peer wire dock path]
+          [%pull wire dock ~]
+          [%wait wire p=@da]
+          [%rest wire p=@da]
+      ==
+    ::
+    +$  state
+      $:  %0
+          subscribed=_|
+          piers=(map ship pier)
+      ==
+    ::
+    +$  pier  next-timer=(unit @da)
+    --
+=,  gall
+=|  moves=(list move)
+|_  $:  bowl
+        state
+    ==
+++  this  .
+++  apex  %_(this moves ~)
+++  abet  [(flop moves) this]
+++  emit-moves
+  |=  ms=(list move)
+  %_(this moves (weld ms moves))
+::
+++  emit-aqua-events
+  |=  aes=(list aqua-event)
+  %-  emit-moves
+  [ost %poke /aqua-events [our %aqua] %aqua-events aes]~
+::
+++  poke-aqua-vane-control
+  |=  command=?(%subscribe %unsubscribe)
+  :_  this(subscribed =(command %subscribe))
+  (aqua-vane-control-handler our ost subscribed command)
+::
+++  diff-aqua-effects
+  |=  [way=wire afs=aqua-effects]
+  ^-  (quip move _this)
+  =.  this  apex  =<  abet
+  |-  ^+  this
+  ?~  ufs.afs
+    this
+  =.  this
+    ?+  -.q.i.ufs.afs  this
+      %sleep    abet-pe:handle-sleep:(pe who.afs)
+      %restore  abet-pe:handle-restore:(pe who.afs)
+      %doze     abet-pe:(handle-doze:(pe who.afs) i.ufs.afs)
+    ==
+  $(ufs.afs t.ufs.afs)
+::
+::  Received timer wake
+::
+++  wake
+  |=  [way=wire error=(unit tang)]
+  ^-  (quip move _this)
+  =.  this  apex  =<  abet
+  ?>  ?=([@ *] way)
+  =/  who  (,@p (slav %p i.way))
+  abet-pe:(take-wake:(pe who) t.way error)
+::
+++  pe
+  |=  who=ship
+  =+  (fall (~(get by piers) who) *pier)
+  =*  pier-data  -
+  |%
+  ++  abet-pe
+    ^+  this
+    =.  piers  (~(put by piers) who pier-data)
+    this
+  ::
+  ++  handle-sleep
+    ^+  ..abet-pe
+    =<  ..abet-pe(pier-data *pier)
+    ?~  next-timer
+      ..abet-pe
+    cancel-timer
+  ::
+  ++  handle-restore
+    ^+  ..abet-pe
+    =.  this
+      %-  emit-aqua-events
+      [%event who [//behn/0v1n.2m9vh %born ~]]~
+    ..abet-pe
+  ::
+  ++  handle-doze
+    |=  [way=wire %doze tim=(unit @da)]
+    ^+  ..abet-pe
+    ?~  tim
+      ?~  next-timer
+        ..abet-pe
+      cancel-timer
+    ?~  next-timer
+      (set-timer u.tim)
+    (set-timer:cancel-timer u.tim)
+  ::
+  ++  set-timer
+    |=  tim=@da
+    ~?  debug=|  [who=who %setting-timer tim]
+    =.  next-timer  `tim
+    =.  this  (emit-moves [ost %wait /(scot %p who) tim]~)
+    ..abet-pe
+  ::
+  ++  cancel-timer
+    ~?  debug=|  [who=who %cancell-timer (need next-timer)]
+    =.  this  (emit-moves [ost %rest /(scot %p who) (need next-timer)]~)
+    =.  next-timer  ~
+    ..abet-pe
+  ::
+  ++  take-wake
+    |=  [way=wire error=(unit tang)]
+    ~?  debug=|  [who=who %aqua-behn-wake now error=error]
+    =.  next-timer  ~
+    =.  this
+      %-  emit-aqua-events
+      :_  ~
+      ^-  aqua-event
+      :+  %event  who
+      :-  //behn/0v1n.2m9vh
+      ?~  error
+        [%wake ~]
+      [%crud %fail u.error]
+    ..abet-pe
+  --
+--

app/aqua-dill.hoon

@@ -0,0 +1,78 @@
+::  Would love to see a proper stateful terminal handler.  Ideally,
+::  you'd be able to ^X into the virtual ship, like the old ^W.
+::
+::  However, that's probably not the primary way of interacting with
+::  it.  In practice, most of the time you'll be running from a file
+::  (eg for automated testing) or fanning the same command to multiple
+::  ships or otherwise making use of the fact that we can
+::  programmatically send events.
+::
+/-  aquarium
+=,  aquarium
+=>  |%
+    +$  move  (pair bone card)
+    +$  card
+      $%  [%poke wire dock %aqua-events (list aqua-event)]
+          [%peer wire dock path]
+          [%pull wire dock ~]
+      ==
+    ::
+    +$  state
+      $:  %0
+          subscribed=_|
+      ==
+    --
+=,  gall
+=|  moves=(list move)
+|_  $:  bowl
+        state
+    ==
+++  this  .
+++  apex  %_(this moves ~)
+++  abet  [(flop moves) this]
+++  emit-moves
+  |=  ms=(list move)
+  %_(this moves (weld ms moves))
+::
+++  emit-aqua-events
+  |=  aes=(list aqua-event)
+  %-  emit-moves
+  [ost %poke /aqua-events [our %aqua] %aqua-events aes]~
+::
+++  poke-aqua-vane-control
+  |=  command=?(%subscribe %unsubscribe)
+  :_  this(subscribed =(command %subscribe))
+  (aqua-vane-control-handler our ost subscribed command)
+::
+++  diff-aqua-effects
+  |=  [way=wire afs=aqua-effects]
+  ^-  (quip move _this)
+  =.  this  apex  =<  abet
+  |-  ^+  this
+  ?~  ufs.afs
+    this
+  =.  this
+    ?+  -.q.i.ufs.afs  this
+      %blit     (handle-blit who.afs i.ufs.afs)
+    ==
+  $(ufs.afs t.ufs.afs)
+::
+++  handle-blit
+  |=  [who=@p way=wire %blit blits=(list blit:dill)]
+  ^+  this
+  =/  last-line
+    %+  roll  blits
+    |=  [b=blit:dill line=tape]
+    ?-    -.b
+        %lin  (tape p.b)
+        %mor  ~&  "{<who>}: {line}"  ""
+        %hop  line
+        %bel  line
+        %clr  ""
+        %sag  ~&  [%save-jamfile-to p.b]  line
+        %sav  ~&  [%save-file-to p.b]  line
+        %url  ~&  [%activate-url p.b]  line
+    ==
+  ~&  last-line
+  this
+--