;;; cg-net.el --- Networked multiplayer for card games  -*- lexical-binding: t; -*-

;; Copyright (C) 2026  Corwin Brust

;; Author: Corwin Brust <corwin@bru.st>
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Version: 1.0.91
;; Package-Requires: ((emacs "26.1"))
;; Keywords: games
;; URL: https://code.bru.st/corwin/card-game.el

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Host-authoritative networking for the card games.  One Emacs is the
;; HOST: it owns the canonical game and listens for players.  Other
;; Emacsen CONNECT as clients, send move "intents", and receive the new
;; game state to redraw.  Because the games are turn-based there is
;; nothing to merge, so this is a simple authoritative server rather
;; than a CRDT; crdt.el is kept in reserve for any future free-form
;; shared state.
;;
;; Transport is line-delimited s-expressions over `make-network-process'
;; (plain TCP), so it works wherever Emacs has TCP -- including an
;; Android client joining a desktop host.  A message is a plist with a
;; `:type' key:
;;
;;   client -> host:  (:type hello :name NAME)
;;                    (:type move  :move MOVE)
;;   host -> client:  (:type welcome :seat N)
;;                    (:type state  :state SEXP)
;;
;; A game plugs in by defining methods on `cg-net-apply-move' (host
;; side) and, if its state is not just the env plist, on
;; `cg-net-game-state' / `cg-net-set-game-state'.  Clients add a
;; redraw function to `cg-net-state-functions'.

;;; Code:

(require 'cg-core)

(defgroup cg-net nil
  "Networked play for card games."
  :group 'card-games
  :prefix "cg-net-")

(defcustom cg-net-port 7500
  "Default TCP port used to host or join a game."
  :type 'integer :group 'cg-net)

(defcustom cg-net-host-address "127.0.0.1"
  "Address the host's listening socket binds when hosting a game.
The default, \"127.0.0.1\", accepts connections only from this
machine; remote players reach it through a tunnel they were
deliberately given (for example ssh port forwarding), which also
encrypts the traffic in transit.

Setting this to \"0.0.0.0\" listens on every network interface, which
means anyone able to reach this machine's port can take a seat: there
is no password and no encryption on the wire.  That can be a
reasonable choice on a trusted LAN, but it is a choice -- make it
deliberately."
  :type '(choice (const :tag "This machine only (recommended)" "127.0.0.1")
                 (const :tag "Every interface (anyone who can reach you)" "0.0.0.0")
                 (string :tag "A specific interface address"))
  :group 'cg-net)

(defcustom cg-net-max-line 65536
  "Longest unterminated line accepted from a connection, in bytes.
Messages in this protocol are short; 64 KiB is generous.  A connection
whose pending (newline-less) data exceeds this is closed, so one peer
cannot grow the line buffer until memory runs out."
  :type 'integer :group 'cg-net)

(defcustom cg-net-max-connections 8
  "Most simultaneous client connections a host will accept.
A table seats four, so the default leaves headroom without letting the
client list grow unboundedly.  Connections beyond the limit are closed
as they arrive."
  :type 'integer :group 'cg-net)

(defvar cg-net-state-functions nil
  "Abnormal hook run on a client after the game state is updated.
Each function is called with the client's game object.")

(defvar cg-net-connect-functions nil
  "Abnormal hook run on the host when a client connects.
Each function is called with (HOST SEAT): the `cg-net-host' struct and
the seat number just assigned to the new connection.")

;;;; Game integration points

(cl-defgeneric cg-net-apply-move (game seat move)
  "Apply MOVE made by SEAT to GAME on the host.
Return non-nil when the move was accepted (and state should broadcast).")

(cl-defgeneric cg-net-game-state (game &optional seat)
  "Return a `read'able representation of GAME's shared state for SEAT.
SEAT is the recipient's seat number, letting a game hide other players'
private information; nil requests the full host view.")

(cl-defmethod cg-net-game-state ((game cg-game) &optional _seat)
  "Default: return GAME's env plist (no per-seat filtering)."
  (oref game env))

(cl-defgeneric cg-net-set-game-state (game state)
  "Replace GAME's shared state with STATE on a client.")

(cl-defmethod cg-net-set-game-state ((game cg-game) state)
  "Default: install STATE as GAME's env plist."
  (oset game env state))

;;;; Wire protocol

(defun cg-net--send (proc msg)
  "Send MSG (a sexp) to PROC as one newline-terminated line."
  (when (process-live-p proc)
    (let ((print-length nil) (print-level nil))
      (process-send-string proc (concat (prin1-to-string msg) "\n")))))

(defun cg-net--scrub (x)
  "Return X with text properties removed from every string inside it.
Walks conses and vectors, tolerating shared and circular structure.
Everything arriving over the network passes through this: text
properties can rebind keys or carry expressions evaluated during
redisplay, and there is never a reason to honour a remote peer's."
  (let ((seen (make-hash-table :test 'eq)))
    (cl-labels ((walk (v)
                  (cond
                   ((stringp v) (substring-no-properties v))
                   ((consp v)
                    (or (gethash v seen)
                        (let ((cell (cons nil nil)))
                          (puthash v cell seen)
                          (setcar cell (walk (car v)))
                          (setcdr cell (walk (cdr v)))
                          cell)))
                   ((vectorp v)
                    (or (gethash v seen)
                        (let ((copy (make-vector (length v) nil)))
                          (puthash v copy seen)
                          (dotimes (i (length v))
                            (aset copy i (walk (aref v i))))
                          copy)))
                   (t v))))
      (walk x))))

(defconst cg-net-max-nodes 20000
  "Upper bound on the number of nodes accepted in one wire message.")

(defun cg-net--valid-p (msg types)
  "Return non-nil when MSG is a well-shaped protocol message.
TYPES is the list of message-type symbols accepted from this peer.
MSG must be a proper plist whose `:type' is in TYPES, built only from
conses, vectors, strings, numbers and symbols, with no shared or
circular structure and at most `cg-net-max-nodes' nodes.  Accept what
is recognised rather than trying to spot what is bad: parsed text can
carry self-references that hang code walking them, and objects that
impersonate internal record types."
  (let ((seen (make-hash-table :test 'eq))
        (nodes 0))
    (cl-labels ((clean-p (v)
                  (cond
                   ((> (cl-incf nodes) cg-net-max-nodes) nil)
                   ((consp v)
                    (and (not (gethash v seen))
                         (progn (puthash v t seen)
                                (and (clean-p (car v)) (clean-p (cdr v))))))
                   ((vectorp v)
                    (and (not (gethash v seen))
                         (progn (puthash v t seen)
                                (cl-every #'clean-p v))))
                   ((or (stringp v) (numberp v) (symbolp v)) t)
                   (t nil))))
      (and (consp msg)
           (clean-p msg)                      ; safe before plist-get: no cycles past here
           (null (cdr (last msg)))            ; a proper list
           (cl-evenp (length msg))            ; of key/value pairs
           (memq (plist-get msg :type) types)))))

(defun cg-net--filter (handler types)
  "Return a process filter dispatching each complete line to HANDLER.
HANDLER is called with (PROC MSG) for each line that parses into a
well-shaped message (`cg-net--valid-p') whose type is in TYPES;
strings inside MSG have their text properties stripped first, by
`cg-net--scrub'.  Anything else is dropped where it lands."
  (lambda (proc string)
    (let ((buf (concat (or (process-get proc 'cg-net-buf) "") string))
          (start 0) nl)
      (while (setq nl (cl-search "\n" buf :start2 start))
        (let ((line (substring buf start nl)))
          (setq start (1+ nl))
          (unless (string-empty-p line)
            (condition-case err
                (let ((msg (car (read-from-string line))))
                  (if (cg-net--valid-p msg types)
                      (funcall handler proc (cg-net--scrub msg))
                    (message "cg-net: dropped malformed message")))
              (error (message "cg-net: bad message: %S" err))))))
      (let ((rest (substring buf start)))
        (if (> (length rest) cg-net-max-line)
            (progn
              (process-put proc 'cg-net-buf nil)
              (message "cg-net: dropping %s (line over %d bytes)"
                       (process-name proc) cg-net-max-line)
              (delete-process proc))
          (process-put proc 'cg-net-buf rest))))))

;;;; Host

(cl-defstruct (cg-net-host (:constructor cg-net--host-make))
  server game (clients nil) (next-seat 0))

(defvar cg-net--host nil
  "The running `cg-net-host', or nil when not hosting.")

(defun cg-net-hosting-p ()
  "Return non-nil when this Emacs is hosting a game."
  (and cg-net--host (process-live-p (cg-net-host-server cg-net--host))))

(defun cg-net-host-start (game &optional port)
  "Begin hosting GAME on PORT (default `cg-net-port').  Return the server process.
The socket binds `cg-net-host-address' -- by default, this machine only."
  (let* ((port (or port cg-net-port))
         (server (make-network-process
                  :name "cg-host" :server t :service port
                  :host cg-net-host-address :family 'ipv4 :coding 'utf-8
                  :log #'cg-net--host-accept)))
    (setq cg-net--host (cg-net--host-make :server server :game game))
    server))

(defun cg-net-host-stop ()
  "Stop hosting and close all client connections."
  (when cg-net--host
    (dolist (c (cg-net-host-clients cg-net--host))
      (when (process-live-p c) (delete-process c)))
    (when (process-live-p (cg-net-host-server cg-net--host))
      (delete-process (cg-net-host-server cg-net--host)))
    (setq cg-net--host nil)))

(defun cg-net--host-sentinel (proc _event)
  "Reap PROC from the client list when its connection has ended.
Without this, departed players stay listed forever and the host keeps
sending to them.  Seat numbers are deliberately not reused: a stale
seat must not be inherited by a stranger mid-game."
  (unless (process-live-p proc)
    (when cg-net--host
      (setf (cg-net-host-clients cg-net--host)
            (delq proc (cg-net-host-clients cg-net--host))))))

(defun cg-net--host-accept (_server connection _message)
  "Set up an accepted CONNECTION: assign a seat and send the current state.
A connection arriving past `cg-net-max-connections' is closed instead."
  (if (>= (length (cl-remove-if-not #'process-live-p
                                    (cg-net-host-clients cg-net--host)))
          cg-net-max-connections)
      (progn
        (message "cg-net: refusing connection (table is at %d)"
                 cg-net-max-connections)
        (delete-process connection))
    (let ((seat (cg-net-host-next-seat cg-net--host)))
      (setf (cg-net-host-next-seat cg-net--host) (1+ seat))
      (push connection (cg-net-host-clients cg-net--host))
      (process-put connection 'cg-net-seat seat)
      (set-process-coding-system connection 'utf-8 'utf-8)
      (set-process-sentinel connection #'cg-net--host-sentinel)
      (set-process-filter connection
                          (cg-net--filter #'cg-net--host-handle '(hello move)))
      (cg-net--send connection (list :type 'welcome :seat seat))
      (cg-net--send connection
                    (list :type 'state
                          :state (cg-net-game-state (cg-net-host-game cg-net--host) seat)))
      (run-hook-with-args 'cg-net-connect-functions cg-net--host seat))))

(defun cg-net--host-handle (proc msg)
  "Handle one message MSG from a client PROC on the host."
  (pcase (plist-get msg :type)
    ('hello (process-put proc 'cg-net-name (plist-get msg :name)))
    ('move
     (let ((seat (process-get proc 'cg-net-seat))
           (game (cg-net-host-game cg-net--host)))
       (when (cg-net-apply-move game seat (plist-get msg :move))
         (cg-net-host-broadcast))))))

(defun cg-net-host-broadcast ()
  "Send each connected client the game state filtered for its seat."
  (when cg-net--host
    (let ((game (cg-net-host-game cg-net--host)))
      (dolist (c (cg-net-host-clients cg-net--host))
        (cg-net--send c (list :type 'state
                              :state (cg-net-game-state
                                      game (process-get c 'cg-net-seat))))))))

;;;; Client

(cl-defstruct (cg-net-client (:constructor cg-net--client-make))
  proc game (seat nil))

(defvar cg-net--client nil
  "The active `cg-net-client', or nil when not connected.")

(defun cg-net-connected-p ()
  "Return non-nil when connected to a host as a client."
  (and cg-net--client (process-live-p (cg-net-client-proc cg-net--client))))

(defun cg-net-connect (host port name game)
  "Connect to HOST on PORT as NAME, syncing into the local GAME.
Return the new `cg-net-client'."
  (let ((proc (make-network-process
               :name "cg-client" :host host :service port
               :family 'ipv4 :coding 'utf-8)))
    (setq cg-net--client (cg-net--client-make :proc proc :game game))
    (set-process-coding-system proc 'utf-8 'utf-8)
    (set-process-filter proc
                        (cg-net--filter #'cg-net--client-handle
                                        '(welcome state full)))
    (cg-net--send proc (list :type 'hello :name name))
    cg-net--client))

(defun cg-net-disconnect ()
  "Disconnect from the host."
  (when (and cg-net--client (process-live-p (cg-net-client-proc cg-net--client)))
    (delete-process (cg-net-client-proc cg-net--client)))
  (setq cg-net--client nil))

(defun cg-net--client-handle (_proc msg)
  "Handle one message MSG from the host on a client."
  (pcase (plist-get msg :type)
    ('welcome (setf (cg-net-client-seat cg-net--client) (plist-get msg :seat)))
    ('state
     (let ((game (cg-net-client-game cg-net--client)))
       (cg-net-set-game-state game (plist-get msg :state))
       (run-hook-with-args 'cg-net-state-functions game)))))

(defun cg-net-send-move (move)
  "Send MOVE to the host from this client."
  (cg-net--send (cg-net-client-proc cg-net--client) (list :type 'move :move move)))

(provide 'cg-net)
;;; cg-net.el ends here