(in-package :opencortex)

(defun sanitize-protocol-message (msg)
  "Recursively strips non-serializable objects (streams, sockets) from a protocol plist."
  (if (and msg (listp msg))
      (let ((clean nil))
        (loop for (k v) on msg by #'cddr
              do (unless (member k '(:reply-stream :socket :stream))
                   (push k clean)
                   (push (if (listp v) (sanitize-protocol-message v) v) clean)))
        (nreverse clean))
      msg))

(defun frame-message (msg)
  "Serializes a message plist and prefixes it with a 6-character hex length."
  (let* ((sanitized (sanitize-protocol-message msg))
         (payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized)))
         (len (length payload)))
    (format nil "~6,'0x~a" len payload)))

(defun read-framed-message (stream)
  "Reads a hex-prefixed message from a stream. Returns the parsed Lisp plist or :EOF."
  (handler-case
      (let ((len-buf (make-string 6)))
        ;; 1. Read the length prefix
        (let ((count (read-sequence len-buf stream)))
          (if (< count 6)
              :eof
              (let ((len (ignore-errors (parse-integer len-buf :radix 16))))
                (if (and len (> len 0))
                    ;; 2. Read exactly 'len' bytes
                    (let ((payload-buf (make-string len)))
                      (read-sequence payload-buf stream)
                      (let ((*read-eval* nil))
                        (read-from-string payload-buf)))
                    :error)))))
    (error (c) 
      (harness-log "PROTOCOL ERROR: ~a" c)
      :error)))

(defun make-hello-message (version)
  "Constructs the standard HELLO handshake message."
  (list :TYPE :EVENT 
        :PAYLOAD (list :ACTION :handshake 
                       :VERSION version 
                       :CAPABILITIES '(:AUTH :SWANK :ORG-AST))))