Merge pull request #6323 from urbit/i/6282/adjust-clog

ames: add %cong task to adjust clog

pkg/arvo/sys/lull.hoon

@@ -363,6 +363,8 @@
   ::    %sift: limit verbosity to .ships
   ::    %snub: set packet blacklist to .ships
   ::    %spew: set verbosity toggles
+  ::    %cong: adjust congestion control parameters
+  ::    %stir: recover from timer desync
   ::    %trim: release memory
   ::    %vega: kernel reload notification
   ::
@@ -380,6 +382,7 @@
         [%sift ships=(list ship)]
         [%snub ships=(list ship)]
         [%spew veb=(list verb)]
+        [%cong msg=@ud mem=@ud]
         [%stir arg=@t]
         $>(%trim vane-task)
         $>(%vega vane-task)

pkg/arvo/sys/vane/ames.hoon

@@ -609,6 +609,7 @@
 ::    crypto-core: interface for encryption and signing
 ::    bug:         debug printing configuration
 ::    snub:        blocklist for incoming packets
+::    cong:        parameters for marking a flow as clogged
 ::
 ::    Note: .corks is only still present for unreleased migration reasons
 ::
@@ -621,6 +622,7 @@
       =bug
       corks=(set wire)
       snub=(set ship)
+      cong=[msg=@ud mem=@ud]
   ==
 +$  ames-state-4  ames-state-5
 +$  ames-state-5
@@ -703,6 +705,11 @@
       ships=(set ship)
   ==
 ::
++$  bug-10
+  $:  veb=_[`?`%.n `?`%.n `?`%.n `?`%.n `?`%.n `?`%.n `?`%.n `?`%.n]
+      ships=(set ship)
+  ==
+::
 +$  ames-state-9
   $:  peers=(map ship ship-state)
       =unix=duct
@@ -713,6 +720,16 @@
       snub=(set ship)
   ==
 ::
++$  ames-state-10
+  $:  peers=(map ship ship-state)
+      =unix=duct
+      =life
+      crypto-core=acru:ames
+      bug=bug-10
+      corks=(set wire)
+      snub=(set ship)
+  ==
+::
 ::  $bug: debug printing configuration
 ::
 ::    veb: verbosity toggles
@@ -876,7 +893,8 @@
             [%7 ames-state-7]
             [%8 ames-state-8]
             [%9 ames-state-9]
-            [%10 ^ames-state]
+            [%10 ames-state-10]
+            [%11 ^ames-state]
         ==
     ::
     |=  [now=@da eny=@ rof=roof]
@@ -999,7 +1017,7 @@
     ::  lifecycle arms; mostly pass-throughs to the contained adult ames
     ::
     ++  scry  scry:adult-core
-    ++  stay  [%10 %larva queued-events ames-state.adult-gate]
+    ++  stay  [%11 %larva queued-events ames-state.adult-gate]
     ++  load
       |=  $=  old
           $%  $:  %4
@@ -1045,6 +1063,13 @@
                   [%adult state=ames-state-9]
               ==  ==
               $:  %10
+              $%  $:  %larva
+                      events=(qeu queued-event)
+                      state=ames-state-10
+                  ==
+                  [%adult state=ames-state-10]
+              ==  ==
+              $:  %11
               $%  $:  %larva
                       events=(qeu queued-event)
                       state=_ames-state.adult-gate
@@ -1109,12 +1134,22 @@
         =.  queued-events  events.old
         larval-gate
       ::
-          [%10 %adult *]  (load:adult-core %10 state.old)
+          [%10 %adult *]
+        =.  cached-state  `[%10 state.old]
+        ~>  %slog.0^leaf/"ames: larva reload"
+        larval-gate
       ::
           [%10 %larva *]
         ~>  %slog.1^leaf/"ames: larva: load"
         =.  queued-events  events.old
-        =.  adult-gate     (load:adult-core %10 state.old)
+        larval-gate
+      ::
+          [%11 %adult *]  (load:adult-core %11 state.old)
+      ::
+          [%11 %larva *]
+        ~>  %slog.1^leaf/"ames: larva: load"
+        =.  queued-events  events.old
+        =.  adult-gate     (load:adult-core %11 state.old)
         larval-gate
        ::
       ==
@@ -1137,7 +1172,9 @@
         9+(state-8-to-9:load:adult-core +.u.cached-state)
       =?  u.cached-state  ?=(%9 -.u.cached-state)
         10+(state-9-to-10:load:adult-core +.u.cached-state)
-      ?>  ?=(%10 -.u.cached-state)
+      =?  u.cached-state  ?=(%10 -.u.cached-state)
+        11+(state-10-to-11:load:adult-core +.u.cached-state)
+      ?>  ?=(%11 -.u.cached-state)
       =.  ames-state.adult-gate  +.u.cached-state
       [moz larval-core(cached-state ~)]
     --
@@ -1178,6 +1215,7 @@
       %sift  (on-sift:event-core ships.task)
       %snub  (on-snub:event-core ships.task)
       %spew  (on-spew:event-core veb.task)
+      %cong  (on-cong:event-core [msg mem]:task)
       %stir  (on-stir:event-core arg.task)
       %trim  on-trim:event-core
       %vega  on-vega:event-core
@@ -1214,19 +1252,19 @@
   [moves ames-gate]
 ::  +stay: extract state before reload
 ::
-++  stay  [%10 %adult ames-state]
+++  stay  [%11 %adult ames-state]
 ::  +load: load in old state after reload
 ::
 ++  load
   =<  |=  $=  old-state
-          $%  [%10 ^ames-state]
+          $%  [%11 ^ames-state]
           ==
       ^+  ames-gate
-      ?>  ?=(%10 -.old-state)
+      ?>  ?=(%11 -.old-state)
       ames-gate(ames-state +.old-state)
+  ::  all state transitions are called from larval ames
   ::
   |%
-  ::  +state-4-to-5 called from larval-ames
   ::
   ++  state-4-to-5
     |=  ames-state=ames-state-4
@@ -1244,7 +1282,6 @@
         message-pump-state
       ship-state
     ames-state
-  ::  +state-5-to-6 called from larval-ames
   ::
   ++  state-5-to-6
     |=  ames-state=ames-state-5
@@ -1267,7 +1304,6 @@
     :_  +.peer-state
     =,  -.peer-state
     [symmetric-key life rift public-key sponsor]
-  ::  +state-6-to-7 called from larval-ames
   ::
   ++  state-6-to-7
     |=  ames-state=ames-state-6
@@ -1282,41 +1318,42 @@
     ^-  peer-state
     :-  +<.ship-state
     [route qos ossuary snd rcv nax heeds ~ ~ ~]:ship-state
-  ::  +state-7-to-8 called from larval-ames
   ::
   ++  state-7-to-8
     |=  ames-state=ames-state-7
     ^-  ames-state-8
-    :*  peers.ames-state
+    =,  ames-state
-        unix-duct.ames-state
+    :*  peers  unix-duct  life  crypto-core  bug
-        life.ames-state
-        crypto-core.ames-state
-        bug.ames-state
         *(set wire)
     ==
+  ::
   ++  state-8-to-9
     |=  ames-state=ames-state-8
     ^-  ames-state-9
-    :*  peers.ames-state
+    =,  ames-state
-        unix-duct.ames-state
+    :*  peers  unix-duct  life  crypto-core  bug  corks
-        life.ames-state
-        crypto-core.ames-state
-        bug.ames-state
-        corks.ames-state
         *(set ship)
     ==
+  ::
   ++  state-9-to-10
     |=  ames-state=ames-state-9
-    ^-  ^^ames-state
+    ^-  ames-state-10
-    :*  peers.ames-state
+    =,  ames-state
-        unix-duct.ames-state
+    :*  peers  unix-duct  life  crypto-core
-        life.ames-state
-        crypto-core.ames-state
         %=  bug.ames-state
-          veb  [&1 &2 &3 &4 &5 &6 |6 %.n]:veb.bug.ames-state
+          veb  [&1 &2 &3 &4 &5 &6 |6 %.n]:veb.bug
         ==
-        corks.ames-state
+        corks  snub
-        snub.ames-state
+    ==
+  ::
+  ++  state-10-to-11
+    |=  ames-state=ames-state-10
+    ^-  ^^ames-state
+    =,  ames-state
+    :*  peers  unix-duct  life  crypto-core  bug  corks  snub
+        ::  5 messages and 100Kb of data outstanding
+        ::
+        [msg=5 mem=100.000]
     ==
   --
 ::  +scry: dereference namespace
@@ -1583,6 +1620,13 @@
       =.  peer-core  (run-message-pump:peer-core i.bones %prod ~)
       $(bones t.bones)
     --
+  ::  +on-cong: adjust congestion control parameters
+  ::
+  ++  on-cong
+    |=  [msg=@ud mem=@ud]
+    ^+  event-core
+    =.  cong.ames-state  msg^mem
+    event-core
   ::  +on-stir: recover from timer desync, setting new timers as needed
   ::
   ::    .arg is unused, meant to ease future debug commands
@@ -2585,7 +2629,7 @@
               (sub [next current]:i.pumps)
               ~(wyt in unsent-messages.i.pumps)
             ==
-          ?:  (gte num 5)
+          ?:  (gte num msg.cong.ames-state)
             &
           $(pumps t.pumps)
         ::  +nuf-memory: is enough memory used to mark as clogged?
@@ -2600,7 +2644,7 @@
               |=([a=@ b=_mem] (add b (met 3 a)))
             ?~  unsent-fragments.i.pumps  0
             (met 3 fragment.i.unsent-fragments.i.pumps)
-          ?:  (gte mem 100.000)
+          ?:  (gte mem mem.cong.ames-state)
             &
           $(pumps t.pumps)
         --