Check for tool existence in spec->tool-call.

2 files changed, 102 insertions, 103 deletions

diff --git a/kaakaa/tea.scm b/kaakaa/tea.scm
index 19d85ee..ce0090e 100644
--- a/kaakaa/tea.scm
+++ b/kaakaa/tea.scm
@@ -256,9 +256,11 @@ and a list of effects."
      ;; requests-alist). Silently ignore it.
      (else (values state '())))))
 
-(define (next-state-tool-call state session-id call-json)
+(define (next-state-tool-call state session-id call-json tools)
   "Given current @var{state} and a new tool @var{call-json}, return the next state
-and a list of effects."
+and a list of effects.
+
+@var{tools} is the same as in @code{tea-loop}."
   (guard (c ((tool-call-parse-failure? c)
              (let ((call-id (focus (key-ref "id") call-json)))
                (values (-> state
@@ -282,6 +284,7 @@ and a list of effects."
                                                  (key-ref session-id)
                                                  state-sessions)
                                         state)
+                                 tools
                                  call-json))
           (request-id (focus state-agent-request-id state)))
       (values (-> state
@@ -310,9 +313,11 @@ and a list of effects."
                                      ,(vector %tool-allow-once
                                               %tool-reject-once))))))))))
 
-(define (next-state-llm-response state response)
+(define (next-state-llm-response state response tools)
   "Given current @var{state} and a new LLM @var{response}, return the next state
-and a list of effects."
+and a list of effects.
+
+@var{tools} is the same as in @code{tea-loop}."
   (let* ((session-id (llm-response-session-id response))
          (llm-reply (focus (in-json "choices" 0 "message")
                            (llm-response-json response)))
@@ -324,7 +329,8 @@ and a list of effects."
     (let-values (((state tool-call-effects)
                   (foldn (lambda (call-json state effects)
                            (let-values (((state new-effects)
-                                         (next-state-tool-call state session-id call-json)))
+                                         (next-state-tool-call
+                                          state session-id call-json tools)))
                              (values state
                                      (append new-effects effects))))
                          tool-calls-json
@@ -403,9 +409,11 @@ state and a list of effects."
                                    ("rawInput" . ,(tool-call-result-arguments result))))))
                   (state->llm-requests session-id state)))))
 
-(define (next-state state message)
+(define (next-state state message tools)
   "Given current @var{state} and a new @var{message}, return the next state and a
-list of effects."
+list of effects.
+
+@var{tools} is the same as in @code{tea-loop}."
   (cond
    ((acp-message? message)
     (let ((json-message (acp-message-json message)))
@@ -426,7 +434,7 @@ list of effects."
                      (else state))
                     effects)))))
    ((llm-response? message)
-    (next-state-llm-response state message))
+    (next-state-llm-response state message tools))
    ((tool-call-result? message)
     (next-state-tool-call-result state message))))
 
@@ -458,7 +466,7 @@ association list matching tool names to @code{<tool>} objects."
 as in @code{tea-loop}."
   (let-values (((state effects)
                 ;; Compute the next state and collect the effects.
-                (next-state state event)))
+                (next-state state event tools)))
     ;; Do the effects.
     (fold (cut do-effect <> <> llm-base-uri llm-api-key model tools)
           state
diff --git a/kaakaa/tools.scm b/kaakaa/tools.scm
index f383446..c816896 100644
--- a/kaakaa/tools.scm
+++ b/kaakaa/tools.scm
@@ -146,118 +146,109 @@
   tool-call-failure tool-call-failure?
   (message tool-call-failure-message))
 
-(define (spec->tool-call session-id session-cwd spec)
+(define (spec->tool-call session-id session-cwd 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.
 
 @var{session-id} and @var{session-cwd} are the ID and current working directory
-of the session the tool call pertains to."
+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."
   ;; TODO: Assert that type is function, and do more sanitization.
   (let ((args (guard (c (else
                          (raise-exception
                           (tool-call-parse-failure
                            "Error: Arguments are not valid JSON"))))
                 (json-string->scm (focus (in "function" "arguments")
-                                         spec)))))
+                                         spec))))
+        (name (focus (in "function" "name")
+                     spec)))
+    (unless (focus (key-ref name) tools)
+      (raise-exception
+       (tool-call-parse-failure
+        (string-append "Error: Function " name " does not exist"))))
     (tool-call session-id
                session-cwd
                (focus (key-ref "id")
                       spec)
-               (focus (in "function" "name")
-                      spec)
-               args
+               name
                'pending-approval)))
 
 (define (eval-tool-call tool-call tools)
   "Evaluate @var{tool-call} and return a @code{<tool-call-result>}
 object. @var{tools} is an association list mapping the names of all
 available tools to their respective @code{<tool>} objects."
-  (cond
-   ((focus (key-ref (tool-call-function tool-call))
-           tools)
-    => (lambda (tool)
-         (case (focus tool-call-status tool-call)
-           ;; User approved tool call.
-           ((approved)
-            (guard (c ((tool-call-failure? c)
-                       (tool-call-result (tool-call-session-id tool-call)
-                                         (tool-call-id tool-call)
-                                         #f
-                                         #f
-                                         (tool-call-arguments tool-call)
-                                         `(("role" . "tool")
-                                           ("tool_call_id" . ,(tool-call-id tool-call))
-                                           ("content" . ,(tool-call-failure-message c)))
-                                         #f)))
-              (let* ((args (tool-call-arguments tool-call))
-                     (filtered-args
-                      ;; Only pick out valid arguments, and error out if any
-                      ;; required arguments are missing.
-                      (alist->plist
-                       (filter-map (match-lambda
-                                     ((arg-name . parameter)
-                                      (cond
-                                       ((assoc arg-name args)
-                                        => identity)
-                                       (else
-                                        (and (tool-parameter-required? parameter)
-                                             (raise-exception
-                                              (tool-call-failure
-                                               (string-append "Error: Missing required argument "
-                                                              arg-name))))))))
-                                   (tool-parameters tool))))
-                     ;; Actually evaluate tool call.
-                     (tool-result
-                      (call-with-container*
-                          (map file-system-mapping->bind-mount
-                               ((tool-container-mappings tool)
-                                (tool-call-session-cwd tool-call)
-                                filtered-args))
-                          (tool-container-namespaces tool)
-                        (lambda ()
-                          (chdir (tool-call-session-cwd tool-call))
-                          (apply (tool-proc tool)
-                                 filtered-args)))))
-                ;; Build result.
-                (tool-call-result (tool-call-session-id tool-call)
-                                  (tool-call-id tool-call)
-                                  (apply (tool-title tool) filtered-args)
-                                  (apply (tool-kind tool) filtered-args)
-                                  (tool-call-arguments tool-call)
-                                  `(("role" . "tool")
-                                    ("tool_call_id" . ,(tool-call-id tool-call))
-                                    ("content" . ,(container-result-output tool-result)))
-                                  (zero? (container-result-exit-value tool-result))))))
-           ;; User cancelled or rejected tool call.
-           ((cancelled rejected)
-            (tool-call-result (tool-call-session-id tool-call)
-                              (tool-call-id tool-call)
-                              #f
-                              #f
-                              (tool-call-arguments tool-call)
-                              `(("role" . "tool")
-                                ("tool_call_id" . ,(tool-call-id tool-call))
-                                ("content" .
-                                 ,(case (focus tool-call-status tool-call)
-                                    ((rejected)
-                                     "Error: User denied permission for this tool call")
-                                    ((cancelled)
-                                     "Error: User cancelled this tool call"))))
-                              #f))
-           (else
-            (assertion-violation (focus tool-call-status tool-call)
-                                 "Invalid tool call status")))))
-   (else
-    (tool-call-result (tool-call-session-id tool-call)
-                      (tool-call-id tool-call)
-                      #f
-                      #f
-                      (tool-call-arguments tool-call)
-                      `(("role" . "tool")
-                        ("tool_call_id" . ,(tool-call-id tool-call))
-                        ("content" .
-                         ,(string-append "Error: Function of name "
-                                         (tool-call-function tool-call)
-                                         " not found")))
-                      #f))))
+  (let ((tool (focus (key-ref (tool-call-function tool-call))
+                     tools)))
+    (case (focus tool-call-status tool-call)
+      ;; User approved tool call.
+      ((approved)
+       (guard (c ((tool-call-failure? c)
+                  (tool-call-result (tool-call-session-id tool-call)
+                                    (tool-call-id tool-call)
+                                    #f
+                                    #f
+                                    (tool-call-arguments tool-call)
+                                    `(("role" . "tool")
+                                      ("tool_call_id" . ,(tool-call-id tool-call))
+                                      ("content" . ,(tool-call-failure-message c)))
+                                    #f)))
+         (let* ((args (tool-call-arguments tool-call))
+                (filtered-args
+                 ;; Only pick out valid arguments, and error out if any required
+                 ;; arguments are missing.
+                 (alist->plist
+                  (filter-map (match-lambda
+                                ((arg-name . parameter)
+                                 (cond
+                                  ((assoc arg-name args)
+                                   => identity)
+                                  (else
+                                   (and (tool-parameter-required? parameter)
+                                        (raise-exception
+                                         (tool-call-failure
+                                          (string-append "Error: Missing required argument "
+                                                         arg-name))))))))
+                              (tool-parameters tool))))
+                ;; Actually evaluate tool call.
+                (tool-result
+                 (call-with-container*
+                     (map file-system-mapping->bind-mount
+                          ((tool-container-mappings tool)
+                           (tool-call-session-cwd tool-call)
+                           filtered-args))
+                     (tool-container-namespaces tool)
+                   (lambda ()
+                     (chdir (tool-call-session-cwd tool-call))
+                     (apply (tool-proc tool)
+                            filtered-args)))))
+           ;; Build result.
+           (tool-call-result (tool-call-session-id tool-call)
+                             (tool-call-id tool-call)
+                             (apply (tool-title tool) filtered-args)
+                             (apply (tool-kind tool) filtered-args)
+                             (tool-call-arguments tool-call)
+                             `(("role" . "tool")
+                               ("tool_call_id" . ,(tool-call-id tool-call))
+                               ("content" . ,(container-result-output tool-result)))
+                             (zero? (container-result-exit-value tool-result))))))
+      ;; User cancelled or rejected tool call.
+      ((cancelled rejected)
+       (tool-call-result (tool-call-session-id tool-call)
+                         (tool-call-id tool-call)
+                         #f
+                         #f
+                         (tool-call-arguments tool-call)
+                         `(("role" . "tool")
+                           ("tool_call_id" . ,(tool-call-id tool-call))
+                           ("content" .
+                            ,(case (focus tool-call-status tool-call)
+                               ((rejected)
+                                "Error: User denied permission for this tool call")
+                               ((cancelled)
+                                "Error: User cancelled this tool call"))))
+                         #f))
+      (else
+       (assertion-violation (focus tool-call-status tool-call)
+                            "Invalid tool call status")))))