;;; acp-fakes.el --- A fake ACP client -*- lexical-binding: t; -*-

;; Copyright (C) 2024 Alvaro Ramirez

;; Author: Alvaro Ramirez https://xenodium.com
;; URL: https://github.com/xenodium/acp.el

;; This package 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, or (at your option)
;; any later version.

;; This package 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; acp-fakes enable faking ACP infrastructure to allow integration
;; in isolation.

;;; Code:

(require 'acp)
(eval-when-compile
  (require 'cl-lib))
(require 'map)

(defun acp-fakes-make-client (messages)
  "Create a fake ACP client that responds using traffic MESSAGES.

Eeach message is of the form:

\((:direction . ...)
  (:kind . ...)
  (:object . ...))"
  (let ((client (acp-make-client
                 :command "cat"
                 :command-params nil
                 :environment-variables nil
                 :request-sender (cl-function (lambda (&key client request _buffer on-success on-failure _sync)
                                                (acp-fakes--request-sender
                                                 :client client
                                                 :request request
                                                 :on-success on-success
                                                 :on-failure on-failure)))
                 :response-sender
                 (cl-function (lambda (&key _client response)
                                (acp-fakes--response-sender :response response)))
                 :request-resolver
                 (cl-function (lambda (&key client id)
                                (acp-fakes--request-resolver :client client :id id))))))
    (setf (map-elt client :message-queue) (copy-sequence messages))
    (setf (map-elt client :pending-requests) '())
    client))

(cl-defun acp-fakes--request-sender (&key client _request on-success on-failure)
  "Send request using CLIENT, ON-SUCCESS, and ON-FAILURE."
  (unless client
    (error ":client is required"))
  (unless client
    (error ":client is required"))
  (let* ((request-id (1+ (map-elt client :request-id)))
         (message-queue (map-elt client :message-queue))
         (pending-requests (map-elt client :pending-requests)))
    (setf (map-elt client :request-id) request-id)
    (setf (map-elt pending-requests request-id) (list on-success on-failure))
    (setf (map-elt client :pending-requests) pending-requests)
    ;; Trigger all related notifications or incoming requests
    ;; potentially generated by the agent, related to the
    ;; client request.
    (when-let ((related-incoming-traffic (acp-fakes--get-related-incoming-traffic
                                          :messages message-queue
                                          :request-id request-id)))
      (cl-flet ((acp--log (&rest _) (ignore))
                (acp--log-traffic (&rest _) (ignore)))
        (dolist (msg related-incoming-traffic)
          (acp--route-incoming-message
           :message msg
           :client client
           :on-notification
           (lambda (notification)
             (dolist (handler (map-elt client :notification-handlers))
               (funcall handler notification)))
           :on-request
           (lambda (request)
             (dolist (handler (map-elt client :request-handlers))
               (funcall handler request)))))))
    (let ((response-message (seq-find
                             (lambda (msg)
                               (and (eq (map-elt msg :direction) 'incoming)
                                    (equal (map-elt (map-elt msg :object) 'id)
                                           request-id)
                                    ;; Must be a response (has result or error key),
                                    ;; not an incoming request (has method key).
                                    (or (map-contains-key (map-elt msg :object) 'result)
                                        (map-contains-key (map-elt msg :object) 'error))))
                             message-queue)))
      (when response-message
        (setf (map-elt client :message-queue)
              (seq-remove (lambda (msg)
                            (eq msg response-message))
                          message-queue))
        (let* ((response-obj (map-elt response-message :object))
               (callbacks (map-elt pending-requests request-id))
               (on-success (nth 0 callbacks))
               (on-failure (nth 1 callbacks))
               (result (map-elt response-obj 'result))
               (error (map-elt response-obj 'error)))
          (setf (map-elt client :pending-requests)
                (map-delete pending-requests request-id))
          (cond
           ((and on-success (map-contains-key response-obj 'result))
            (funcall on-success result)
            result)
           ((and error on-failure)
            (funcall on-failure error)
            error)
           (t
            (error "No matching response found for request %s" request-id))))))))

(cl-defun acp-fakes--response-sender (&key _response)
  "Fake response sender."
  ;; Nothing left to do after sending.
  (ignore))

(cl-defun acp-fakes--request-resolver (&key _client _id)
  "Fake request resolver."
  ;; Pending requests tracked in fake message-queue.
  (ignore))

(defun acp-fakes--test-fake-client ()
  "Test a fake client."
  (let* ((messages '(((:kind . outgoing)
                      (:object (jsonrpc . "2.0") (method . "initialize") (id . 1)
                               (params (protocolVersion . 1)
                                       (clientCapabilities
                                        (fs (readTextFile . :false)
                                            (writeTextFile . :false))))))
                     ((:kind . incoming)
                      (:object (jsonrpc . "2.0") (id . 1)
                               (result (protocolVersion . 1)
                                       (authMethods
                                        . [((id . "oauth-personal")
                                            (name . "Log in with Google")
                                            (description . :null))
                                           ((id . "gemini-api-key")
                                            (name . "Use Gemini API key")
                                            (description
                                             . "Requires setting the `GEMINI_API_KEY` environment variable"))
                                           ((id . "vertex-ai") (name . "Vertex AI")
                                            (description . :null))])
                                       (agentCapabilities (loadSession . :false)
                                                          (promptCapabilities (image . t)
                                                                              (audio . t)
                                                                              (embeddedContext
                                                                               . t))))))))
         (client (acp-fakes-make-client messages)))

    (acp-subscribe-to-notifications
     :client client
     :on-notification (lambda (notification)
                        (message "RECEIVED NOTIFICATION: %s" notification)))

    (acp-subscribe-to-requests
     :client client
     :on-request (lambda (request)
                   (message "RECEIVED REQUEST: %s" request)))

    (acp-send-request
     :client client
     :request (acp-make-initialize-request
               :protocol-version 1
               :read-text-file-capability nil
               :write-text-file-capability nil)
     :on-success (lambda (result)
                   (message "Initialize succeeded: %s" result))
     :on-failure (lambda (error)
                   (message "Initialize failed: %s" error)))))

(cl-defun acp-fakes-replay (&key client on-outgoing)
  "Replay messages from CLIENT's message queue.
For each outgoing message, call ON-OUTGOING with its :object.
For incoming messages without an id, log them."
  (cl-flet ((acp--log (&rest _) (ignore))
            (acp--log-traffic (&rest _) (ignore)))
    (dolist (msg (map-elt client :message-queue))
      (cond
       ((eq (map-elt msg :direction) 'outgoing)
        (when on-outgoing
          (funcall on-outgoing (map-elt msg :object))))
       ((and (eq (map-elt msg :direction) 'incoming)
             (or (not (map-elt (map-elt msg :object) 'id))
                 (map-elt (map-elt msg :object) 'method)))
        (acp--route-incoming-message
         :message msg
         :client client
         :on-notification
         (lambda (notification)
           (dolist (handler (map-elt client :notification-handlers))
             (funcall handler notification)))
         :on-request
         (lambda (request)
           (dolist (handler (map-elt client :request-handlers))
             (funcall handler request)))))))))

(cl-defun acp-fakes--get-authenticate-request (&key messages)
  "Find the first authentication object in MESSAGES."
  (unless messages
    (error ":messages is required"))
  (seq-find (lambda (item)
              (and (eq (map-elt item :direction) 'outgoing)
                   (equal (map-nested-elt item '(:object method))
                          "authenticate")))
            messages))

(cl-defun acp-fakes--get-related-incoming-traffic (&key messages request-id)
  "Extract all the incoming MESSAGES related to incoming request with REQUEST-ID."
  (unless messages
    (error ":messages is required"))
  (unless request-id
    (error ":request-id is required"))
  (let ((collecting nil)
        (result '()))
    (dolist (item messages (nreverse result))
      (let ((direction (alist-get :direction item))
            (kind (alist-get :kind item))
            (id (alist-get 'id (alist-get :object item))))
        (cond
         ;; Start collecting for request with request-id.
         ((and (eq direction 'outgoing)
               (eq kind 'request)
               (equal id request-id))
          (setq collecting t))
         ;; Stop collecting for request with request-id.
         ((and collecting
               (eq direction 'incoming)
               (eq kind 'response)
               (equal id request-id))
          (setq collecting nil))
         ;; Collect incoming requests/notifications while in collecting mode
         ((and collecting
               (eq direction 'incoming)
               (memq kind '(request notification)))
          (push item result)))))))

(provide 'acp-fakes)

;;; acp-fakes.el ends here
