Add ls/fetch tools, Google Gemini, Ollama; replace curl with native HTTP
ober
3e4f60a15a39743b3cfc76daf48357112005bb29
--- a/Makefile +++ b/Makefile @@ -6,7 +6,8 @@ JERBUILD = $(SCHEME) --libdirs $(JERBOA_HOME)/lib --script $(JERBOA_HOME)/jerb # Library paths for FFI shared objects (macOS: dylib, Linux: so) SQLITE_LIB_DIR := $(shell brew --prefix sqlite 2>/dev/null)/lib SHIM_DIR := $(CURDIR)/vendor/chez-sqlite -LDPATH := $(SHIM_DIR):$(SQLITE_LIB_DIR) +NATIVE_LIB_DIR := $(JERBOA_HOME)/lib +LDPATH := $(SHIM_DIR):$(SQLITE_LIB_DIR):$(NATIVE_LIB_DIR) .PHONY: all build gen run test clean repl @@ -26,7 +27,8 @@ run: repl: $(SCHEME) $(LIBDIRS) -test: +test: build + DYLD_LIBRARY_PATH=$(LDPATH) LD_LIBRARY_PATH=$(LDPATH) \ $(SCHEME) $(LIBDIRS) --script test/run.ss clean: --- a/lib/jcode/provider/provider.sls +++ b/lib/jcode/provider/provider.sls @@ -9,7 +9,7 @@ (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex mutex? mutex-name) - (std text json) (std os shell) (jcode core log) + (std text json) (std net request) (jcode core log) (jcode core message) (jerboa core) (jerboa runtime)) (def logger (make-logger "provider")) (defstruct provider-record (name api-key model base-url)) @@ -36,7 +36,7 @@ "https://generativelanguage.googleapis.com/v1beta"] [(openrouter) "https://openrouter.ai/api/v1"] [(deepseek) "https://api.deepseek.com/v1"] - [(ollama) "http://localhost:11434/api"] + [(ollama) "http://localhost:11434/v1"] [else (error 'provider-default-url "Unknown provider" name)])) (def (provider-chat provider messages tools) @@ -60,60 +60,12 @@ (let ([response (provider-chat provider messages tools)]) (callback response) response)) - (def (curl-post url headers body-json) - (let* ([header-args (apply - string-append - (map (lambda (h) - (string-append - " -H " - (shell-quote - (string-append - (car h) - ": " - (cdr h))))) - headers))] - [cmd (string-append "curl -s -w '\\n__STATUS__%{http_code}' -X POST " - (shell-quote url) header-args " -d " - (shell-quote body-json))]) - (let-values ([(out err code) (shell/status cmd #f)]) - (if (not (= code 0)) - (error 'curl-post - (format "curl failed (exit ~a): ~a" code err)) - (let* ([marker "__STATUS__"] - [marker-pos (let loop ([i (- (string-length out) - (string-length marker) - 3)]) - (cond - [(< i 0) #f] - [(string=? - (substring - out - i - (+ i (string-length marker))) - marker) - i] - [else (loop (- i 1))]))] - [body (if marker-pos - (substring - out - 0 - (if (and (> marker-pos 0) - (char=? - (string-ref - out - (- marker-pos 1)) - #\newline)) - (- marker-pos 1) - marker-pos)) - out)] - [status (if marker-pos - (string->number - (substring - out - (+ marker-pos (string-length marker)) - (string-length out))) - 0)]) - (values status body)))))) + (def (http-post-json url headers body-json) + (let* ([resp (http-post url headers body-json)] + [status (request-status resp)] + [body (request-text resp)]) + (request-close resp) + (values status body))) (def (openai-chat provider messages tools) (let* ([url (string-append (provider-base-url provider) @@ -121,16 +73,18 @@ [headers (openai-headers provider)] [body (openai-body provider messages tools)]) (let-values ([(status text) - (curl-post url headers (json-object->string body))]) + (http-post-json + url + headers + (json-object->string body))]) (if (= status 200) (openai-parse-response (string->json-object text)) (error 'openai-chat (format "API error ~a: ~a" status text)))))) (def (openai-headers provider) - `(("Content-Type" . "application/json") - ("Authorization" - . - ,(string-append "Bearer " (provider-api-key provider))))) + (let ([key (or (provider-api-key provider) "")]) + `(("Content-Type" . "application/json") + ("Authorization" . ,(string-append "Bearer " key))))) (def (openai-body provider messages tools) (let ([body (make-hash-table)]) (hash-put! body "model" (provider-model provider)) @@ -152,7 +106,10 @@ [headers (anthropic-headers provider)] [body (anthropic-body provider messages tools)]) (let-values ([(status text) - (curl-post url headers (json-object->string body))]) + (http-post-json + url + headers + (json-object->string body))]) (if (= status 200) (anthropic-parse-response (string->json-object text)) (error 'anthropic-chat @@ -256,6 +213,126 @@ (json-object->string (hash-ref tu "input" #f)))) tool-uses))))) (def (google-chat provider messages tools) - (error 'google-chat "Google provider not yet implemented")) + (let* ([url (string-append (provider-base-url provider) "/models/" + (provider-model provider) ":generateContent?key=" + (provider-api-key provider))] + [headers '(("Content-Type" . "application/json"))] + [body (google-body provider messages tools)]) + (let-values ([(status text) + (http-post-json + url + headers + (json-object->string body))]) + (if (= status 200) + (google-parse-response (string->json-object text)) + (error 'google-chat + (format "API error ~a: ~a" status text)))))) + (def (google-body provider messages tools) + (let ([body (make-hash-table)] + [system-msg (find-system-message messages)] + [other-msgs (remove-system-messages messages)]) + (when system-msg + (let ([si (make-hash-table)] [part (make-hash-table)]) + (hash-put! part "text" (message-content system-msg)) + (hash-put! si "parts" (list part)) + (hash-put! body "systemInstruction" si))) + (hash-put! + body + "contents" + (map google-convert-message other-msgs)) + (when (and tools (not (null? tools))) + (let ([td (make-hash-table)]) + (hash-put! + td + "function_declarations" + (map google-convert-tool tools)) + (hash-put! body "tools" (list td)))) + body)) + (def (google-convert-message msg) + (let ([ht (make-hash-table)]) + (cond + [(message-tool-call-id msg) + (hash-put! ht "role" "user") + (let ([part (make-hash-table)] + [fr (make-hash-table)] + [resp (make-hash-table)]) + (hash-put! resp "output" (or (message-content msg) "")) + (hash-put! fr "name" (message-tool-call-id msg)) + (hash-put! fr "response" resp) + (hash-put! part "functionResponse" fr) + (hash-put! ht "parts" (list part)))] + [(equal? (message-role msg) "assistant") + (hash-put! ht "role" "model") + (let ([text-parts (if (message-content msg) + (let ([p (make-hash-table)]) + (hash-put! + p + "text" + (message-content msg)) + (list p)) + '())] + [call-parts (if (message-tool-calls msg) + (map (lambda (tc) + (let ([p (make-hash-table)] + [fc (make-hash-table)]) + (hash-put! + fc + "name" + (tool-call-name tc)) + (hash-put! + fc + "args" + (string->json-object + (tool-call-arguments tc))) + (hash-put! p "functionCall" fc) + p)) + (message-tool-calls msg)) + '())]) + (hash-put! ht "parts" (append text-parts call-parts)))] + [else + (hash-put! ht "role" "user") + (let ([p (make-hash-table)]) + (hash-put! p "text" (or (message-content msg) "")) + (hash-put! ht "parts" (list p)))]) + ht)) + (def (google-convert-tool tool) + (let ([fn (hash-ref tool "function" (make-hash-table))] + [ht (make-hash-table)]) + (hash-put! ht "name" (hash-ref fn "name" "")) + (hash-put! ht "description" (hash-ref fn "description" "")) + (hash-put! + ht + "parameters" + (hash-ref fn "parameters" (make-hash-table))) + ht)) + (def (google-parse-response json) + (let* ([candidates (hash-ref json "candidates" '())] + [candidate (if (null? candidates) #f (car candidates))] + [content (and candidate (hash-get candidate "content"))] + [parts (if content (hash-ref content "parts" '()) '())] + [text-parts (filter (lambda (p) (hash-get p "text")) parts)] + [fn-calls (filter + (lambda (p) (hash-get p "functionCall")) + parts)] + [text (if (null? text-parts) + #f + (hash-ref (car text-parts) "text" ""))]) + (if (null? fn-calls) + (make-assistant-message text) + (make-assistant-message + text + (map (lambda (p) + (let ([fc (hash-ref + p + "functionCall" + (make-hash-table))]) + (let ([name (hash-ref fc "name" "")] + [args (json-object->string + (hash-ref + fc + "args" + (make-hash-table)))]) + (restore-tool-call name name args)))) + fn-calls))))) (def (ollama-chat provider messages tools) - (error 'ollama-chat "Ollama provider not yet implemented"))) + (openai-chat provider messages tools))) --- a/lib/jcode/tool/file.sls +++ b/lib/jcode/tool/file.sls @@ -15,6 +15,19 @@ (def logger (make-logger "tool.file")) (def (init-file-tools) (register-tool! + "ls" + "List the contents of a directory. Returns file and directory names (directories end with /)." + (make-schema + '(("path" + "string" + "Directory to list (default: current directory)" + #f) + ("show_hidden" + "boolean" + "Include hidden files starting with . (default: false)" + #f))) + handle-ls) + (register-tool! "read" "Read the contents of a file. Returns the file contents as a string." (make-schema @@ -68,6 +81,39 @@ "Glob pattern to filter files (e.g., *.ss)" #f))) handle-grep)) + (def (handle-ls args) + (let* ([path (let ([p (hash-ref args "path" #f)]) + (if (or (not p) (eq? p (void))) "." p))] + [show-hidden (let ([s (hash-ref args "show_hidden" #f)]) + (if (or (not s) (eq? s (void))) #f s))]) + (log-debug logger "ls" `((path . ,path))) + (cond + [(not (file-exists? path)) + (format "Error: Path not found: ~a" path)] + [(not (file-directory? path)) + (format "Error: Not a directory: ~a" path)] + [else + (let* ([entries (directory-list path)] + [visible (if show-hidden + entries + (filter + (lambda (e) + (or (= (string-length e) 0) + (not (char=? + (string-ref e 0) + #\.)))) + entries))] + [sorted (sort visible string<?)] + [base (strip-trailing-slash path)] + [lines (map (lambda (e) + (let ([full (string-append base "/" e)]) + (if (file-directory? full) + (string-append e "/") + e))) + sorted)]) + (if (null? lines) + "(empty directory)" + (string-join lines "\n")))]))) (def (handle-read args) (let ([path (hash-ref args "path" #f)]) (unless path new file mode 100644 --- /dev/null +++ b/lib/jcode/tool/web.sls @@ -0,0 +1,78 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jcode/tool/web.ss + +(library (jcode tool web) + (export init-web-tools) + (import + (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- + getenv path-extension path-absolute? thread? make-mutex + mutex? mutex-name) + (std net request) (std text json) (jcode core log) + (jcode tool registry) (jerboa core) (jerboa runtime)) + (def logger (make-logger "tool.web")) + (def (init-web-tools) + (register-tool! + "fetch" + "Fetch a URL via HTTP/HTTPS. Supports GET and POST. Returns HTTP status and response body." + (make-fetch-schema) + handle-fetch)) + (def (make-fetch-schema) + (let ([schema (make-hash-table)] [props (make-hash-table)]) + (hash-put! schema "type" "object") + (hash-put! schema "required" '("url")) + (let ([url-p (make-hash-table)]) + (hash-put! url-p "type" "string") + (hash-put! + url-p + "description" + "URL to fetch (http:// or https://)") + (hash-put! props "url" url-p)) + (let ([method-p (make-hash-table)]) + (hash-put! method-p "type" "string") + (hash-put! + method-p + "description" + "HTTP method: GET or POST (default: GET)") + (hash-put! props "method" method-p)) + (let ([body-p (make-hash-table)]) + (hash-put! body-p "type" "string") + (hash-put! body-p "description" "Request body for POST") + (hash-put! props "body" body-p)) + (let ([headers-p (make-hash-table)]) + (hash-put! headers-p "type" "string") + (hash-put! + headers-p + "description" + "Extra request headers as a JSON object string") + (hash-put! props "headers" headers-p)) + (hash-put! schema "properties" props) + schema)) + (def (handle-fetch args) + (let* ([url (hash-ref args "url" #f)] + [method (let ([m (hash-ref args "method" #f)]) + (if (or (not m) (eq? m (void))) "GET" m))] + [body (let ([b (hash-ref args "body" #f)]) + (if (eq? b (void)) #f b))] + [headers (let ([h (hash-ref args "headers" #f)]) + (if (eq? h (void)) #f h))]) + (unless url + (error 'fetch "Missing required parameter: url")) + (log-info logger "fetch" `((url . ,url) (method . ,method))) + (try (fetch-url url method body headers) + (catch (e) (format "Error: ~a" (err->string e)))))) + (def (fetch-url url method body headers-json) + (let* ([extra-headers (if headers-json + (let ([ht (string->json-object + headers-json)]) + (map (lambda (k) + (cons k (hash-ref ht k ""))) + (hash-keys ht))) + '())] + [resp (if (equal? method "POST") + (http-post url extra-headers (or body "")) + (http-get url extra-headers #f))] + [status (request-status resp)] + [text (request-text resp)]) + (request-close resp) + (format "Status: ~a\n~a" status text)))) --- a/lib/jcode/ui/cli.sls +++ b/lib/jcode/ui/cli.sls @@ -11,7 +11,7 @@ (std misc string) (jcode core config) (jcode core log) (jcode core session) (jcode core message) (jcode core agent) (jcode tool registry) (jcode tool file) (jcode tool bash) - (jerboa core) (jerboa runtime)) + (jcode tool web) (jerboa core) (jerboa runtime)) (def logger (make-logger "cli")) (def *version* "0.1.0") (def (cli-main args) @@ -74,7 +74,10 @@ (cddr args) (cons (cons '\x2D;-provider (cadr args)) opts))] [else (cons (cons '\x2D;- args) (reverse opts))]))) - (def (init-tools) (init-file-tools) (init-bash-tool)) + (def (init-tools) + (init-file-tools) + (init-bash-tool) + (init-web-tools)) (def (display-help) (display "jcode - Portable AI coding agent\n\nUSAGE:\n jcode [OPTIONS] [PROMPT]\n jcode [COMMAND]\n\nOPTIONS:\n -h, --help Show this help message\n -v, --version Show version\n -d, --debug Enable debug logging\n -m, --model Model to use (default: claude-sonnet-4-20250514)\n -p, --provider Provider to use (default: anthropic)\n\nCOMMANDS:\n session list List all sessions\n session resume Resume a previous session\n config Show or edit configuration\n\nEXAMPLES:\n jcode Start interactive session\n jcode \"Read main.ss\" One-shot query\n jcode session list List sessions\n")) --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -7,7 +7,7 @@ provider-model) (import :std/text/json - :std/os/shell + :std/net/request :jcode/core/log :jcode/core/message) @@ -36,7 +36,7 @@ ((google) "https://generativelanguage.googleapis.com/v1beta") ((openrouter) "https://openrouter.ai/api/v1") ((deepseek) "https://api.deepseek.com/v1") - ((ollama) "http://localhost:11434/api") + ((ollama) "http://localhost:11434/v1") (else (error 'provider-default-url "Unknown provider" name)))) (def (provider-chat provider messages tools) @@ -56,46 +56,14 @@ (callback response) response)) -;;; HTTP via curl ;;; - -(def (curl-post url headers body-json) - (let* ((header-args - (apply string-append - (map (lambda (h) - (string-append " -H " (shell-quote - (string-append (car h) ": " (cdr h))))) - headers))) - (cmd (string-append - "curl -s -w '\\n__STATUS__%{http_code}' -X POST " - (shell-quote url) - header-args - " -d " (shell-quote body-json)))) - (let-values (((out err code) (shell/status cmd #f))) - (if (not (= code 0)) - (error 'curl-post (format "curl failed (exit ~a): ~a" code err)) - (let* ((marker "__STATUS__") - (marker-pos - (let loop ((i (- (string-length out) (string-length marker) 3))) - (cond - ((< i 0) #f) - ((string=? (substring out i (+ i (string-length marker))) marker) i) - (else (loop (- i 1)))))) - (body - (if marker-pos - (substring out 0 - (if (and (> marker-pos 0) - (char=? (string-ref out (- marker-pos 1)) #\newline)) - (- marker-pos 1) - marker-pos)) - out)) - (status - (if marker-pos - (string->number - (substring out - (+ marker-pos (string-length marker)) - (string-length out))) - 0))) - (values status body)))))) +;;; HTTP POST via (std net request) ;;; + +(def (http-post-json url headers body-json) + (let* ((resp (http-post url headers body-json)) + (status (request-status resp)) + (body (request-text resp))) + (request-close resp) + (values status body))) ;;; OpenAI-compatible API ;;; @@ -103,14 +71,15 @@ (let* ((url (string-append (provider-base-url provider) "/chat/completions")) (headers (openai-headers provider)) (body (openai-body provider messages tools))) - (let-values (((status text) (curl-post url headers (json-object->string body)))) + (let-values (((status text) (http-post-json url headers (json-object->string body)))) (if (= status 200) (openai-parse-response (string->json-object text)) (error 'openai-chat (format "API error ~a: ~a" status text)))))) (def (openai-headers provider) - `(("Content-Type" . "application/json") - ("Authorization" . ,(string-append "Bearer " (provider-api-key provider))))) + (let ((key (or (provider-api-key provider) ""))) + `(("Content-Type" . "application/json") + ("Authorization" . ,(string-append "Bearer " key))))) (def (openai-body provider messages tools) (let ((body (make-hash-table))) @@ -134,7 +103,7 @@ (let* ((url (string-append (provider-base-url provider) "/messages")) (headers (anthropic-headers provider)) (body (anthropic-body provider messages tools))) - (let-values (((status text) (curl-post url headers (json-object->string body)))) + (let-values (((status text) (http-post-json url headers (json-object->string body)))) (if (= status 200) (anthropic-parse-response (string->json-object text)) (error 'anthropic-chat (format "API error ~a: ~a" status text)))))) @@ -223,9 +192,109 @@ ;;; Google Gemini API ;;; (def (google-chat provider messages tools) - (error 'google-chat "Google provider not yet implemented")) + (let* ((url (string-append + (provider-base-url provider) + "/models/" (provider-model provider) + ":generateContent?key=" (provider-api-key provider))) + (headers '(("Content-Type" . "application/json"))) + (body (google-body provider messages tools))) + (let-values (((status text) (http-post-json url headers (json-object->string body)))) + (if (= status 200) + (google-parse-response (string->json-object text)) + (error 'google-chat (format "API error ~a: ~a" status text)))))) + +(def (google-body provider messages tools) + (let ((body (make-hash-table)) + (system-msg (find-system-message messages)) + (other-msgs (remove-system-messages messages))) + (when system-msg + (let ((si (make-hash-table)) + (part (make-hash-table))) + (hash-put! part "text" (message-content system-msg)) + (hash-put! si "parts" (list part)) + (hash-put! body "systemInstruction" si))) + (hash-put! body "contents" (map google-convert-message other-msgs)) + (when (and tools (not (null? tools))) + (let ((td (make-hash-table))) + (hash-put! td "function_declarations" (map google-convert-tool tools)) + (hash-put! body "tools" (list td)))) + body)) + +(def (google-convert-message msg) + (let ((ht (make-hash-table))) + (cond + ;; Tool result — role "tool" maps to Gemini functionResponse + ((message-tool-call-id msg) + (hash-put! ht "role" "user") + (let ((part (make-hash-table)) + (fr (make-hash-table)) + (resp (make-hash-table))) + (hash-put! resp "output" (or (message-content msg) "")) + (hash-put! fr "name" (message-tool-call-id msg)) + (hash-put! fr "response" resp) + (hash-put! part "functionResponse" fr) + (hash-put! ht "parts" (list part)))) + ;; Assistant message — may have text and/or tool calls + ((equal? (message-role msg) "assistant") + (hash-put! ht "role" "model") + (let ((text-parts + (if (message-content msg) + (let ((p (make-hash-table))) + (hash-put! p "text" (message-content msg)) + (list p)) + '())) + (call-parts + (if (message-tool-calls msg) + (map (lambda (tc) + (let ((p (make-hash-table)) + (fc (make-hash-table))) + (hash-put! fc "name" (tool-call-name tc)) + (hash-put! fc "args" + (string->json-object (tool-call-arguments tc))) + (hash-put! p "functionCall" fc) + p)) + (message-tool-calls msg)) + '()))) + (hash-put! ht "parts" (append text-parts call-parts)))) + ;; User message + (else + (hash-put! ht "role" "user") + (let ((p (make-hash-table))) + (hash-put! p "text" (or (message-content msg) "")) + (hash-put! ht "parts" (list p))))) + ht)) + +(def (google-convert-tool tool) + (let ((fn (hash-ref tool "function" (make-hash-table))) + (ht (make-hash-table))) + (hash-put! ht "name" (hash-ref fn "name" "")) + (hash-put! ht "description" (hash-ref fn "description" "")) + (hash-put! ht "parameters" (hash-ref fn "parameters" (make-hash-table))) + ht)) + +(def (google-parse-response json) + (let* ((candidates (hash-ref json "candidates" '())) + (candidate (if (null? candidates) #f (car candidates))) + (content (and candidate (hash-get candidate "content"))) + (parts (if content (hash-ref content "parts" '()) '())) + (text-parts (filter (lambda (p) (hash-get p "text")) parts)) + (fn-calls (filter (lambda (p) (hash-get p "functionCall")) parts)) + (text (if (null? text-parts) #f + (hash-ref (car text-parts) "text" "")))) + (if (null? fn-calls) + (make-assistant-message text) + (make-assistant-message text + (map (lambda (p) + (let ((fc (hash-ref p "functionCall" (make-hash-table)))) + (let ((name (hash-ref fc "name" "")) + (args (json-object->string + (hash-ref fc "args" (make-hash-table))))) + ;; Use function name as ID — Gemini has no separate call IDs + (restore-tool-call name name args)))) + fn-calls))))) -;;; Ollama API ;;; +;;; Ollama API (OpenAI-compatible) ;;; (def (ollama-chat provider messages tools) - (error 'ollama-chat "Ollama provider not yet implemented")) + ;; Ollama exposes an OpenAI-compatible /v1/chat/completions endpoint + (openai-chat provider messages tools)) --- a/src/jcode/tool/file.ss +++ b/src/jcode/tool/file.ss @@ -13,6 +13,11 @@ (def logger (make-logger "tool.file")) (def (init-file-tools) + (register-tool! "ls" + "List the contents of a directory. Returns file and directory names (directories end with /)." + (make-schema '(("path" "string" "Directory to list (default: current directory)" #f) + ("show_hidden" "boolean" "Include hidden files starting with . (default: false)" #f))) + handle-ls) (register-tool! "read" "Read the contents of a file. Returns the file contents as a string." (make-schema '(("path" "string" "Absolute or relative path to the file to read" #t))) @@ -40,6 +45,39 @@ ("glob" "string" "Glob pattern to filter files (e.g., *.ss)" #f))) handle-grep)) +;;; LS ;;; + +(def (handle-ls args) + (let* ((path (let ((p (hash-ref args "path" #f))) + (if (or (not p) (eq? p (void))) "." p))) + (show-hidden (let ((s (hash-ref args "show_hidden" #f))) + (if (or (not s) (eq? s (void))) #f s)))) + (log-debug logger "ls" `((path . ,path))) + (cond + ((not (file-exists? path)) + (format "Error: Path not found: ~a" path)) + ((not (file-directory? path)) + (format "Error: Not a directory: ~a" path)) + (else + (let* ((entries (directory-list path)) + (visible (if show-hidden + entries + (filter (lambda (e) + (or (= (string-length e) 0) + (not (char=? (string-ref e 0) #\.)))) + entries))) + (sorted (sort visible string<?)) + (base (strip-trailing-slash path)) + (lines (map (lambda (e) + (let ((full (string-append base "/" e))) + (if (file-directory? full) + (string-append e "/") + e))) + sorted))) + (if (null? lines) + "(empty directory)" + (string-join lines "\n"))))))) + ;;; READ ;;; (def (handle-read args) new file mode 100644 --- /dev/null +++ b/src/jcode/tool/web.ss @@ -0,0 +1,71 @@ +;;; jcode web tool — HTTP/HTTPS fetch + +(export init-web-tools) + +(import :std/net/request + :std/text/json + :jcode/core/log + :jcode/tool/registry) + +(def logger (make-logger "tool.web")) + +(def (init-web-tools) + (register-tool! "fetch" + "Fetch a URL via HTTP/HTTPS. Supports GET and POST. Returns HTTP status and response body." + (make-fetch-schema) + handle-fetch)) + +(def (make-fetch-schema) + (let ((schema (make-hash-table)) + (props (make-hash-table))) + (hash-put! schema "type" "object") + (hash-put! schema "required" '("url")) + (let ((url-p (make-hash-table))) + (hash-put! url-p "type" "string") + (hash-put! url-p "description" "URL to fetch (http:// or https://)") + (hash-put! props "url" url-p)) + (let ((method-p (make-hash-table))) + (hash-put! method-p "type" "string") + (hash-put! method-p "description" "HTTP method: GET or POST (default: GET)") + (hash-put! props "method" method-p)) + (let ((body-p (make-hash-table))) + (hash-put! body-p "type" "string") + (hash-put! body-p "description" "Request body for POST") + (hash-put! props "body" body-p)) + (let ((headers-p (make-hash-table))) + (hash-put! headers-p "type" "string") + (hash-put! headers-p "description" "Extra request headers as a JSON object string") + (hash-put! props "headers" headers-p)) + (hash-put! schema "properties" props) + schema)) + +(def (handle-fetch args) + (let* ((url (hash-ref args "url" #f)) + (method (let ((m (hash-ref args "method" #f))) + (if (or (not m) (eq? m (void))) "GET" m))) + (body (let ((b (hash-ref args "body" #f))) + (if (eq? b (void)) #f b))) + (headers (let ((h (hash-ref args "headers" #f))) + (if (eq? h (void)) #f h)))) + (unless url (error 'fetch "Missing required parameter: url")) + (log-info logger "fetch" `((url . ,url) (method . ,method))) + (try + (fetch-url url method body headers) + (catch (e) + (format "Error: ~a" (err->string e)))))) + +(def (fetch-url url method body headers-json) + (let* ((extra-headers + (if headers-json + (let ((ht (string->json-object headers-json))) + (map (lambda (k) (cons k (hash-ref ht k ""))) + (hash-keys ht))) + '())) + (resp + (if (equal? method "POST") + (http-post url extra-headers (or body "")) + (http-get url extra-headers #f))) + (status (request-status resp)) + (text (request-text resp))) + (request-close resp) + (format "Status: ~a\n~a" status text))) --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -10,7 +10,8 @@ :jcode/core/agent :jcode/tool/registry :jcode/tool/file - :jcode/tool/bash) + :jcode/tool/bash + :jcode/tool/web) (def logger (make-logger "cli")) (def *version* "0.1.0") @@ -66,7 +67,8 @@ (def (init-tools) (init-file-tools) - (init-bash-tool)) + (init-bash-tool) + (init-web-tools)) (def (display-help) (display "\