;;; clatter-cap.el --- IRCv3 CAP negotiation and SASL -*- lexical-binding: t; -*-

;; Copyright (C) 2026 Glenn Thompson
;; Author: Glenn Thompson <glenn@paren.works>
;; SPDX-License-Identifier: MIT

;;; Commentary:

;; IRCv3 capability negotiation and SASL authentication for clatter.el.
;; Ported from CLatter's net/irc.lisp CAP handling.

;;; Code:

(require 'cl-lib)
(require 'clatter-config)
(require 'clatter-protocol)
(require 'clatter-connection)
(require 'clatter-sasl-scram)
(require 'clatter-sts)

;; --- CAP LS / REQ / ACK / NAK ---

(defun clatter-cap--finish-negotiation (conn)
  "Finish CAP negotiation, register CONN, and release deferred playback."
  (clatter-send conn "CAP END")
  (clatter-cap--send-registration conn)
  (setf (clatter-connection-cap-negotiating conn) nil)
  (run-hook-with-args 'clatter-cap-complete-hook conn))

(defun clatter-cap--parse-list (caps-string)
  "Parse a space-separated capability list from CAPS-STRING.
Strips =value suffixes (e.g., \"sasl=PLAIN,EXTERNAL\" -> \"sasl\")."
  (when caps-string
    (mapcar (lambda (cap)
              (let ((eq-pos (cl-position ?= cap)))
                (if eq-pos (substring cap 0 eq-pos) cap)))
            (split-string caps-string))))

(defun clatter-cap--find-matching (available wanted)
  "Find capabilities from WANTED that appear in AVAILABLE."
  (cl-remove-if-not (lambda (w)
                      (cl-member w available :test #'string-equal))
                    wanted))

(defun clatter-cap-handle (conn params)
  "Handle a CAP response on CONN with PARAMS.
Dispatches based on subcommand (LS, ACK, NAK)."
  (let* ((subcommand (nth 1 params))
         ;; Handle multi-line CAP LS (third param is *)
         (is-multiline (string= (nth 2 params) "*"))
         (caps-string (if is-multiline (nth 3 params) (nth 2 params))))
    (unless (seq-empty-p caps-string)
      (setq caps-string (string-trim caps-string)))
    (cond
     ;; CAP LS - server lists available capabilities
     ((string-equal subcommand "LS")
      ;; Accumulate capabilities
      (setf (clatter-connection-cap-string conn)
            (cond
             ((and (seq-empty-p (clatter-connection-cap-string conn))
                   (not (seq-empty-p caps-string)))
              caps-string)
             ((and (not (seq-empty-p (clatter-connection-cap-string conn)))
                   (not (seq-empty-p caps-string)))
              (concat (clatter-connection-cap-string conn) " " caps-string))
             (t (clatter-connection-cap-string conn))))
      ;; If there is no multiline indicator, the capability list is complete, so
      ;; handle the result as if it was a single CAP * LS <CAPS-STRING> line.
      (unless (or is-multiline
                  (seq-empty-p (clatter-connection-cap-string conn)))
        (clatter-cap--handle-ls conn (clatter-connection-cap-string conn))))

     ;; CAP ACK - capabilities accepted
     ((string-equal subcommand "ACK")
      (clatter-cap--handle-ack conn caps-string))

     ;; CAP NAK - capabilities rejected
     ((string-equal subcommand "NAK")
      (clatter-cap--handle-nak conn caps-string)))))

(cl-defun clatter-cap--handle-ls (conn caps-string)
  "Handle CAP LS response on CONN with CAPS-STRING."
  ;; Check STS before processing capabilities
  (let* ((config (process-get (clatter-connection-process conn) :clatter-config))
         (hostname (plist-get config :server))
         (is-tls (plist-get config :tls))
         (sts-result (clatter-sts-check-cap caps-string hostname is-tls)))
    (when (and sts-result (eq (plist-get sts-result :action) 'upgrade))
      ;; Must disconnect and reconnect with TLS
      (let ((new-port (plist-get sts-result :port)))
        (clatter--debug "STS: upgrading to TLS on port %d" new-port)
        (clatter-send conn "CAP END")
        ;; Schedule reconnect with TLS
        (run-at-time 0.1 nil
                     (lambda ()
                       (clatter-connect
                        (clatter-connection-network-id conn)
                        :server hostname
                        :port new-port
                        :tls t
                        :nick (clatter-connection-nick conn))))
        (delete-process (clatter-connection-process conn))
        (cl-return-from clatter-cap--handle-ls nil))))
  (let* ((available (clatter-cap--parse-list caps-string))
         (_ (setf (clatter-connection-cap-available conn) available))
         (config (process-get (clatter-connection-process conn) :clatter-config))
         (sasl-type (plist-get config :sasl))
         (client-cert (plist-get config :client-cert))
         (want-sasl-external (and (eq sasl-type 'external)
                                   client-cert
                                   (file-exists-p client-cert)))
         (want-sasl-plain (and (memq sasl-type '(plain scram-sha-256))
                                (clatter-get-password
                                 (clatter-connection-network-id conn))))
         (caps-to-request (clatter-cap--find-matching
                           available clatter-wanted-capabilities)))
    ;; Soju bouncer-networks: requested only on a control connection
    ;; (`:bouncer t' with a bare username), so single-network bouncer
    ;; connections and child fan-out connections keep a minimal CAP REQ.
    (when (clatter-bouncer-networks-p config)
      (dolist (cap '("soju.im/bouncer-networks"
                      "soju.im/bouncer-networks-notify"))
        (when (cl-member cap available :test #'string-equal)
          (cl-pushnew cap caps-to-request :test #'string-equal))))
    ;; Add SASL if wanted and available
    (when (and (or want-sasl-external want-sasl-plain)
               (cl-member "sasl" available :test #'string-equal))
      (push "sasl" caps-to-request)
      (setf (clatter-connection-sasl-state conn) :requested))
    (if caps-to-request
        (progn
          (clatter--debug "Requesting caps: %s" (string-join caps-to-request ", "))
          (clatter-send conn (format "CAP REQ :%s"
                                     (string-join caps-to-request " "))))
      (progn
        (clatter--debug "No IRCv3 capabilities to request")
        (clatter-cap--finish-negotiation conn)))))

(defun clatter-cap--handle-ack (conn caps-string)
  "Handle CAP ACK response on CONN with CAPS-STRING."
  (let* ((acked (clatter-cap--parse-list caps-string))
         (config (process-get (clatter-connection-process conn) :clatter-config))
         (sasl-type (plist-get config :sasl)))
    (setf (clatter-connection-cap-enabled conn)
          (append (clatter-connection-cap-enabled conn) acked))
    (clatter--watchdog "CAP-ACK %s caps=%s sasl-type=%s"
                       (clatter-connection-network-id conn)
                       (string-join acked ",") sasl-type)
    ;; If SASL was ACKed, start authentication
    (if (cl-member "sasl" acked :test #'string-equal)
        (cond
         ;; SASL EXTERNAL
         ((eq sasl-type 'external)
          (clatter--debug "Starting SASL EXTERNAL")
          (setf (clatter-connection-sasl-state conn) :authenticating)
          (clatter-send conn "AUTHENTICATE EXTERNAL"))
         ;; SASL SCRAM-SHA-256
         ((eq sasl-type 'scram-sha-256)
          (clatter--debug "Starting SASL SCRAM-SHA-256")
          (setf (clatter-connection-sasl-state conn) :authenticating)
          (clatter-send conn "AUTHENTICATE SCRAM-SHA-256"))
         ;; SASL PLAIN
         ((eq sasl-type 'plain)
          (setf (clatter-connection-sasl-state conn) :authenticating)
          (clatter-send conn "AUTHENTICATE PLAIN"))
         ;; Fallback
         (t
          (clatter-cap--finish-negotiation conn)))
      ;; No SASL - finish CAP and register
      (clatter-cap--finish-negotiation conn))))

(defun clatter-cap--handle-nak (conn caps-string)
  "Handle CAP NAK response on CONN with CAPS-STRING."
  (clatter--debug "Capabilities rejected: %s" caps-string)
  (clatter-cap--finish-negotiation conn))

;; --- SASL Authentication ---

(defun clatter-cap-handle-authenticate (conn params)
  "Handle AUTHENTICATE response on CONN with PARAMS.
For PLAIN: sends base64-encoded credentials.
For EXTERNAL: sends + (empty, cert already presented at TLS).
For SCRAM-SHA-256: multi-step challenge-response."
  (let* ((response (car params))
         (config (process-get (clatter-connection-process conn) :clatter-config))
         (sasl-type (plist-get config :sasl)))
    (cond
     ;; EXTERNAL
     ((and (string= response "+") (eq sasl-type 'external))
      (clatter-send conn "AUTHENTICATE +"))
     ;; SCRAM-SHA-256: server ready for client-first
     ((and (string= response "+") (eq sasl-type 'scram-sha-256))
      (clatter-cap--scram-client-first conn))
     ;; SCRAM-SHA-256: server-first or server-final response
     ((and (not (string= response "+")) (eq sasl-type 'scram-sha-256))
      (clatter-cap--scram-continue conn response))
     ;; PLAIN
     ((and (string= response "+") (eq sasl-type 'plain))
      (clatter-cap--sasl-plain-authenticate conn)))))

(defun clatter-cap--scram-client-first (conn)
  "Send SCRAM-SHA-256 client-first-message on CONN."
  (let* ((config (process-get (clatter-connection-process conn) :clatter-config))
         (nick (clatter-connection-nick conn))
         ;; SASL authenticates the account/user, which for a Soju bouncer is
         ;; the bouncer username (optionally "user/network@client"), not the
         ;; IRC nick.  Fall back to the nick when unspecified.
         (authcid (or (and config (plist-get config :username)) nick))
         (password (clatter-get-password (clatter-connection-network-id conn)))
         (result (clatter-scram-client-first authcid password))
         (state (car result))
         (message-b64 (cdr result)))
    ;; Store SCRAM state on the connection process
    (process-put (clatter-connection-process conn) :scram-state state)
    (clatter-send conn (format "AUTHENTICATE %s" message-b64))))

(defun clatter-cap--scram-continue (conn server-response)
  "Handle SCRAM server response on CONN.
SERVER-RESPONSE is base64-encoded server message."
  (let ((state (process-get (clatter-connection-process conn) :scram-state)))
    (if (clatter-scram-state-auth-message state)
        ;; We already sent client-final, this is server-final
        (if (clatter-scram-verify-server state server-response)
            (clatter--debug "SCRAM: server signature verified")
          (clatter--debug "SCRAM: server signature INVALID (possible MITM)"))
      ;; This is server-first, send client-final
      (let ((client-final (clatter-scram-client-final state server-response)))
        (clatter-send conn (format "AUTHENTICATE %s" client-final))))))

(defun clatter-cap--sasl-plain-authenticate (conn)
  "Send SASL PLAIN authentication on CONN."
  (let* ((network-id (clatter-connection-network-id conn))
         (config (process-get (clatter-connection-process conn) :clatter-config))
         (nick (clatter-connection-nick conn))
         ;; SASL PLAIN authenticates the account/user, which for a Soju bouncer
         ;; is the bouncer username (optionally "user/network@client"), not the
         ;; IRC nick.  Fall back to the nick when :username is unspecified.
         (authcid (or (and config (plist-get config :username)) nick))
         (password (clatter-get-password network-id))
         ;; SASL PLAIN format: \0authcid\0password
         (auth-string (format "%c%s%c%s" 0 authcid 0 password))
         (encoded (base64-encode-string auth-string t)))
    (setf (clatter-connection-sasl-state conn) :authenticating)
    (clatter-send conn (format "AUTHENTICATE %s" encoded))))

(defun clatter-cap-handle-sasl-success (conn)
  "Handle 903 RPL_SASLSUCCESS on CONN."
  (setf (clatter-connection-sasl-state conn) :done)
  (clatter--debug "SASL authentication successful")
  (clatter-cap--finish-negotiation conn))

(defun clatter-cap-handle-sasl-failure (conn params)
  "Handle 904/905/906 SASL failure on CONN with PARAMS."
  (clatter--watchdog "SASL-FAIL %s %s"
                     (clatter-connection-network-id conn)
                     (or (nth 1 params) "unknown"))
  (message "[clatter] SASL failed: %s" (or (nth 1 params) "unknown"))
  (clatter-cap--finish-negotiation conn))

;; --- Registration (NICK/USER/PASS) ---

(defun clatter-cap--send-registration (conn)
  "Send NICK and USER registration commands on CONN."
  (let* ((config (process-get (clatter-connection-process conn) :clatter-config))
         (nick (clatter-connection-nick conn))
         (username (or (plist-get config :username) nick))
         (realname (or (plist-get config :realname) clatter-default-realname))
         (password (clatter-get-password (clatter-connection-network-id conn) config)))
    (clatter--watchdog "SEND-REG %s nick=%s user=%s"
                       (clatter-connection-network-id conn) nick username)
    ;; Server password (PASS) must come before NICK/USER
    (when password
      (clatter-send conn (clatter-irc-pass password)))
    (clatter-send conn (clatter-irc-nick nick))
    (clatter-send conn (clatter-irc-user username realname))))

(provide 'clatter-cap)

;;; clatter-cap.el ends here
