Implement persistent tool permissions.

We store a list of allowed and rejected tools in the session state,
and pass it on to spec->tool-call so it can set an appropriate tool
call status.

Then, request permission from the client only if the tool call hasn't
been pre-approved or pre-rejected.

2 files changed, 65 insertions, 30 deletions

diff --git a/kaakaa/tea.scm b/kaakaa/tea.scm
index 57526bc..8481dce 100644
--- a/kaakaa/tea.scm
+++ b/kaakaa/tea.scm
@@ -48,12 +48,19 @@
 
 (define-record-type* (<session> session session?)
   (lambda (constructor)
-    (lambda* (cwd #:key cancelling? (messages '()) (pending-tool-calls '()))
-      (constructor cwd cancelling? messages pending-tool-calls)))
+    (lambda* (cwd #:key
+                  cancelling? (messages '()) (pending-tool-calls '())
+                  (allowed-tools '()) (rejected-tools '()))
+      (constructor cwd cancelling? messages pending-tool-calls
+                   allowed-tools rejected-tools)))
   (fields (cwd session-cwd lensed)
           (cancelling? session-cancelling? lensed)
           (messages session-messages lensed)
-          (tool-calls session-tool-calls lensed)))
+          (tool-calls session-tool-calls lensed)
+          ;; List of tool names that are allowlisted for the session
+          (allowed-tools session-allowed-tools lensed)
+          ;; List of tool names that are blocklisted for the session
+          (rejected-tools session-rejected-tools lensed)))
 
 (define-record-type* (<state> state state?)
   (fields (client-request-id state-client-request-id lensed)
@@ -130,6 +137,20 @@
            (key-ref session-id)
            state-sessions))
 
+(define (state-allowed-tools session-id)
+  "Return a lens to focus on allowed tools of session with @var{session-id} in
+state."
+  (compose session-allowed-tools
+           (key-ref session-id)
+           state-sessions))
+
+(define (state-rejected-tools session-id)
+  "Return a lens to focus on rejected tools of session with @var{session-id} in
+state."
+  (compose session-rejected-tools
+           (key-ref session-id)
+           state-sessions))
+
 (define (state-tool-call tool-call-id session-id)
   "Return a lens to focus on tool call with @var{tool-call-id} of session with
 @var{session-id} in state."
@@ -405,6 +426,10 @@ and a list of effects.
                                  (focus (state-cwd session-id)
                                         state)
                                  tools
+                                 (focus (state-allowed-tools session-id)
+                                        state)
+                                 (focus (state-rejected-tools session-id)
+                                        state)
                                  call-json))
           (request-id (focus state-agent-request-id state)))
       (values (-> state
@@ -425,30 +450,34 @@ and a list of effects.
               (let ((tool (focus (key-ref (tool-call-function call))
                                  tools))
                     (args (alist->plist (tool-call-arguments call))))
-                (map acp-message
-                     `(;; Notify client about new tool call.
-                       (("jsonrpc" . "2.0")
-                        ("method" . "session/update")
-                        ("params"
-                         ("sessionId" . ,session-id)
-                         ("update"
-                          ("sessionUpdate" . "tool_call")
-                          ("toolCallId" . ,(tool-call-id call))
-                          ("title" . ,(apply (tool-title tool) args))
-                          ("kind" . ,(apply (tool-kind tool) args))
-                          ("rawInput" . ,(tool-call-arguments call))
-                          ("status" . "pending"))))
-                       ;; Request permission from the client.
-                       (("jsonrpc" . "2.0")
-                        ("id" . ,request-id)
-                        ("method" . "session/request_permission")
-                        ("params"
-                         ("sessionId" . ,session-id)
-                         ("toolCall"
-                          ("toolCallId" . ,(tool-call-id call)))
-                         ("options" .
-                          ,(vector %tool-allow-once
-                                   %tool-reject-once)))))))))))
+                (list
+                 ;; Notify client about new tool call.
+                 (acp-message `(("jsonrpc" . "2.0")
+                                ("method" . "session/update")
+                                ("params"
+                                 ("sessionId" . ,session-id)
+                                 ("update"
+                                  ("sessionUpdate" . "tool_call")
+                                  ("toolCallId" . ,(tool-call-id call))
+                                  ("title" . ,(apply (tool-title tool) args))
+                                  ("kind" . ,(apply (tool-kind tool) args))
+                                  ("rawInput" . ,(tool-call-arguments call))
+                                  ("status" . "pending")))))
+                 ;; Request permission from the client if necessary. Else,
+                 ;; schedule the tool call.
+                 (if (eq? (focus tool-call-status call)
+                          'pending-approval)
+                     (acp-message `(("jsonrpc" . "2.0")
+                                    ("id" . ,request-id)
+                                    ("method" . "session/request_permission")
+                                    ("params"
+                                     ("sessionId" . ,session-id)
+                                     ("toolCall"
+                                      ("toolCallId" . ,(tool-call-id call)))
+                                     ("options" .
+                                      ,(vector %tool-allow-once
+                                               %tool-reject-once)))))
+                     call)))))))
 
 (define (next-state-llm-response state response tools)
   "Given current @var{state} and a new LLM @var{response}, return the next state
diff --git a/kaakaa/tools.scm b/kaakaa/tools.scm
index d975201..cb8fd3c 100644
--- a/kaakaa/tools.scm
+++ b/kaakaa/tools.scm
@@ -146,7 +146,7 @@
   tool-call-failure tool-call-failure?
   (message tool-call-failure-message))
 
-(define (spec->tool-call session-id session-cwd tools spec)
+(define (spec->tool-call session-id session-cwd tools allowed-tools rejected-tools spec)
   "Deserialize JSON tool call @var{spec} into a @code{<tool-call>}
 object. Raise a @code{&tool-call-parse-failure} condition if deserialization
 fails.
@@ -154,7 +154,8 @@ fails.
 @var{session-id} and @var{session-cwd} are the ID and current working directory
 of the session the tool call pertains to. @var{tools} is an association list
 mapping the names of all available tools to their respective @code{<tool>}
-objects."
+objects. @var{allowed-tools} and @var{rejected-tools} are the lists of tool
+names that have been respectively allowed and rejected by the user in advance."
   ;; TODO: Assert that type is function, and do more sanitization.
   (let* ((args (guard (c (else
                           (raise-exception
@@ -190,7 +191,12 @@ objects."
                                        (string-append "Error: Missing required argument "
                                                       arg-name))))))))
                            (tool-parameters tool))
-               'pending-approval)))
+               ;; Set tool call status based on pre-approved and pre-rejected
+               ;; tools.
+               (cond
+                ((member name allowed-tools) 'approved)
+                ((member name rejected-tools) 'rejected)
+                (else 'pending-approval)))))
 
 (define (eval-tool-call tool-call tools)
   "Evaluate @var{tool-call} and return a @code{<tool-call-result>}