diff options
Diffstat (limited to 'kaakaa/tools.scm')
| -rw-r--r-- | kaakaa/tools.scm | 256 |
1 files changed, 256 insertions, 0 deletions
diff --git a/kaakaa/tools.scm b/kaakaa/tools.scm new file mode 100644 index 0000000..b490852 --- /dev/null +++ b/kaakaa/tools.scm @@ -0,0 +1,256 @@ +;;; kaakaa --- Tiny, security-focused AI agent in Guile +;;; Copyright © 2026 Arun Isaac <arunisaac@systemreboot.net> +;;; +;;; This file is part of kaakaa. +;;; +;;; kaakaa 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 of the License, or +;;; (at your option) any later version. +;;; +;;; kaakaa 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 kaakaa. If not, see <https://www.gnu.org/licenses/>. + +(define-module (kaakaa tools) + #:use-module ((rnrs base) #:select (assertion-violation)) + #:use-module (rnrs conditions) + #:use-module (rnrs exceptions) + #:use-module (rnrs records syntactic) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:use-module (gnu build linux-container) + #:use-module (gnu system file-systems) + #:use-module (json) + #:use-module (lens) + #:use-module (kaakaa container) + #:use-module (kaakaa records) + #:use-module (kaakaa utils) + #:export (tool->spec + spec->tool-call + eval-tool-call)) + +(define (readonly-cwd-only-mappings cwd arguments) + (list (file-system-mapping + (source cwd) + (target source) + (writable? #f)))) + +(define-public-record-type* (<tool> tool tool?) + (lambda (constructor) + (lambda* (#:key + description (parameters '()) proc + (container-mappings readonly-cwd-only-mappings) + (container-namespaces %namespaces) + title kind) + (unless description + (raise-exception + (condition (make-violation) + (make-message-condition "tool requires description")))) + (unless proc + (raise-exception + (condition (make-violation) + (make-message-condition "tool requires proc")))) + (constructor description parameters proc + container-mappings container-namespaces title kind))) + (fields (description tool-description) + ;; Association list mapping parameter names to + ;; <tool-parameter> objects. + (parameters tool-parameters) + (proc tool-proc) + (container-mappings tool-container-mappings) + (container-namespaces tool-container-namespaces) + (title tool-title) + (kind tool-kind))) + +(define-public-record-type* (<tool-parameter> tool-parameter tool-parameter?) + (lambda (constructor) + (lambda* (#:key type description (required? #t)) + (unless type + (raise-exception + (condition (make-violation) + (make-message-condition "tool parameter requires type")))) + (unless description + (raise-exception + (condition (make-violation) + (make-message-condition "tool parameter requires description")))) + (constructor type description required?))) + (fields (type tool-parameter-type) + (description tool-parameter-description) + (required? tool-parameter-required?))) + +(define-public-record-type* (<array-type> array-type array-type?) + (fields (subtype array-type-subtype))) + +(define (tool->spec name tool) + "Serialize @var{tool} of @var{name} to OpenAI-compatible JSON spec." + `(("type" . "function") + ("function" + ("name" . ,name) + ("description" . ,(tool-description tool)) + ("parameters" + ("type" . "object") + ("properties" . + ,(map (match-lambda + ((name . parameter) + ;; TODO: Check if the OpenAI API supports arrays of + ;; arrays and other more deeply nested types. + (let ((type (tool-parameter-type parameter))) + `(,name + ("description" . ,(tool-parameter-description parameter)) + ("type" . ,(if (array-type? type) + "array" + type)) + ,@(if (array-type? type) + `(("items" . ,(array-type-subtype type))) + '()))))) + (tool-parameters tool))) + ("required" . + ,(list->vector + (filter-map (match-lambda + ((name . parameter) + (and (tool-parameter-required? parameter) + name))) + (tool-parameters tool)))))))) + +(define-public-record-type* (<tool-call> tool-call tool-call?) + (fields (session-id tool-call-session-id) + (session-cwd tool-call-session-cwd) + (id tool-call-id) + (function tool-call-function) + (arguments tool-call-arguments) + ;; One of 'approved, 'rejected or 'cancelled + (status tool-call-status lensed))) + +(define-public-record-type* (<tool-call-result> tool-call-result tool-call-result?) + (fields (session-id tool-call-result-session-id) + (call-id tool-call-result-call-id) + (title tool-call-result-title) + (kind tool-call-result-kind) + (arguments tool-call-result-arguments) + (json tool-call-result-json) + (success? tool-call-result-success?))) + +(define-condition-type &tool-call-failure &serious + tool-call-failure tool-call-failure? + (message tool-call-failure-message)) + +(define (spec->tool-call session-id session-cwd spec) + "Deserialize JSON tool call @var{spec} into a @code{<tool-call>} +object. @var{session-id} and @var{session-cwd} are the ID and current working +directory of the session the tool call pertains to." + ;; TODO: Assert that type is function, and do more sanitization. + (tool-call session-id + session-cwd + (focus (key-ref "id") + spec) + (focus (in "function" "name") + spec) + ;; The arguments may be invalid JSON. So, we don't deserialize + ;; right away. + (focus (in "function" "arguments") + spec) + '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 + ;; Deserialize arguments checking for valid JSON. + (guard (c (else + (raise-exception + (tool-call-failure + "Error: Arguments are not valid JSON")))) + (json-string->scm (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)))) |