tests/socket-tests.lisp

(in-package #:cl-user)

;;; Nekomata socket layer tests
;;; Deterministic unit tests (no live Docker required)
;;; Integration tests clearly marked — require /var/run/docker.sock

(defpackage #:nekod.test.socket
  (:use #:cl))

(in-package #:nekod.test.socket)

(defvar *tests-run* 0)
(defvar *tests-passed* 0)
(defvar *tests-failed* 0)
(defvar *test-results* nil)

(defmacro deftest (name &body body)
  `(progn
     (incf *tests-run*)
     (handler-case
         (progn ,@body
                (incf *tests-passed*)
                (push (cons ',name :pass) *test-results*)
                (format t "  PASS: ~a~%" ',name))
       (error (e)
         (incf *tests-failed*)
         (push (cons ',name e) *test-results*)
         (format t "  FAIL: ~a — ~a~%" ',name e)))))

(defmacro assert-true (expr)
  `(unless ,expr
     (error "Assertion failed: ~s" ',expr)))

(defmacro assert-equal (expected actual)
  `(let ((e ,expected) (a ,actual))
     (unless (equal e a)
       (error "Expected ~s got ~s" e a))))

(defmacro assert-signals (condition-type &body body)
  `(let ((signaled nil))
     (handler-case (progn ,@body)
       (,condition-type (c) (declare (ignore c)) (setf signaled t)))
     (unless signaled
       (error "Expected ~a to be signaled" ',condition-type))))

;;; =========================================================
;;; UNIT TESTS — No live socket required
;;; =========================================================

(defun run-unit-tests ()
  (format t "~%=== Nekomata Socket Layer — Unit Tests ===~%~%")
  (setf *tests-run* 0 *tests-passed* 0 *tests-failed* 0 *test-results* nil)

  ;; Phase 1: Socket transport conditions
  (format t "--- Socket Transport ---~%")

  (deftest socket-connect-failure-signals-condition
    (assert-signals nekod:socket-connect-error
      (nekod.docker:connect-socket "/nonexistent/path/docker.sock")))

  (deftest disconnect-is-idempotent
    (let ((sock (nekod.docker::make-docker-socket
                 :path "/test" :descriptor nil :stream nil :connected nil)))
      (nekod.docker:disconnect-socket sock)
      (nekod.docker:disconnect-socket sock)
      (nekod.docker:disconnect-socket sock)
      (assert-true (not (nekod.docker:docker-socket-connected sock)))))

  ;; Phase 2: HTTP parsing
  (format t "~%--- HTTP Protocol ---~%")

  (deftest parse-status-line-200
    (multiple-value-bind (ver status reason)
        (nekod.docker::parse-status-line "HTTP/1.1 200 OK")
      (assert-equal "HTTP/1.1" ver)
      (assert-equal 200 status)
      (assert-equal "OK" reason)))

  (deftest parse-status-line-204
    (multiple-value-bind (ver status reason)
        (nekod.docker::parse-status-line "HTTP/1.1 204 No Content")
      (assert-equal 204 status)
      (assert-equal "No Content" reason)))

  (deftest parse-http-headers-basic
    (let ((headers (nekod.docker::parse-http-headers
                    (format nil "Content-Type: application/json~%Content-Length: 42"))))
      (assert-equal "application/json" (nekod.docker::header-value headers "content-type"))
      (assert-equal "42" (nekod.docker::header-value headers "content-length"))))

  (deftest header-value-missing-returns-nil
    (let ((headers (nekod.docker::parse-http-headers "Content-Type: text/plain")))
      (assert-true (null (nekod.docker::header-value headers "x-missing")))))

  (deftest decode-chunk-size-hex
    (assert-equal 255 (nekod.docker::decode-chunk-size "ff"))
    (assert-equal 16 (nekod.docker::decode-chunk-size "10"))
    (assert-equal 0 (nekod.docker::decode-chunk-size "0")))

  (deftest build-http-request-format
    (let ((req (nekod.docker:build-http-request "GET" "/_ping")))
      (assert-true (search "GET /_ping HTTP/1.1" req))
      (assert-true (search "Host: localhost" req))
      (assert-true (search "Connection: close" req))))

  ;; Phase 3: Regex algebra and DFA
  (format t "~%--- Regex DFA ---~%")

  (deftest regex-literal-compiles-to-dfa
    (let* ((re (nekod.regex:re-literal "start"))
           (dfa (nekod.regex::compile-regex-to-dfa re)))
      (assert-true (nekod.regex::dfa-run dfa "start"))
      (assert-true (not (nekod.regex::dfa-run dfa "stop")))
      (assert-true (not (nekod.regex::dfa-run dfa "star")))))

  (deftest regex-union-compiles
    (let* ((re (nekod.regex:re-union
                (nekod.regex:re-literal "die")
                (nekod.regex:re-literal "kill")))
           (dfa (nekod.regex::compile-regex-to-dfa re)))
      (assert-true (nekod.regex::dfa-run dfa "die"))
      (assert-true (nekod.regex::dfa-run dfa "kill"))
      (assert-true (not (nekod.regex::dfa-run dfa "stop")))))

  (deftest regex-concat-compiles
    (let* ((re (nekod.regex:re-concat
                (nekod.regex:re-literal "foo")
                (nekod.regex:re-literal "bar")))
           (dfa (nekod.regex::compile-regex-to-dfa re)))
      (assert-true (nekod.regex::dfa-run dfa "foobar"))
      (assert-true (not (nekod.regex::dfa-run dfa "foo")))
      (assert-true (not (nekod.regex::dfa-run dfa "bar")))))

  (deftest dfa-equals-reference-for-lifecycle
    (nekod.regex:init-default-filters)
    (dolist (action '("start" "stop" "die" "kill" "pause" "unpause"))
      (assert-true (nekod.regex::filter-event-dfa action :lifecycle)))
    (assert-true (not (nekod.regex::filter-event-dfa "unknown" :lifecycle))))

  (deftest dfa-equals-reference-for-critical
    (nekod.regex:init-default-filters)
    (dolist (action '("die" "kill" "oom"))
      (assert-true (nekod.regex::filter-event-dfa action :critical)))
    (assert-true (not (nekod.regex::filter-event-dfa "start" :critical))))

  (deftest dfa-equals-reference-for-network
    (nekod.regex:init-default-filters)
    (dolist (action '("connect" "disconnect" "create" "destroy"))
      (assert-true (nekod.regex::filter-event-dfa action :network)))
    (assert-true (not (nekod.regex::filter-event-dfa "die" :network))))

  ;; Phase 4: Event classification
  (format t "~%--- Event Classification ---~%")

  (deftest lifecycle-filter-classifies
    (nekod.regex:init-default-filters)
    (let ((classes (nekod.regex:classify-event
                    "{\"Type\":\"container\",\"Action\":\"start\",\"ID\":\"abc123\"}")))
      (assert-true (member :lifecycle classes))))

  (deftest network-filter-classifies
    (nekod.regex:init-default-filters)
    (let ((classes (nekod.regex:classify-event
                    "{\"Type\":\"network\",\"Action\":\"connect\",\"ID\":\"net1\"}")))
      (assert-true (member :network classes))))

  (deftest critical-oom-classifies
    (nekod.regex:init-default-filters)
    (let ((classes (nekod.regex:classify-event
                    "{\"Type\":\"container\",\"Action\":\"oom\",\"ID\":\"dead1\"}")))
      (assert-true (member :critical classes))))

  ;; Phase 5: Feature vector derivation
  (format t "~%--- Feature Vectors ---~%")

  (deftest routing-features-deterministic
    (nekod.regex:init-default-filters)
    (let* ((event "{\"Type\":\"container\",\"Action\":\"die\",\"ID\":\"x\"}")
           (v1 (nekod.regex:event-to-feature-vector event))
           (v2 (nekod.regex:event-to-feature-vector event)))
      (assert-true (equalp v1 v2))))

  (deftest critical-event-sets-urgency
    (nekod.regex:init-default-filters)
    (let ((features (nekod.regex:event-to-feature-vector
                     "{\"Type\":\"container\",\"Action\":\"die\",\"ID\":\"x\"}")))
      (assert-equal 1.0d0 (aref features 7))))

  (deftest auth-event-sets-is-auth
    (nekod.regex:init-default-filters)
    (let ((features (nekod.regex:event-to-feature-vector
                     "{\"Type\":\"container\",\"Action\":\"auth_check\",\"ID\":\"x\"}")))
      (assert-equal 1.0d0 (aref features 1))))

  ;; Phase 6: MoE routing
  (format t "~%--- Sparse MoE Routing ---~%")

  (deftest top-k-activates-exactly-two
    (let* ((router (nekod.moe:make-router 2))
           (h (make-array 8 :element-type 'double-float :initial-element 0.5d0))
           (selected (nekod.moe:top-k-experts router h)))
      (assert-equal 2 (length selected))))

  (deftest top-k-weights-sum-to-one
    (let* ((router (nekod.moe:make-router 2))
           (h (make-array 8 :element-type 'double-float :initial-element 0.5d0))
           (routing (nekod.moe:route router h))
           (total (reduce #'+ routing :key #'cdr)))
      (assert-true (< (abs (- total 1.0d0)) 0.001d0))))

  (deftest unauthorized-expert-zero-activation
    (nekod.socket:init-default-capabilities)
    (nekod.socket:revoke-capability "container.read")
    (let* ((router (nekod.moe:make-router 2))
           (h (make-array 8 :element-type 'double-float :initial-element 1.0d0))
           (routing (nekod.moe:route router h)))
      (assert-true (= 2 (length routing)))))

  ;; Phase 7: Backpressure
  (format t "~%--- Backpressure ---~%")

  (deftest oversized-event-rejected
    (nekod.socket:reset-backpressure)
    (let ((big-event (make-string (* 512 1024) :initial-element #\x)))
      (assert-signals nekod:event-too-large
        (nekod.socket:enqueue-event big-event))))

  (deftest normal-event-accepted
    (nekod.socket:reset-backpressure)
    (let ((event "{\"Type\":\"container\",\"Action\":\"start\"}"))
      (assert-equal :accepted (nekod.socket:enqueue-event event))))

  ;; Phase 8: Security policy
  (format t "~%--- Security Policy ---~%")

  (deftest unauthorized-path-denied
    (nekod.socket:init-default-capabilities)
    (assert-signals nekod:policy-denied
      (nekod.socket:authorize-operation "DELETE" "/volumes/prune")))

  (deftest authorized-path-allowed
    (nekod.socket:init-default-capabilities)
    (let ((result (nekod.socket:authorize-operation "GET" "/containers/json")))
      (assert-true (stringp result))))

  (deftest untrusted-socket-path-rejected
    (assert-signals nekod:policy-denied
      (nekod.socket:validate-socket-path "/tmp/evil.sock")))

  (deftest trusted-socket-path-allowed
    (nekod.socket:validate-socket-path "/var/run/docker.sock"))

  ;; Phase 9: Receipts
  (format t "~%--- Receipts ---~%")

  (deftest receipt-creation
    (let ((r (nekod.socket:make-operation-receipt
              :method "GET" :path "/_ping"
              :response-status 200
              :response-body "OK"
              :socket-path "/var/run/docker.sock"
              :policy "ALLOW")))
      (assert-true (nekod.socket::receipt-p r))
      (assert-equal "GET" (nekod.socket::receipt-request-method r))
      (assert-equal 200 (nekod.socket::receipt-response-status r))))

  (deftest receipt-no-secrets
    (let* ((r (nekod.socket:make-operation-receipt
               :method "POST" :path "/auth"
               :request-body "{\"password\":\"secret123\"}"
               :response-status 200
               :response-body "OK"))
           (alist (nekod.socket:receipt-to-alist r)))
      (assert-true (not (search "secret123" (format nil "~a" alist))))))

  ;; Summary
  (format t "~%=== Results: ~a/~a passed, ~a failed ===~%"
          *tests-passed* *tests-run* *tests-failed*)
  (values *tests-passed* *tests-run* *tests-failed*))

;;; =========================================================
;;; INTEGRATION TESTS — Require live Docker socket
;;; =========================================================

(defun docker-available-p ()
  "Check if Docker socket is accessible."
  (probe-file "/var/run/docker.sock"))

(defun run-integration-tests ()
  (format t "~%=== Nekomata Socket Layer — Integration Tests ===~%")
  (unless (docker-available-p)
    (format t "SKIP: /var/run/docker.sock not available~%")
    (return-from run-integration-tests nil))

  (setf *tests-run* 0 *tests-passed* 0 *tests-failed* 0 *test-results* nil)

  (format t "--- Live Docker Socket ---~%")

  (deftest integration-connect-and-ping
    (let ((sock (nekod.docker:connect-socket "/var/run/docker.sock")))
      (unwind-protect
           (progn
             (assert-true (nekod.docker:socket-open-p sock))
             (multiple-value-bind (status body)
                 (nekod.docker:docker-get sock "/_ping")
               (assert-equal 200 status)
               (assert-true (search "OK" body))))
        (nekod.docker:disconnect-socket sock))))

  (deftest integration-version
    (let ((sock (nekod.docker:connect-socket "/var/run/docker.sock")))
      (unwind-protect
           (multiple-value-bind (status body)
               (nekod.docker:docker-get sock "/version")
             (assert-equal 200 status)
             (assert-true (search "ApiVersion" body)))
        (nekod.docker:disconnect-socket sock))))

  (deftest integration-list-containers
    (let ((sock (nekod.docker:connect-socket "/var/run/docker.sock")))
      (unwind-protect
           (multiple-value-bind (status body)
               (nekod.docker:docker-get sock "/containers/json?all=true")
             (assert-equal 200 status)
             (assert-true (stringp body)))
        (nekod.docker:disconnect-socket sock))))

  (deftest integration-full-pipeline
    (nekod.regex:init-default-filters)
    (nekod.socket:init-default-capabilities)
    (nekod.socket:reset-backpressure)
    (let* ((router (nekod.moe:make-router 2))
           (event "{\"Type\":\"container\",\"Action\":\"start\",\"ID\":\"test123\"}")
           (features (nekod.regex:event-to-feature-vector event))
           (routing (nekod.moe:route router features))
           (receipt (nekod.socket:make-operation-receipt
                     :method "EVENT" :path "/events"
                     :request-body event
                     :response-status 200
                     :response-body event
                     :event-classes '(:lifecycle)
                     :feature-vector features
                     :experts (mapcar #'car routing)
                     :weights (mapcar #'cdr routing)
                     :policy "ALLOW")))
      (assert-true (= 2 (length routing)))
      (assert-true (nekod.socket::receipt-p receipt))
      (format t "    Routed to: ~{~a~^, ~}~%"
              (mapcar #'car routing))))

  (format t "~%=== Integration Results: ~a/~a passed, ~a failed ===~%"
          *tests-passed* *tests-run* *tests-failed*)
  (values *tests-passed* *tests-run* *tests-failed*))

;;; =========================================================
;;; Run all
;;; =========================================================

(defun run-all-tests ()
  (multiple-value-bind (p1 r1 f1) (run-unit-tests)
    (multiple-value-bind (p2 r2 f2) (run-integration-tests)
      (let ((total-pass (+ p1 (or p2 0)))
            (total-run (+ r1 (or r2 0)))
            (total-fail (+ f1 (or f2 0))))
        (format t "~%=== TOTAL: ~a/~a passed, ~a failed ===~%"
                total-pass total-run total-fail)
        (values total-pass total-run total-fail)))))