From 6a13048cf17314dc321c52721952151663a04dfd Mon Sep 17 00:00:00 2001
From: Ted Blackman <ted@tlon.io>
Date: Tue, 31 May 2022 18:31:38 -0500
Subject: [PATCH] ames: WIP modernized tests pass, still haven't found
 signature bug

---
 pkg/arvo/sys/vane/ames.hoon       | 103 ++++++++++++++++++++-------
 pkg/arvo/tests/sys/vane/ames.hoon | 112 ++++++++++++++++++++----------
 pkg/urbit/vere/io/ames.c          |   6 +-
 3 files changed, 156 insertions(+), 65 deletions(-)

diff --git a/pkg/arvo/sys/vane/ames.hoon b/pkg/arvo/sys/vane/ames.hoon
index 1db4669014..0c3011eb6b 100644
--- a/pkg/arvo/sys/vane/ames.hoon
+++ b/pkg/arvo/sys/vane/ames.hoon
@@ -288,8 +288,10 @@
     %+  turn  (flop hav)
     |=  =have
     dat.have
-  :-  sig=(end 9 mes)
+  =+  sig=(end 9 mes)
+  :-  sig
   =+  dat=(rsh 9 mes)
+  ~&  [sig=`@q`(mug sig) dat=`@q`(mug dat)]
   ?~  dat  ~
   ~|  [%fine %response-not-cask]
   ;;((cask) (cue dat))
@@ -1119,7 +1121,7 @@
   ::  /ax/peers/[ship]/forward-lane  (list lane)
   ::  /ax/bones/[ship]               [snd=(set bone) rcv=(set bone)]
   ::  /ax/snd-bones/[ship]/[bone]    vase
-  ::  /ax/fine/message/[path/...]    song
+  ::  /ax/fine/hunk/[path/...]       (list @ux) scry response fragments
   ::
   ?.  ?=(%x ren)  ~
   =>  .(tyl `(pole knot)`tyl)
@@ -2650,7 +2652,9 @@
           ++  pe-keen
             |=  [=path =^duct]
             ?:  (~(has by order.scry) path)
+              ~&  %pe-keen-already
               ke-abet:(ke-sub:(ke-abed:keen-core path) duct)
+            ~&  %pe-keen-new
             =^  keen-id=@ud  seq.scry  [seq.scry +(seq.scry)]
             =.  order.scry  (~(put by order.scry) path keen-id)
             =.  keens.scry  (put:orm keens.scry keen-id *keen-state)
@@ -2701,6 +2705,7 @@
           ::
           ++  pe-hear
             |=  [=lane =packet]
+            ~&  %pe-hear
             ?>  =(sndr-tick.packet (mod life.peer 16))
             ::
             =/  [=peep =purr]  (decode-request-info `@ux`content.packet)
@@ -2799,10 +2804,13 @@
             ++  ke-on-ack
               =|  marked=(list want)
               |=  fra=@ud
+              ~&  %ke-on-ack
               ^-  [? _ke-core]
               =;  [[found=? cor=_ke-core] wan=(pha want)]
                 ?.  found
+                  ~&  %not-found
                   [found ke-core]
+                  ~&  %found
                 [found cor(wan.keen wan)]
               %^  (dip-left:ke-deq ,[found=? cor=_ke-core])  wan.keen
                 [| ke-core]
@@ -2875,12 +2883,14 @@
               =/  max  num-slots:ke-gauge
               |-  ^+  ke-core
               ?:  |(=(~ nex.keen) =(inx max))
+              ~&  [%ke-continue-done inx]
                 ke-core
               =^  =want  nex.keen  nex.keen
               =.  last-sent.want  now
               =.  tries.want  +(tries.want)
               =.  wan.keen  (snoc:ke-deq wan.keen want)
               =.  metrics.keen  (on-sent:ke-gauge 1)
+              ~&  [%ke-continue fra.want]
               =.  ke-core  (ke-emit hoot.want)
               $(inx +(inx))
             ::
@@ -2920,6 +2930,7 @@
             ++  ke-rcv
               |=  [fra=@ud =purr =lane:ames]
               ^+  ke-core
+              ~&  [%ke-rcv fra]
               =/  =meow          (decode-response-packet purr)
               =/  og  ke-core
               =.  pe-core  (pe-update-qos %live last-contact=now)
@@ -2934,19 +2945,23 @@
                 ?>  =(fra 1)
                 (ke-first-rcv meow)
               ::
-              ~|  failed-signature/fra^`@ux`sig.meow
-              ~|  life.peer
-              ?>  (veri-fra:keys ship life.peer ke-full-path fra [dat sig]:meow)
+              ?.  %-  veri-fra:keys
+                  [ship life.peer ke-full-path fra [dat sig]:meow]
+                ~|  failed-signature/fra^`@ux`sig.meow
+                ~|  life.peer
+                !!
               =^  found=?  ke-core
                 (ke-on-ack fra)
               ::
               ?.  found
+                ~&  %ke-fast-retransmit
                 (ke-fast-retransmit:og fra)
               =/  =have   [fra meow]
               =.  hav.keen
                 `(list ^have)`[have hav.keen]
               =.  num-received.keen  +(num-received.keen)
               ?:  =(num-fragments num-received):keen
+                ~&  %ke-done
                 (ke-done [sig dat]:ke-decode-full)
               ke-continue
             ::
@@ -3024,6 +3039,7 @@
                   last-sent.u.want  now
                 ==
               =.  wan.keen  (cons:ke-deq wan.keen u.want)
+              ~&  [%ke-take-wake-resend fra.u.want]
               (ke-resend [fra hoot]:u.want)
             --
           --
@@ -3076,10 +3092,12 @@
         ::
         ++  on-keen
           |=  [=ship =path]
+          ~&  %on-keen
           ^+  event-core
           =+  ~:(spit path)  ::  assert length
           =/  peer-core  (pe-abed:fine-peer ship)
           ?^  peer-core  pe-abet:(pe-keen:u.peer-core path duct)
+          ~&  %on-keen-alien
           %+  enqueue-alien-todo  ship
           |=  todos=alien-agenda
           todos(keens (~(put ju keens.todos) path duct))
@@ -3117,6 +3135,7 @@
           ::      so we should only get responses from ships we know.
           ::      below we assume sndr.packet is a known peer.
           =*  from  sndr.packet
+            ~&  %on-hear-response
           =/  peer-core  (need (pe-abed:fine-peer from))
           pe-abet:(pe-hear:peer-core lane packet)
         --
@@ -3173,19 +3192,34 @@
           wid^`@`pat  ::  namespace path
       ==
     ::
-    ++  frag-body
-      |=  [=path mes=@ num=@ud fin=?]
-      ^-  @uxmeow
+    ++  make-meow
+      |=  [=path mes=@ num=@ud]
+      ^-  meow
+      =;  meow
+        ~&  :*  %made-meow
+                sig=`@q`(mug sig.meow)
+                num=num.meow
+                siz=siz.meow
+                dat=`@q`(mug dat.meow)
+            ==
+        meow
       =/  tot  (met 13 mes)
-      =/  fra  (cut 13 [(dec num) 1] mes)
-      =/  wid  (met 3 fra)
-      =/  wod  ?:(fin wid 1.024)
-      =-  ~&  [tot=tot wid=wid num=num fra=!=(0 fra) fin=fin]  -
+      =/  dat  (cut 13 [(dec num) 1] mes)
+      =/  wid  (met 3 dat)
+      :*  sig=(sign-fra:keys path num dat)      ::  fragment signature
+          num=tot                               ::  number of fragments
+          siz=?:(=(num tot) (met 3 dat) 1.024)  ::  fragment byte width
+          dat=dat                               ::  response data fragment
+      ==
+    ::
+    ++  encode-meow
+      |=  =meow
+      ^-  @uxmeow
       %+  can  3
-      :~  64^(sign-fra:keys path num fra)
-          4^tot    ::  number of fragments
-          2^wod    ::  response data fragment size in bytes
-          wid^fra  ::  response data fragment
+      :~  64^sig.meow
+          4^num.meow
+          2^siz.meow
+          (met 3 dat.meow)^dat.meow
       ==
     ::
     ++  encode-request
@@ -3199,15 +3233,17 @@
         (can 3 sig bod ~)
       (encode-packet [our ship] req=& sam=| sic ric ~ syn)
     ::
-    ++  encode-hunk  ::TODO  unit tests
+    ++  encode-hunk
       |=  [=path =hunk data=$@(~ (cask))]
       ^-  (list @uxmeow)
+      ~&  [hunk=hunk len=(met 3 (jam data))]
       =/  mes=@
+        =-  ~&  [sig=`@q`(mug sig) dat=`@q`(mug (jam data))]  -
         =/  sig=@  (full:keys path data)
         ?~  data  sig
-        (cat 9 sig (jam data))
+        (mix sig (lsh 9 (jam data)))
+        ::(cat 9 sig (jam data))
       ::
-      ?>  (lte len.hunk 16.384)
       =/  las  (met 13 mes)
       =/  tip  (dec (add [lop len]:hunk))
       =/  top  (min las tip)
@@ -3218,25 +3254,38 @@
       |-  ^+  res
       ?:  =(num top)
         =-  (flop - res)
-        (frag-body path mes num =(top las))
-      $(num +(num), res :_(res (frag-body path mes num |)))
+        (encode-meow (make-meow path mes num))
+      $(num +(num), res :_(res (encode-meow (make-meow path mes num))))
     ::
     ++  keys
       |%
       ++  mess
-        |=([@p life path $@(~ (cask))] (jam +<))
+        |=  [=ship life=@ud =path dat=$@(~ (cask))]
+        ::~&  :*  %mess
+        ::        ship  life  path
+        ::        ^=  dat
+        ::        ?~  dat  ~
+        ::        ?:  =(%hoon -.dat)
+        ::          [%hoon ;;(@t +.dat)]
+        ::        [%noun `@q`(mug dat)]
+        ::    ==
+        (jam +<)
       ::
       ++  full
         |=  [=path data=$@(~ (cask))]
         (sign (mess our life.ames-state path data))
       ::
+      ++  frag
+        |=  [=path fra=@ud dat=@ux]
+        (jam +<)
+      ::
       ++  sign-fra
-        |=  [=path fra=@ dat=@ux]
-        (sign (jam path fra dat))
+        |=  [=path fra=@ud dat=@ux]
+        (sign (frag path fra dat))
       ::
       ++  veri-fra
-        |=  [who=ship lyf=life =path fra=@ dat=@ux sig=@]
-        (veri who lyf sig (jam path fra dat))
+        |=  [who=ship lyf=life =path fra=@ud dat=@ux sig=@]
+        (veri who lyf sig (frag path fra dat))
       ::
       ++  sign
         sigh:as:crypto-core.ames-state
@@ -3917,7 +3966,7 @@
   ++  clamp-rto
     |=  rto=@dr
     ^+  rto
-    (min ~m2 (max ^~((div ~s1 5)) rto))
+    (min ~s5 (max ^~((div ~s1 5)) rto))
   ::  +in-slow-start: %.y iff we're in "slow-start" mode
   ::
   ++  in-slow-start
diff --git a/pkg/arvo/tests/sys/vane/ames.hoon b/pkg/arvo/tests/sys/vane/ames.hoon
index ac82074693..146b765014 100644
--- a/pkg/arvo/tests/sys/vane/ames.hoon
+++ b/pkg/arvo/tests/sys/vane/ames.hoon
@@ -1,6 +1,7 @@
 /+  *test
 /=  ames  /sys/vane/ames
 /=  jael  /sys/vane/jael
+/*  dojo  %hoon  /app/dojo/hoon
 ::  construct some test fixtures
 ::
 =/  nec     ^$:((ames ~nec))
@@ -183,6 +184,16 @@
   %+  snag  index
   (skim moves is-move-send)
 ::
+++  n-frags
+  |=  n=@
+  ^-  @ux
+  ::  6 chosen randomly to get some trailing zeros
+  ::
+  %+  rsh  10
+  %+  rep  13
+  %+  turn  (gulf 1 n)
+  |=(x=@ (fil 3 1.024 (dis 0xff x)))
+::
 ++  scry
   |=  [vane=_nec car=term bem=beam]
   =/  =roof
@@ -198,7 +209,12 @@
       ``noun+!>([black black])
     ::
         %cz
-      ``noun+!>(`@ux`(fil 5 32 0xdead.beef))
+      ?+  -.r.bem  !!
+        %ud  ``noun+!>((n-frags p.r.bem))
+      ==
+    ::
+        %cx
+      ``hoon+!>(dojo)
     ==
   =/  vane-core  (vane(rof roof))
   (scry:vane-core ~ car bem)
@@ -226,34 +242,36 @@
   ::
   =/  =packet:ames
     :*  [sndr=~nec rcvr=~bud]
+        req=&  sam=&
         sndr-tick=0b10
         rcvr-tick=0b11
         origin=~
         content=0xdead.beef
     ==
   ::
-  =/  encoded  (encode-packet:ames & packet)
+  =/  encoded  (encode-packet:ames packet)
   =/  decoded  (decode-packet:ames encoded)
   ::
   %+  expect-eq
-    !>  [& packet]
+    !>  packet
     !>  decoded
 ::
 ++  test-origin-encoding  ^-  tang
   ::
   =/  =packet:ames
     :*  [sndr=~nec rcvr=~bud]
+        req=&  sam=&
         sndr-tick=0b10
         rcvr-tick=0b11
         origin=`0xbeef.cafe.beef
         content=0xdead.beef
     ==
   ::
-  =/  encoded  (encode-packet:ames & packet)
+  =/  encoded  (encode-packet:ames packet)
   =/  decoded  (decode-packet:ames encoded)
   ::
   %+  expect-eq
-    !>  [& packet]
+    !>  packet
     !>  decoded
 ::
 ++  test-shut-packet-encoding  ^-  tang
@@ -305,7 +323,7 @@
       rcvr-life=3
     ==
   ::
-  =/  =blob:ames   (encode-packet:ames & packet)
+  =/  =blob:ames   (encode-packet:ames packet)
   =^  moves1  bud  (call bud ~[//unix] %hear lane-foo blob)
   =^  moves2  bud
     =/  =point:ames
@@ -478,55 +496,79 @@
     ?.  ?=(%give -.card.move)    ~
     ?.  ?=(%send -.p.card.move)  ~
     `;;(@uxhoot blob.p.card.move)
-  =/  [is-ames=? =packet:ames]  (decode-packet:ames `@ux`req)
-  ?>  ?=(%| is-ames)
+  =/  =packet:ames  (decode-packet:ames `@ux`req)
+  ?<  sam.packet
+  ?>  req.packet
   =/  twit
    (decode-request:ames `@ux`content.packet)
   ~&  twit
   (expect-eq !>(1) !>(1))
 ::
+++  test-fine-hunk
+  ^-  tang
+  %-  zing
+  %+  turn  (gulf 1 10)
+  |=  siz=@
+  =/  want=path  /~bud/0/1/c/z/(scot %ud siz)/kids/sys
+  ::
+  =/  =beam  [[~bud %$ da+now:bud] (welp /fine/hunk/1/16.384 want)]
+  =/  [=mark =vase]  (need (need (scry bud %x beam)))
+  =+  !<(song=(list @uxmeow) vase)
+  %+  expect-eq
+    !>(siz)
+    !>((lent song))
+::
 ++  test-fine-response
   ^-  tang
-  =/  datum=@ux  (fil 5 32 0xdead.beef)
-  =/  want=path  /~bud/0/1/c/z/1/kids/sys
-  =.  rof.bud
-    |=(* ``noun+!>(datum))
-  =/  =beam  [[~bud %$ da+now:bud] (welp /fine/message want)]
+  ::%-  zing
+  ::%+  turn  (gulf 1 50)
+  ::|=  siz=@
+  ::=/  want=path  /~bud/0/1/c/z/(scot %ud siz)/kids/sys
+  =/  want=path  /~bud/0/1/c/x/1/kids/app/dojo/hoon
+  =/  dit  (jam %hoon dojo)
+  =/  exp  (cat 9 (fil 3 64 0xff) dit)
+  =/  siz=@ud  (met 13 exp)
+  ^-  tang
+  ::
+  =/  =beam  [[~bud %$ da+now:bud] (welp /fine/hunk/1/16.384 want)]
   =/  [=mark =vase]  (need (need (scry bud %x beam)))
-  =+  !<(=song:ames vase)
-  =/   partial=(list have:ames)
-    %-  head
-    %^  spin  song  1
-    |=  [blob=@ux num=@ud]
+  =+  !<(song=(list @uxmeow) vase)
+  =/   paz=(list have:ames)
+    %+  spun  song
+    |=  [blob=@ux num=_1]
     ^-  [have:ames _num]
     :_  +(num)
-    =/  [is-ames=? =packet:ames]  (decode-packet:ames `@ux`blob)
-    ?>  ?=(%| is-ames)
-    =/  [=peep:ames =purr:ames]  (decode-request-info:ames `@ux`content.packet)
-    =/  rawr  (decode-response-packet:ames `@ux`purr)
-    ~&  rawr-sig/`@ux`sig.rawr
-    ~&  rawr-siz/`@ux`siz.rawr
-    ~&  rawr-wid/`@ux`wid.rawr
-    ~&  rawr-dat/`@ux`dat.rawr
-    [num rawr]
+    =/  =meow:ames  (decode-response-packet:ames blob)
+    [num meow]
   ::
-  =/  num-frag=@ud  (lent partial)
+  =/  num-frag=@ud  (lent paz)
+  ~&  num-frag=num-frag
   =/   =roar:ames
-    (decode-response-msg:ames num-frag (flop partial))
+    (decode-response-msg:ames num-frag (flop paz))
   %+  welp
     =/  dat
       ?>  ?=(^ dat.roar)
       ;;(@ux q.dat.roar)
-    (expect-eq !>(dat) !>(datum))
+    (expect-eq !>(`@`dat) !>(`@`dojo))
   =/  event-core
     ~!  nec
     =/   foo  [*@da *@ rof.nec]
     (per-event:(nec foo) [*@da *@ rof.nec] *duct ames-state.nec)
-  %-  zing
-  %+  turn  partial
-  |=  [fra=@ud sig=@ siz=@ud byts]
-  %+  expect-eq  !>(%.y)
-  !>((veri-fra:keys:fine:event-core ~bud life.ames-state.bud want fra dat sig))
+  %+  welp
+    ^-  tang
+    %-  zing
+    %+  turn  paz
+    |=  [fra=@ud sig=@ siz=@ud byts]
+    %+  expect-eq  !>(%.y)
+    !>
+    %-  veri-fra:keys:fine:event-core
+    [~bud life.ames-state.bud want fra dat sig]
+  ~&  %verifying-sig
+  %+  expect-eq
+    !>(&)
+    !>
+    %-  meri:keys:fine:event-core
+    [~bud life.ames-state.bud want roar]
 ::
 ++  test-old-ames-wire  ^-  tang
   =^  moves0  bud  (call bud ~[/g/hood] %spew [%odd]~)
diff --git a/pkg/urbit/vere/io/ames.c b/pkg/urbit/vere/io/ames.c
index cfbbe6e481..eb1e1d67de 100644
--- a/pkg/urbit/vere/io/ames.c
+++ b/pkg/urbit/vere/io/ames.c
@@ -5,7 +5,7 @@
 #include "vere/vere.h"
 #include "ur/serial.h"
 
-#define FINE_PAGE     16384  //  packets per page
+#define FINE_PAGE         8  //  packets per page TODO: 16384
 #define FINE_FRAG      1024  //  bytes per fragment packet
 #define FINE_PATH_MAX   384  //  longest allowed scry path
 #define HEAD_SIZE         4  //  header size in bytes
@@ -1682,7 +1682,6 @@ _ames_hear_ames(u3_pact* pac_u, c3_w cur_w)
     }
 
     _ames_pact_free(pac_u);
-    return;
   }
 
   //  otherwise, inject the packet as an event
@@ -1788,8 +1787,9 @@ _ames_hear(u3_ames* sam_u,
 
 
   //  check contents match mug in header
-  //
+ //
   if ( c3n == _ames_check_mug(pac_u) ) {
+        _log_head(&pac_u->hed_u);
       sam_u->sat_u.mut_d++;
       //  TODO: reinstate filter after debugging is over
       //  if ( 0 == (sam_u->sat_u.mut_d % 100000) ) {