From 05ff277b9227d676e3b84162b08213873cd07317 Mon Sep 17 00:00:00 2001
From: Aleteoryx <alyx@aleteoryx.me>
Date: Fri, 30 Aug 2024 12:46:43 -0400
Subject: [PATCH] CAP ACK/NAK, initial negotiation

---
 cap.tcl  | 103 +++++++++++++++++++++++++++++++++++++++++++++----------
 main.tcl |   2 +-
 2 files changed, 86 insertions(+), 19 deletions(-)

diff --git a/cap.tcl b/cap.tcl
index 7589f6f..1caf809 100644
--- a/cap.tcl
+++ b/cap.tcl
@@ -2,6 +2,10 @@
 # - sent (we have sent CAP LS 302, no terminal reply)
 # - ack-wait (we've sent off the first REQ, wait for an ACK to update state and send END. will only transition when cap.req-inflight == {})
 # - finished (all other CAP negotiation(CAP NEW) is handled asynchronously)
+# cap.available: dict of CAPs advertised to us
+# cap.req-inflight: set of inflight CAP REQs. aka a dict where the value is ignored
+# cap.supporting: dict of cap -> callback pairs
+
 
 # handling for CAP-related things
 namespace eval ::cap {
@@ -21,6 +25,7 @@ namespace eval ::cap {
     foreach cap [split [string trim $list] " "] {
       lappend ret $cap
     }
+    return $ret
   }
   proc server_ls list {
     regsub -all { +} $list { } list
@@ -32,7 +37,7 @@ namespace eval ::cap {
           dict set caps $capname [value_dict $value]
         }
         {^(account-notify|account-tag|away-notify|batch|cap-notify|draft/channel-rename|draft/chathistory|chghost|echo-message|draft/event-playback|extended-join|extended-monitor|invite-notify|labeled-response|draft/message-redaction|message-tags|draft/metadata-notify-2|multi-prefix|draft/no-implicit-names|draft/pre-away|draft/read-marker|server-time|setname|standard-replies|userhost-in-names)$} {
-          dict set caps $capname available
+          dict set caps $capname true
         }
         {^(draft/languages|sasl)$} {
           dict set caps $capname [split $value ","]
@@ -44,6 +49,33 @@ namespace eval ::cap {
     }
     return $caps
   }
+
+  proc implied_caps caps {
+    set ret {}
+    set retd {}
+    foreach cap $caps {
+      switch -- $cap {
+        draft/account-registration {
+          lappend ret standard-replies
+        }
+        account-tag {
+          lappend ret message-tags
+        }
+        batch {
+          lappend ret message-tags
+        }
+        draft/chathistory {
+          lappend ret batch server-time message-tags
+        }
+        
+      }
+    }
+    foreach cap $ret {
+      dict set retd $cap set
+    }
+    return $retd
+  }
+
   proc parse_msg cmdargs {
     variable logp
     if {[llength $cmdargs] <= 2} {
@@ -129,6 +161,33 @@ namespace eval ::cap {
     }
   }
 
+  proc test-cap {chan capname capval} {
+    if [irc::meta exists $chan cap supporting $capname] {
+      uplevel #0 [list apply [list {capname capval} [irc::meta get $chan cap supporting $capname]] $capname $capval]
+    } else {
+      return false
+    }
+  }
+
+  proc apply-caps chan {
+    variable logh
+    if [llength [irc::meta get $chan cap req-inflight]] return
+    foreach cap [dict keys [irc::meta get $chan cap to-change]] {
+      if {[string range $cap 0 0] == "-"} {
+        irc::meta unset $chan cap enabled $cap
+      } else {
+        irc::meta set $chan cap enabled $cap set
+      }
+    }
+    irc::meta set $chan cap implied [implied_caps [dict keys [irc::meta get $chan cap enabled]]]
+    irc::meta set $chan cap to-change {}
+    if {[irc::meta get $chan cap status] == "ack-wait"} {
+      irc::msg send $chan CAP END
+      ${logh}::info "initial capability negotiation complete"
+      irc::meta set $chan cap status "finished"
+    }
+  }
+
   proc handler dispatch {
     variable logh
     ${logh}::debug "handling CAP message"
@@ -152,13 +211,10 @@ namespace eval ::cap {
           set req_acc {}
           dict for {cap val} $available {
             # if we don't have a capability enabled, and we support it, request it
-            if {![irc::meta exists $chan cap enabled $cap] && [irc::meta exists $chan cap supporting $cap]} {
-              # if we don't really support it, continue
-              uplevel #0 [list set capvalue $val]
-              if ![uplevel #0 [irc::meta get $chan cap supporting $cap]] { continue; }
+            if {![irc::meta exists $chan cap enabled $cap] && [test-cap $chan $cap $val]} {
+              ${logh}::debug "attempting to negotiate $cap"
+              irc::meta set $chan cap req-inflight $cap set
 
-              # this little manouver pushes to the req-inflight stack
-              irc::meta set $chan cap req-inflight [concat [irc::meta get $chan cap req-inflight] [list $cap]]
               if {[string length [concat $req_acc [list $cap]]] >= 500} {
                 irc::msg send $chan CAP REQ $req_acc
                 set $req_acc {}
@@ -171,17 +227,28 @@ namespace eval ::cap {
           }
 
           if {[irc::meta get $chan cap status] == "sent"} {
-            irc::meta set $chan cap status "ack-wait"
+            if [llength [irc::meta get $chan cap req-inflight]] {
+              irc::meta set $chan cap status "ack-wait"
+            } else {
+              irc::meta set $chan cap status "finished"
+              irc::msg send $chan CAP END
+              ${logh}::info "initial capability negotiation ended early: no capabilities to negotiate"
+            }
           }
         }
       }
       ACK {
-        # move [0-9a-z\-]+ from cap.req-inflight to cap.enabled; remove -[0-9a-z\-]+ from both cap.req-inflight and cap.enabled
-        puts "TODO!"
+        foreach cap [dict get $parsed caps] {
+          irc::meta unset $chan cap req-inflight $cap
+          irc::meta set $chan cap to-change $cap set
+        }
+        apply-caps $chan
       }
       NAK {
-        # remove from cap.req-inflight
-        puts "TODO!"
+        foreach cap [dict get $parsed caps] {
+          irc::meta unset $chan cap req-inflight $cap
+        }
+        apply-caps $chan
       }
       NEW {
         # run cap.supporting handler, if applicable
@@ -201,20 +268,20 @@ namespace eval ::cap {
     }
   }
 
-  proc support {chan cap {script {expr {true}}}} {
+  proc support {chan cap {script {return true}}} {
     variable log
 
     ${log}::info "supporting CAP $cap"
     # if we're not in early boot, and haven't already requested the capability, request it
     if {[irc::meta exists $chan cap status] && [irc::meta get $chan cap status] != "sent" && [irc::meta exists $chan cap available $cap] && ![irc::meta exists $chan cap supporting $cap]} {
-      uplevel #0 [list set capvalue [irc::meta get $chan cap available $cap]]
-      if [uplevel #0 $script] {
-        # this little manouver pushes to the req-inflight stack
-        irc::meta set $chan cap req-inflight [concat [irc::meta get $chan cap req-inflight] [list $cap]]
+      irc::meta set $chan cap supporting $cap $script
+      if [test-cap $chan $cap [irc::meta get $chan cap available $cap]] {
+        irc::meta set $chan cap req-inflight $cap set
         irc::msg send $chan CAP REQ $cap
       }
+    } else {
+      irc::meta set $chan cap supporting $cap $script
     }
-    irc::meta set $chan cap supporting $cap $script
   }
 
   proc negotiate {chan} {
diff --git a/main.tcl b/main.tcl
index d9f0b9d..74f8e7f 100755
--- a/main.tcl
+++ b/main.tcl
@@ -8,7 +8,7 @@ source irc.tcl
 source cap.tcl
 
 puts "connecting to testnet.ergo.chat"
-set chan [irc::connect testnet.ergo.chat 6667 0]
+set chan [irc::connect testnet.ergo.chat 6697 1]
 
 irc::handler add $chan * {
   ${log}::debug [dict get $dispatch rawmsg]
-- 
2.43.4