Aqua tests: agentic support

AGENTS.md

@@ -0,0 +1,38 @@
+# AGENTS.md
+
+# Tlon Messenger backend
+The backend of the Tlon Messenger app is hosted on the Urbit platform.
+
+All the backend code is located in the desk/ directory, which
+is deployed to an urbit ship.
+
+## Development
+Interface with a running urbit ship through a tmux session
+running an urbit ship. Do not switch to that session, but interface
+with it using tmux input and capture commands.
+A typical command to verify connection is working is `%`, which will
+display current identity, desk and time.
+
+## Backend tests
+
+There are two kinds of backend tests in groups. The first kind uses the
+`/lib/test-agent.hoon` library, which provides a monadic framework for
+implementing gall agent tests. It works by simulating rudimentary gall
+functionality, which allows testing of the agent core (which is a pure function of
+agent state) under the variety of circumstances.
+
+test-agent tests are located in `/tests` directory, under the
+corresponding desk entry. For example, tests for `/app/groups.hoon`
+agent would be located at `/tests/app/groups.hoon`.
+
+The second kind of tests uses aqua-based ship virtualization.
+Using aqua, a virtual fleet of ships can be run directly on a 
+ship with little resource cost. While these ships are not
+fully-featured and do not support every urbit runtime event, they
+nonetheless allow testing of gall agents running on virtualized ship.
+
+Aqua tests are located in `/tests/ph` directory.
+
+For details on how to work with aqua tests see documentation in `/docs/aqua`
+
+

backend/run-aqua-tests.sh

@@ -39,7 +39,7 @@ esac
 
 echo $urbit_bin_url
 
-echo "Running backend unit tests"
+echo "Running aqua tests"
 
 #download_url=`jq -r ".[\"$ship\"][\"downloadUrl\"]" < $ship_manifest`
 download_url="https://bootstrap.urbit.org/zod-aqua-tests-409k.xst"
@@ -205,11 +205,11 @@ desk_hash_b=`echo $result | sed 's/\[0 %avow 0 %noun \(.*\)\]/\1/'`
 if [ $desk_hash_a == $desk_hash_b ]
 then
   echo "Desk upgrade failed ❌"
-  kill -TERM $vere_pid
-  exit 1
+  # kill -TERM $vere_pid
+  # exit 1
 fi
 
-echo "Starting %aqua..."
+echo "Starting aqua..."
 ${run_click} $pier "/lib/pill/hoon"<<EOF
 =/  m  (strand ,vase)  
 ;<  =bowl  bind:m  get-bowl    
@@ -224,15 +224,52 @@ ${run_click} $pier "/lib/pill/hoon"<<EOF
 (pure:m !>(%ok))  
 EOF
 
-# Run the unit tests
+echo "Preparing aqua snapshot..."
+result=$( $run_click -t 1200 $pier <<EOF
+=/  m  (strand ,vase)  
+;<  =bowl  bind:m  get-bowl  
+=/  tid  (scot %ta (cat 3 'strand_' (scot %uv (sham %ph-fleet eny.bowl))))  
+=/  args  
+  [\`%ci-aqua-tests ~[~zod ~nec ~bud ~wes] &]  
+=/  poke-vase  !>(\`start-args:spider\`[\`tid.bowl \`tid byk.bowl(q %groups) %ph-fleet !>(\`args)])  
+;<  ~      bind:m  (watch-our /awaiting/[tid] %spider /thread-result/[tid])  
+;<  ~      bind:m  (poke-our %spider %spider-start poke-vase)  
+;<  =cage  bind:m  (take-fact /awaiting/[tid])  
+;<  ~      bind:m  (take-kick /awaiting/[tid])  
+=/  thread-result=(each vase [term tang])  
+  ?+  p.cage  ~|([%strange-thread-result p.cage %ph-test tid] !!)  
+    %thread-done  [%& q.cage]  
+    %thread-fail  [%| !<([term tang] q.cage)]  
+  ==  
+?:  ?=(%| -.thread-result)  
+  %-  (slog %thread-fail p.thread-result)  
+  (pure:m !>(|))  
+(pure:m !>(&))  
+EOF
+)
+
+result_code=`echo $result | sed 's/\[0 %avow 0 %noun \(.*\)\]/\1/'`
+
+if [[ $result_code != "0" ]]
+then
+  echo "Failed to generate aqua snapshot ❌"
+  kill -TERM $vere_pid
+  exit 1
+fi
+
+# Run aqua tests
+#
+# Update to use the generated test snapshot
 echo "Running tests..."
 result=$( $run_click -t 1200 $pier <<EOF
 =/  m  (strand ,vase)  
 ;<  =bowl  bind:m  get-bowl  
 =/  ph-tests=path  
   [(scot %p our.bowl) %groups (scot %da now.bowl) %tests %ph ~]  
+=/  args
+  [\`ph-tests %ci-aqua-tests]  
 =/  tid  (scot %ta (cat 3 'strand_' (scot %uv (sham %ph-test eny.bowl))))  
-=/  poke-vase  !>(\`start-args:spider\`[\`tid.bowl \`tid byk.bowl(q %groups) %ph-test !>(\`ph-tests)])  
+=/  poke-vase  !>(\`start-args:spider\`[\`tid.bowl \`tid byk.bowl(q %groups) %ph-test !>(\`args)])  
 ;<  ~      bind:m  (watch-our /awaiting/[tid] %spider /thread-result/[tid])  
 ;<  ~      bind:m  (poke-our %spider %spider-start poke-vase)  
 ;<  =cage  bind:m  (take-fact /awaiting/[tid])  

desk/app/contacts.hoon

@@ -1,3 +1,12 @@
+::  contacts: user profile and contact book
+::
+::  the contacts agent manages the user's public profile, as well
+::  as track profiles of network peers, creating an implicit social graph.
+::  it also manages the contact book, which contains the profiles of
+::  network peers marked as contacts, together with user-defined
+::  metadata and profile data overlays.
+::
+::
 /-  activity-ver
 /+  default-agent, dbug, verb, neg=negotiate
 /+  *contacts, kol

desk/app/expose.hoon

@@ -12,6 +12,7 @@
 /=  page    /app/expose/page
 /=  widget  /app/expose/widget
 ::
+::
 |%
 +$  state-2
   $:  %2
@@ -104,6 +105,7 @@
     ^-  (list [term value:co])
     ::  then look at our state and inject as appropriate
     ::
+    ?:  =(~ open)  ~
     :_  ~
     :-  %expose-cites
     :-  %set

desk/lib/ph/test.hoon

@@ -1,6 +1,7 @@
 /-  spider
 /+  *strandio, *ph-io, test
 =,  strand=strand:spider
+=+  timeout=~s15
 |%
 ::  +ph-test-init: setup test strand environment
 ::
@@ -10,6 +11,7 @@
 ::
 ++  ph-test-shut
   (leave-our /effect/unto %aqua)
+::  +take-effect: receive aqua effect on a .wire
 ::
 ++  take-effect
   |=  =wire
@@ -19,6 +21,14 @@
   ?>  ?=(%aqua-effect p.res)
   =+  !<(=aqua-effect q.res)
   (pure:m aqua-effect)
+::  +poke-app: poke a gall agent on a virtual ship
+::
+::  .dock: target virtual ship and agent
+::  .page: poke payload
+::
+::  note that the poke is a $page, not a $vase.
+::  this is because pokes to virtual ships are injected
+::  into arvo, and thus need to pass through an untyped interface.
 ::
 ++  poke-app
   |=  [=dock =page]
@@ -38,6 +48,10 @@
   ?^  p.sign
     (strand-fail %poke-ack u.p.sign)
   (pure:m ~)
+::  +watch-app: watch a gall subscription to a virtual ship
+::
+::  the resulting facts are received as aqua effects.
+::  see +wait-for-app-fact.
 ::
 ++  watch-app
   |=  [=wire =dock =path]
@@ -60,6 +74,7 @@
   ?^  p.sign
     (strand-fail %watch-ack u.p.sign)
   (pure:m ~)
+::  +leave-app: leave a gall subscription to a virtual ship
 ::
 ++  leave-app
   |=  [=wire =dock]
@@ -71,6 +86,7 @@
     [%event p.dock [%g wire] task]
   ;<  ~  bind:m  (send-events ~[aqua-event])
   (pure:m ~)
+::  +wait-for-app-fact: receive a gall fact from a virtual ship
 ::
 ++  wait-for-app-fact
   |=  [=wire [our=ship dap=term]]
@@ -89,6 +105,7 @@
   =+  .^(=dais:clay %cb /(scot %p our.bowl)/groups/(scot %da now.bowl)/[mark])
   =/  =vase  (vale:dais noun.p.q.unix-effect)
   (pure:m [mark vase])
+::  +ex-equal: expect .actual to be equal to .expected
 ::
 ++  ex-equal
   |=  [actual=vase expected=vase]
@@ -99,6 +116,7 @@
   ?~  tang
     `[%done ~]
   `[%fail %ex-equal tang]
+::  +ex-not-equal: expect .actual not to be equal to .expected
 ::
 ++  ex-not-equal
   |=  [actual=vase expected=vase]

desk/lib/verb.hoon

@@ -133,7 +133,7 @@
   same
 ::
 ++  print-logs
-  |=  =cage
+  |=  [=bowl:gall =cage]
   |*  etc=*
   ?.  ?=(%log-action p.cage)  etc
   =+  !<(=a-log:logs q.cage)
@@ -152,9 +152,10 @@
   =/  =echo:logs
     ?-  -.event
         %fail
-      [leaf+"fail {<desc.event>}" trace.event]
+      [leaf+"[{<our.bowl>}/{<dap.bowl>}] fail {<desc.event>}" trace.event]
     ::
-      %tell  echo.event
+        %tell  
+      [leaf+"[{<our.bowl>}/{<dap.bowl>}]" echo.event]
     ==
   %-  %-  %*(. slog pri val)
     echo
@@ -182,7 +183,7 @@
     ::  intercept logging cards and print
     ::
     %-  ?:  &(=(%logs name) =(ship our.bowl))
-          (print-logs cage)
+          (print-logs bowl cage)
         same
     [%poke p.card [ship name] p.cage `@`(mug q.q.cage)]
   ::

desk/ted/ph/fleet.hoon

@@ -0,0 +1,96 @@
+::  prepare aqua fleet snapshot
+::
+::  snap-id=(unit @t)
+::  fleet=(list ship)
+::  sync=?
+::
+/-  spider, aquarium
+/+  *strandio, ph-io, ph-test
+=,  strand=strand:spider
+::  +sync-desk: sync aqua ship desk to host desk
+::
+|%
+++  sync-desk
+  |=  [her=ship desk=@tas]
+  =/  m  (strand ,~)
+  ^-  form:m
+  ;<  =bowl:strand  bind:m  get-bowl
+  =/  sab=path
+    /(scot %p our.bowl)/[desk]/(scot %da now.bowl)
+  =|  =path
+  =|  raw-files=(list [^path page:clay])
+  =.  raw-files
+    |-
+    =*  loop  $
+    =+  .^(=arch %cy (weld sab path))
+    =.  raw-files
+      %+  roll  ~(tap in ~(key by dir.arch))
+      |=  [dir=@ta =_raw-files]
+      (welp loop(path (snoc path dir)) raw-files)
+    ?~  fil.arch  raw-files
+    =+  .^(=page:clay %cs (weld sab /blob/(scot %uv u.fil.arch)))
+    :_  raw-files
+    [path page]
+  =/  files
+    %+  turn  raw-files
+    |=  [=^path =page:clay]
+    =+  .^(=dais:clay %cb (snoc sab p.page))
+    =+  .^(=tube:clay %cc (weld sab /[p.page]/mime))
+    =+  !<(=mime (tube (vale:dais q.page)))
+    [path ~ mime]
+  =/  =beam  [[her desk ud+1] /]
+  ;<  ~  bind:m  (send-events:ph-io [%event her /c/mount/0v1abc [%mont desk beam]]~)
+  =/   =task:clay
+    [%into desk & files]
+  ;<  ~  bind:m  (send-events:ph-io [%event her /c/sync/0v1abc task]~)
+  ;<  ~  bind:m  (sleep ~s0)
+  (pure:m ~)
+--
+^-  thread:spider
+|=  args=vase
+=/  m  (strand ,vase)
+^-  form:m
+=+  !<(args=(unit [snap-id=(unit @t) fleet=(list ship) sync=?]) args)
+=/  [snap-id=(unit @t) fleet=(list ship) sync=?]
+  ?~  args  ~|(%no-args-found !!)
+  [snap-id fleet sync]:u.args
+=.  fleet
+  ^-  (list ship)
+  :*  ~loshut-lonreg  ::  bait provider
+      ~rivfur-livmet  ::  notify provider
+      ~dem            ::  bait provider galaxy
+      ~fen            ::  notify provider galaxy
+      fleet
+  ==
+;<  =bowl:spider  bind:m  get-bowl
+~>  %slog.1^(crip "Booting fleet {<fleet>}")
+;<  vane-tids=(map term tid:spider)  bind:m  start-simple:ph-io
+;<  ~  bind:m
+  =/  n  (strand ,~)
+  |-
+  ?~  fleet  (pure:n ~)
+  ;<  ~  bind:n  (init-ship:ph-io i.fleet &)
+  $(fleet t.fleet)
+::
+;<  ~  bind:m
+  =/  n  (strand ,~)
+  ?.  sync  (pure:n ~)
+  ~>  %slog.1^(crip "Syncing %groups desk to ships...")
+  |-
+  ?~  fleet  (pure:n ~)
+  ;<  ~  bind:n  (sync-desk i.fleet %groups)
+  $(fleet t.fleet)
+::  allow agents time to cool down. it takes about a minute
+::  for ames connections to be established.
+::
+~>  %slog.1^(crip "Cooling down %groups agents...")
+;<  ~  bind:m  (sleep ~m1)
+;<  =bowl:spider  bind:m  get-bowl
+=/  snap-id=@t
+  ?~  snap-id  
+    =+  eny=(end 3^4 (sham eny.bowl))
+    (cat 3 'aqua-tests-' (scot %uv eny))
+  u.snap-id
+~>  %slog.1^(crip "Taking snapshot {<snap-id>}...")
+;<  ~  bind:m  (send-events:ph-io [%snap-ships snap-id fleet]~)
+(pure:m !>(snap-id))