forge phase 2: validator + guardrails facade + respond + agent wiring
ober
3fa41791a1e70ac9ce8c324afd72d32bd1eb934e
--- a/build-binary.ss +++ b/build-binary.ss @@ -133,6 +133,9 @@ "lib/jcode/guardrails/error-tracker" "lib/jcode/guardrails/message-type" "lib/jcode/guardrails/rescue" + "lib/jcode/guardrails/validator" + "lib/jcode/guardrails/respond" + "lib/jcode/guardrails/guardrails" "lib/jcode/provider/provider" "lib/jcode/tool/registry" "lib/jcode/tool/file" --- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -9,6 +9,7 @@ current-provider-override current-model-override get-current-provider + forge-respond-enforced? try-parse-text-tool-calls try-parse-xml-tool-calls) @@ -26,6 +27,9 @@ ./compaction :jcode/provider/provider :jcode/tool/registry + :jcode/guardrails/guardrails + :jcode/guardrails/nudge + :jcode/guardrails/respond :jerboa/core :jerboa/runtime) @@ -34,6 +38,14 @@ (def current-provider-override (make-parameter #f)) (def current-model-override (make-parameter #f)) +;; Forge guardrail policy. The guardrail layer (unknown-tool nudge + retry +;; budget + respond unwrap) is always-on for every provider. This parameter +;; gates only the one behavior that would change UX for well-behaved cloud +;; models: treating a clean bare-text response as a failed turn that must be +;; retried as a tool call. Off by default (bare text is a normal final); +;; turn on for small local models that can't be trusted to pick tool-vs-text. +(def forge-respond-enforced? (make-parameter #f)) + (def (system-prompt) (format "You are an expert AI coding assistant. You help users with software development tasks. Working directory: ~a @@ -1055,15 +1067,21 @@ Be concise. Prefer edit over write for modifying existing files. ;; message without matching tool result messages, which the ;; OpenAI-style API rejects with a 400. (try (session-repair-orphan-tool-calls! session-id) (catch (_) (void))) + ;; In respond-forcing mode, expose the synthetic respond tool so the model + ;; has a structured way to answer the user while staying in tool-calling mode. + (when (forge-respond-enforced?) (register-respond-tool!)) (let ((existing (session-get-messages session-id))) (when (null? existing) (session-add-message session-id (make-system-message (system-prompt))))) (session-add-message session-id (make-user-message (expand-mentions user-input))) - (if (current-stream-cb) - (agent-loop-stream session-id (session-get-messages session-id) 0) - (agent-loop session-id (session-get-messages session-id) 0))) + ;; One guardrails instance per user turn — its retry/error budget persists + ;; across the tool-call rounds of this turn, then resets for the next. + (let ((gr (make-guardrails (list-tools)))) + (if (current-stream-cb) + (agent-loop-stream session-id (session-get-messages session-id) 0 gr) + (agent-loop session-id (session-get-messages session-id) 0 gr)))) -(def (agent-loop session-id messages round) +(def (agent-loop session-id messages round gr) (let* ((provider (get-current-provider)) (tools (get-tool-schemas)) (msgs (refresh-system-prompt messages)) @@ -1090,25 +1108,87 @@ Be concise. Prefer edit over write for modifying existing files. hermes-tcs))) (else response))) (tcs (or (message-tool-calls effective) '()))) - (session-add-message session-id effective) (cond - ((null? tcs) effective) - ((>= round *max-tool-rounds*) - (log-warn logger "max-rounds" `((round . ,round))) - (let ((results (execute-tool-calls tcs))) - (for-each (lambda (r) (session-add-message session-id r)) results) - (let* ((final-msgs (refresh-system-prompt (session-get-messages session-id))) - (final (chat-with-expert provider final-msgs '()))) - (session-add-message session-id final) - final))) + ;; Bare text with respond-forcing off: a normal terminal answer. + ((and (null? tcs) (not (forge-respond-enforced?))) + (session-add-message session-id effective) + effective) (else - (let ((results (execute-tool-calls tcs))) - (for-each - (lambda (result) (session-add-message session-id result)) - results) - (agent-loop session-id (session-get-messages session-id) (+ round 1)))))))) + (agent-guardrails-step + session-id provider effective content tcs round gr)))))) + +;; Apply the guardrail verdict to a (possibly tool-calling) response, then +;; act: stop on fatal, inject a corrective signal on retry, unwrap respond() +;; into a terminal answer, or execute the validated calls and recurse. Each +;; branch persists exactly one assistant message so tool_calls stay paired +;; with their results. +(def (agent-guardrails-step session-id provider effective content tcs round gr) + (let* ((cr (guardrails-check gr content tcs)) + (action (check-result-action cr))) + (cond + ;; Retry budget spent — stop and return what we have. + ((string=? action "fatal") + (log-warn logger "guardrails-fatal" `((reason . ,(check-result-reason cr)))) + (session-add-message session-id effective) + effective) + ;; Unusable response: unknown tool, or bare text under enforcement. + ((string=? action "retry") + (session-add-message session-id effective) + (cond + ((pair? tcs) + ;; Unknown tool: ride the corrective signal on the tool channel — + ;; one tool-error result per call — then re-infer (forge inference.py). + (for-each + (lambda (tc) + (session-add-message session-id + (make-tool-result (tool-call-id tc) + (string-append "[UnknownTool] " + (nudge-content (check-result-nudge cr)))))) + tcs) + (agent-loop session-id (session-get-messages session-id) (+ round 1) gr)) + (else + ;; Bare text under enforcement: fall back to a user-role nudge. + (session-add-message session-id + (make-user-message (nudge-content (check-result-nudge cr)))) + (agent-loop session-id (session-get-messages session-id) (+ round 1) gr)))) + ;; Hard round cap as a final safety net. + ((>= round *max-tool-rounds*) + (log-warn logger "max-rounds" `((round . ,round))) + (session-add-message session-id effective) + (let ((results (execute-tool-calls tcs))) + (for-each (lambda (r) (session-add-message session-id r)) results) + (let* ((final-msgs (refresh-system-prompt (session-get-messages session-id))) + (final (chat-with-expert provider final-msgs '()))) + (session-add-message session-id final) + final))) + ;; Execute: respond() ends the turn as plain text; otherwise run the + ;; validated calls and recurse. + (else + (let* ((calls (or (check-result-tool-calls cr) tcs)) + (rc (find-respond-call calls))) + (cond + (rc + (let ((final (make-assistant-message (respond-call->text rc) #f))) + (session-add-message session-id final) + final)) + (else + ;; If calls were rescued from bare text, effective is only the + ;; text — rebuild it carrying the tool_calls so results stay paired. + (let ((asst (if (null? tcs) (make-assistant-message #f calls) effective))) + (session-add-message session-id asst) + (let ((results (execute-tool-calls calls))) + (for-each (lambda (r) (session-add-message session-id r)) results) + (guardrails-record gr (map tool-call-name calls)) + (agent-loop session-id (session-get-messages session-id) + (+ round 1) gr)))))))))) + +(def (find-respond-call calls) + (cond + ((null? calls) #f) + ((respond-call? (car calls)) (car calls)) + (else (find-respond-call (cdr calls))))) -(def (agent-loop-stream session-id messages round) +(def (agent-loop-stream session-id messages round gr) ;; Streaming version: calls (current-stream-cb) for each text token. (let* ((provider (get-current-provider)) (tools (get-tool-schemas)) @@ -1143,26 +1223,76 @@ Be concise. Prefer edit over write for modifying existing files. (response (make-assistant-message effective-content (if (null? effective-tcs) #f effective-tcs)))) - (session-add-message session-id response) (cond - ((null? effective-tcs) response) - ((>= round *max-tool-rounds*) - (log-warn logger "max-rounds" `((round . ,round))) - (let ((results (execute-tool-calls effective-tcs))) - (for-each (lambda (r) (session-add-message session-id r)) results) - (let-values (((fc _tc _u) - (stream-chat-with-expert provider - (refresh-system-prompt (session-get-messages session-id)) - '() - (and raw-cb (make-tool-call-stream-filter raw-cb))))) - (let ((final (make-assistant-message - (if (string=? fc "") #f fc) #f))) - (session-add-message session-id final) - final)))) + ;; Bare text with respond-forcing off: a normal terminal answer. + ((and (null? effective-tcs) (not (forge-respond-enforced?))) + (session-add-message session-id response) + response) (else - (let ((results (execute-tool-calls effective-tcs))) - (for-each (lambda (r) (session-add-message session-id r)) results) - (agent-loop-stream session-id (session-get-messages session-id) (+ round 1))))))))) + (agent-guardrails-step-stream + session-id provider raw-cb response content effective-tcs round gr))))))) + +;; Streaming twin of agent-guardrails-step: same verdict logic, but the +;; round-cap finalization streams its tokens and recursion stays on the +;; streaming loop. +(def (agent-guardrails-step-stream session-id provider raw-cb response content tcs round gr) + (let* ((cr (guardrails-check gr content tcs)) + (action (check-result-action cr))) + (cond + ((string=? action "fatal") + (log-warn logger "guardrails-fatal" `((reason . ,(check-result-reason cr)))) + (session-add-message session-id response) + response) + ((string=? action "retry") + (session-add-message session-id response) + (cond + ((pair? tcs) + (for-each + (lambda (tc) + (session-add-message session-id + (make-tool-result (tool-call-id tc) + (string-append "[UnknownTool] " + (nudge-content (check-result-nudge cr)))))) + tcs) + (agent-loop-stream session-id (session-get-messages session-id) (+ round 1) gr)) + (else + (session-add-message session-id + (make-user-message (nudge-content (check-result-nudge cr)))) + (agent-loop-stream session-id (session-get-messages session-id) (+ round 1) gr)))) + ((>= round *max-tool-rounds*) + (log-warn logger "max-rounds" `((round . ,round))) + (session-add-message session-id response) + (let ((results (execute-tool-calls tcs))) + (for-each (lambda (r) (session-add-message session-id r)) results) + (let-values (((fc _tc _u) + (stream-chat-with-expert provider + (refresh-system-prompt (session-get-messages session-id)) + '() + (and raw-cb (make-tool-call-stream-filter raw-cb))))) + (let ((final (make-assistant-message (if (string=? fc "") #f fc) #f))) + (session-add-message session-id final) + final)))) + (else + (let* ((calls (or (check-result-tool-calls cr) tcs)) + (rc (find-respond-call calls))) + (cond + (rc + ;; Unwrap respond() — the model emitted a tool_call (suppressed by + ;; the stream filter), so push the answer through the cb now. + (let ((msg (respond-call->text rc))) + (when (and raw-cb (string? msg) (not (string=? msg ""))) + (raw-cb msg)) + (let ((final (make-assistant-message msg #f))) + (session-add-message session-id final) + final))) + (else + (let ((asst (if (null? tcs) (make-assistant-message #f calls) response))) + (session-add-message session-id asst) + (let ((results (execute-tool-calls calls))) + (for-each (lambda (r) (session-add-message session-id r)) results) + (guardrails-record gr (map tool-call-name calls)) + (agent-loop-stream session-id (session-get-messages session-id) + (+ round 1) gr)))))))))) (def (execute-tool-calls tool-calls) (log-info logger "executing-tools" `((count . ,(length tool-calls)))) new file mode 100644 --- /dev/null +++ b/src/jcode/guardrails/guardrails.ss @@ -0,0 +1,88 @@ +;;; jcode guardrails facade +;;; +;;; Verbatim port of forge's Guardrails middleware (guardrails/guardrails.py). +;;; Bundles ResponseValidator + ErrorTracker into a two-method API: +;;; (guardrails-check g content tool-calls) -> check-result (before exec) +;;; (guardrails-record g executed) -> done? (after exec) +;;; +;;; Forge's StepEnforcer (the "step_blocked" checkpoint and premature-terminal +;;; budget) lands in Phase 5 with the workflow surface. Until then check +;;; returns one of "execute" / "retry" / "fatal". The shape is forward +;;; compatible: a terminal-tools set is threaded through so record can report +;;; workflow completion once the enforcer arrives. + +(export make-guardrails + guardrails? + guardrails-check + guardrails-record + guardrails-errors + check-result? + check-result-action + check-result-tool-calls + check-result-nudge + check-result-reason) + +(import :jcode/guardrails/validator + :jcode/guardrails/error-tracker) + +;; Private carriers; public API uses the wrappers below. +(defstruct gr (validator errors terminal-tools)) +(defstruct cresult (action tool-calls nudge reason)) + +;; tool-names: valid tool-name strings. +;; opt (positional, all optional): +;; max-retries consecutive bad responses before "fatal" (default 3) +;; max-tool-errors consecutive tool failures before exhaustion (default 2) +;; rescue-enabled? parse tool calls from plain text (default #t) +;; terminal-tools list of tool names that can end a workflow (default '()) +(def (make-guardrails tool-names . opt) + (let* ((max-retries (if (>= (length opt) 1) (list-ref opt 0) 3)) + (max-tool-errors (if (>= (length opt) 2) (list-ref opt 1) 2)) + (rescue-enabled? (if (>= (length opt) 3) (list-ref opt 2) #t)) + (terminal-tools (if (>= (length opt) 4) (list-ref opt 3) '()))) + (make-gr (make-response-validator tool-names rescue-enabled?) + (make-error-tracker max-retries max-tool-errors) + terminal-tools))) + +(def (guardrails? x) (gr? x)) + +;; Expose the underlying error tracker so callers can record per-tool +;; execution results against the tool-error budget (forge keeps this on the +;; ErrorTracker, distinct from the retry budget check below). +(def (guardrails-errors g) (gr-errors g)) + +(def (check-result? x) (cresult? x)) +(def (check-result-action g) (cresult-action g)) +(def (check-result-tool-calls g) (cresult-tool-calls g)) +(def (check-result-nudge g) (cresult-nudge g)) +(def (check-result-reason g) (cresult-reason g)) + +;; Check an LLM response against the guardrails. Call after each response, +;; before executing any tools. +;; "execute" -- tool-calls safe to run (also set on rescued/clean calls). +;; "retry" -- unusable response; inject nudge and re-infer. +;; "fatal" -- retry budget exhausted; stop. +(def (guardrails-check g content tool-calls) + (let ((validation (validate-response (gr-validator g) content tool-calls))) + (cond + ((validation-result-needs-retry? validation) + (error-tracker-record-retry! (gr-errors g)) + (if (error-tracker-retries-exhausted? (gr-errors g)) + (make-cresult "fatal" #f #f "too many consecutive bad responses") + (make-cresult "retry" #f (validation-result-nudge validation) #f))) + (else + (error-tracker-reset-retries! (gr-errors g)) + (make-cresult "execute" (validation-result-tool-calls validation) #f #f))))) + +;; Record which tools were executed (call after running tools). Resets the +;; tool-error budget for the next batch and returns #t when a terminal tool +;; was reached (only meaningful once terminal-tools is configured). +(def (guardrails-record g executed) + (error-tracker-reset-errors! (gr-errors g)) + (any-in? executed (gr-terminal-tools g))) + +(def (any-in? names set) + (cond + ((null? names) #f) + ((member (car names) set) #t) + (else (any-in? (cdr names) set)))) new file mode 100644 --- /dev/null +++ b/src/jcode/guardrails/respond.ss @@ -0,0 +1,65 @@ +;;; jcode guardrail respond tool +;;; +;;; Verbatim port of forge's synthetic respond tool (tools/respond.py). +;;; Small local models (~8B) cannot reliably choose between emitting a tool +;;; call and bare text. The respond tool gives them a structured way to +;;; "answer the user" while staying in tool-calling mode, so the full +;;; guardrail stack still applies. respond() calls are unwrapped into a +;;; normal assistant text message before display (see agent.ss). + +(export respond-tool-name + respond-description + respond-schema + register-respond-tool! + respond-call? + respond-call->text) + +(import :std/text/json + :jcode/core/message + :jcode/tool/registry) + +(def respond-tool-name "respond") + +;; Verbatim forge RESPOND_DESCRIPTION (tools/respond.py). +(def respond-description + (string-append + "Respond to the user with a message. Use this when the user is chatting, " + "asking a question, when you need to ask a clarifying question before " + "proceeding, or when no other tool action is needed. Also use this " + "after completing the user's request to report the result.")) + +;; JSON-schema object the LLM sees: { message: string (required) }. +(def (respond-schema) + (let ((props (make-hash-table)) + (msg (make-hash-table)) + (root (make-hash-table))) + (hash-put! msg "type" "string") + (hash-put! msg "description" "The message to send to the user.") + (hash-put! props "message" msg) + (hash-put! root "type" "object") + (hash-put! root "properties" props) + (hash-put! root "required" (list "message")) + root)) + +;; Idempotent: registers the respond tool so the LLM can call it. The handler +;; just echoes the message; the agent loop unwraps respond() into a terminal +;; assistant message before the handler would ever run. +(def (register-respond-tool!) + (register-tool! respond-tool-name respond-description (respond-schema) + (lambda (args) + (let ((m (and (hash-table? args) (hash-ref args "message" "")))) + (if (string? m) m ""))))) + +(def (respond-call? tc) + (and tc (string=? (tool-call-name tc) respond-tool-name))) + +;; If TC is a respond() call, return its message string (or "" if absent), +;; else #f. Used to unwrap respond into a plain assistant text response. +(def (respond-call->text tc) + (and (respond-call? tc) + (let* ((raw (tool-call-arguments tc)) + (args (guard (e [#t #f]) (string->json-object raw)))) + (if (hash-table? args) + (let ((m (hash-ref args "message" ""))) + (if (string? m) m "")) + "")))) new file mode 100644 --- /dev/null +++ b/src/jcode/guardrails/validator.ss @@ -0,0 +1,66 @@ +;;; jcode guardrail response validator +;;; +;;; Verbatim port of forge's ResponseValidator (guardrails/response_validator.py). +;;; Given an LLM response (assistant text + structured tool-calls), decide +;;; whether the response is usable as-is, rescuable from text, or needs a +;;; corrective retry nudge. Stateless — safe to reuse across turns/sessions. +;;; +;;; Dispatch mirrors forge's TextResponse vs list[ToolCall] split: an empty +;;; tool-call list is a text response (rescue, then retry nudge); a non-empty +;;; one is checked for unknown tool names. + +(export make-response-validator + response-validator? + validate-response + validation-result? + validation-result-tool-calls + validation-result-nudge + validation-result-needs-retry?) + +(import :jcode/guardrails/rescue + :jcode/guardrails/nudge + :jcode/core/message) + +;; Private carriers; public API uses the wrappers below (same convention +;; as message.ss's tool-call-data and error-tracker.ss's etracker). +(defstruct rvalidator (tool-names rescue-enabled?)) +(defstruct vresult (tool-calls nudge needs-retry?)) + +;; tool-names: list of valid tool-name strings. +;; opt: optional rescue-enabled? boolean (default #t) — when #t, attempt to +;; parse a tool call out of plain text before falling back to a retry nudge. +(def (make-response-validator tool-names . opt) + (let ((rescue-enabled? (if (pair? opt) (car opt) #t))) + (make-rvalidator tool-names rescue-enabled?))) + +(def (response-validator? x) (rvalidator? x)) + +(def (validation-result? x) (vresult? x)) +(def (validation-result-tool-calls v) (vresult-tool-calls v)) +(def (validation-result-nudge v) (vresult-nudge v)) +(def (validation-result-needs-retry? v) (vresult-needs-retry? v)) + +;; Validate an LLM response. +;; content — assistant text (string or #f) +;; tool-calls — list of jcode tool-call-data (possibly empty) +;; Returns a validation-result: exactly one of tool-calls / nudge is set. +(def (validate-response v content tool-calls) + (cond + ;; list[ToolCall] branch: structured calls present — reject unknown names. + ((pair? tool-calls) + (let* ((names (rvalidator-tool-names v)) + (unknown (filter (lambda (tc) (not (member (tool-call-name tc) names))) + tool-calls))) + (if (pair? unknown) + (make-vresult #f + (make-unknown-tool-nudge (tool-call-name (car unknown)) names) + #t) + (make-vresult tool-calls #f #f)))) + ;; TextResponse branch: rescue, then retry nudge. + (else + (let* ((text (or content "")) + (rescued (and (rvalidator-rescue-enabled? v) + (rescue-tool-call text (rvalidator-tool-names v))))) + (if (pair? rescued) + (make-vresult rescued #f #f) + (make-vresult #f (make-retry-nudge text) #t)))))) --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -271,11 +271,22 @@ EXAMPLES: (loop next (cons (string-append (substring line 0 (- (string-length line) 1)) "\n") acc))))) (string-join (reverse (cons line acc)) "")))))) +(def (forge-print-status) + (printf "Forge guardrails (always-on for all providers):~n") + (printf " rescue parse tool calls from text (json/rehearsal/qwen/mistral)~n") + (printf " unknown-tool nudge + retry when the model names a tool that doesn't exist~n") + (printf " retry budget 3 consecutive bad responses then stop~n") + (printf " respond-forcing ~a~n" + (if (forge-respond-enforced?) + "ON (bare text retried as a tool call)" + "OFF (bare text is a normal final answer)")) + (printf "Toggle with /forge on | /forge off~n")) + (def (handle-command input session-id) (let ((cmd (string-trim (substring input 1 (string-length input))))) (cond ((equal? cmd "help") - (display "\nCommands:\n /help Show this help\n /model [name] Show or set model\n /provider [name] Show or set provider\n /plan Switch to PLAN mode (read-only)\n /build Switch to BUILD mode (read+write)\n /mode Show current mode\n /mcp Toggle MCP tools on/off\n /tools List available tools\n /clear Start a new session\n /sessions List saved sessions\n /compact Show message count\n /undo [N] Revert last N checkpoint(s) (default 1)\n /checkpoints List recent shadow-git checkpoints\n /quit Exit\n\nMulti-line: end a line with \\ to continue on the next line.\n\n")) + (display "\nCommands:\n /help Show this help\n /model [name] Show or set model\n /provider [name] Show or set provider\n /plan Switch to PLAN mode (read-only)\n /build Switch to BUILD mode (read+write)\n /mode Show current mode\n /mcp Toggle MCP tools on/off\n /tools List available tools\n /clear Start a new session\n /sessions List saved sessions\n /compact Show message count\n /undo [N] Revert last N checkpoint(s) (default 1)\n /checkpoints List recent shadow-git checkpoints\n /forge [on|off] Show or toggle forge guardrails\n /quit Exit\n\nMulti-line: end a line with \\ to continue on the next line.\n\n")) ((equal? cmd "model") (printf "Provider: ~a~n" (or (current-provider-override) (config-provider))) (printf "Model: ~a~n" (or (current-model-override) (config-model))) @@ -360,6 +371,15 @@ EXAMPLES: (if (null? file-skills) (printf " (none)~n") (for-each (lambda (n) (printf " ~a~n" n)) file-skills)))) + ((or (equal? cmd "forge") (equal? cmd "forge status")) + (forge-print-status)) + ((or (equal? cmd "forge on") (equal? cmd "forge enforce") + (equal? cmd "forge enforce on")) + (forge-respond-enforced? #t) + (printf "Forge respond-forcing: ON (bare text retried as a tool call; respond tool injected).~n")) + ((or (equal? cmd "forge off") (equal? cmd "forge enforce off")) + (forge-respond-enforced? #f) + (printf "Forge respond-forcing: OFF (bare text is a normal final answer).~n")) (#t ;; Slash dispatch: builtins win over file-based skills. (let* ((space-pos (string-index cmd #\space)) --- a/test/run.ss +++ b/test/run.ss @@ -11,7 +11,10 @@ (jcode guardrails nudge) (jcode guardrails error-tracker) (jcode guardrails message-type) - (jcode guardrails rescue)) + (jcode guardrails rescue) + (jcode guardrails validator) + (jcode guardrails respond) + (jcode guardrails guardrails)) ;; ── Helpers ────────────────────────────────────────────────────── @@ -441,6 +444,97 @@ (check! "no tool call → empty" (length (rescue-tool-call "Just a normal answer." '("ls" "grep"))) 0) +;; ── guardrails: validator ────────────────────────────────────────── +(section "=== guardrails: validator ===") + +(define v (make-response-validator '("ls" "grep") #t)) + +;; structured valid tool calls pass through +(let ([r (validate-response v #f (list (make-tool-call "ls" "{}")))]) + (check! "validator valid: no retry" (validation-result-needs-retry? r) #f) + (check! "validator valid: tool-calls returned" + (length (validation-result-tool-calls r)) 1)) + +;; unknown tool name -> retry nudge (unknown_tool kind) +(let ([r (validate-response v #f (list (make-tool-call "nope" "{}")))]) + (check! "validator unknown: needs retry" (validation-result-needs-retry? r) #t) + (check! "validator unknown: no tool-calls" (validation-result-tool-calls r) #f) + (check! "validator unknown: nudge kind" + (nudge-kind (validation-result-nudge r)) "unknown_tool")) + +;; bare text that contains a rescuable call -> recovered, no retry +(let ([r (validate-response v "{\"tool\":\"grep\",\"args\":{\"pattern\":\"x\"}}" '())]) + (check! "validator rescue: no retry" (validation-result-needs-retry? r) #f) + (check! "validator rescue: name" + (tool-call-name (car (validation-result-tool-calls r))) "grep")) + +;; bare prose -> retry nudge (retry kind) +(let ([r (validate-response v "I think the answer is 42." '())]) + (check! "validator prose: needs retry" (validation-result-needs-retry? r) #t) + (check! "validator prose: nudge kind" + (nudge-kind (validation-result-nudge r)) "retry")) + +;; rescue disabled -> a rescuable bare text still retries +(let* ([v2 (make-response-validator '("grep") #f)] + [r (validate-response v2 "{\"tool\":\"grep\",\"args\":{}}" '())]) + (check! "validator rescue-disabled: needs retry" (validation-result-needs-retry? r) #t)) + +;; ── guardrails: respond ──────────────────────────────────────────── +(section "=== guardrails: respond ===") + +(check! "respond tool name" respond-tool-name "respond") +(check-pred! "respond description non-empty" respond-description + (lambda (s) (> (string-length s) 0))) + +(let ([rc (make-tool-call "respond" "{\"message\":\"all done\"}")] + [other (make-tool-call "ls" "{}")] + [empty (make-tool-call "respond" "{}")]) + (check! "respond-call? yes" (respond-call? rc) #t) + (check! "respond-call? no" (respond-call? other) #f) + (check! "respond-call->text extracts message" (respond-call->text rc) "all done") + (check! "respond-call->text missing arg -> empty" (respond-call->text empty) "") + (check! "respond-call->text on non-respond -> #f" (respond-call->text other) #f)) + +;; ── guardrails: facade ───────────────────────────────────────────── +(section "=== guardrails: facade ===") + +;; execute path: valid structured calls +(let* ([g (make-guardrails '("ls" "grep"))] + [cr (guardrails-check g #f (list (make-tool-call "ls" "{}")))]) + (check! "facade execute action" (check-result-action cr) "execute") + (check! "facade execute returns calls" + (length (check-result-tool-calls cr)) 1)) + +;; retry path: unknown tool, within budget +(let* ([g (make-guardrails '("ls") 3 2 #t)] + [cr (guardrails-check g #f (list (make-tool-call "nope" "{}")))]) + (check! "facade retry action" (check-result-action cr) "retry") + (check-pred! "facade retry nudge present" (check-result-nudge cr) + (lambda (n) (and n #t)))) + +;; fatal path: budget 1 tolerates one bad response; the second trips it +(let ([g (make-guardrails '("ls") 1 2 #t)]) + (guardrails-check g "prose one" '()) + (let ([cr (guardrails-check g "prose two" '())]) + (check! "facade fatal action" (check-result-action cr) "fatal") + (check-pred! "facade fatal reason" (check-result-reason cr) + (lambda (s) (str-contains? s "consecutive"))))) + +;; a good response resets the retry budget +(let ([g (make-guardrails '("ls") 1 2 #t)]) + (guardrails-check g "prose" '()) + (guardrails-check g #f (list (make-tool-call "ls" "{}"))) + (let ([cr (guardrails-check g "prose again" '())]) + (check! "facade budget resets on success" (check-result-action cr) "retry"))) + +;; record: clean batch returns #f when no terminal tool configured +(let ([g (make-guardrails '("ls"))]) + (check! "facade record no terminal" (guardrails-record g '("ls")) #f)) + +;; record: terminal tool reached returns #t +(let ([g (make-guardrails '("ls" "respond") 3 2 #t '("respond"))]) + (check! "facade record terminal reached" (guardrails-record g '("respond")) #t)) + ;; ── Results ─────────────────────────────────────────────────────── (printf "~n~a passed, ~a failed~n" pass-count fail-count)