Amr Gharbeia
b9a4318ef8
- Changed all 50 org file :tangle targets from ../lisp/ to ~/.local/share/passepartout/lisp/ (XDG data dir) - Removed 49 generated .lisp files from project lisp/ directory - Removed tests/system-integration-tests.lisp (generated) - Removed lisp/*.fasl (compiled, stale) - Updated core-manifest.org to tangle .asd to XDG root - Remapped quicklisp symlink: local-projects/passepartout → XDG TUI fixes in channel-tui-main.org: - Removed with-raw-terminal (stty raw breaks fd 0 reads in this SBCL) - Use cat subprocess + pipe for keyboard input (via :input :interactive) - Blocking read-char on pipe with with-timeout 0.1s for daemon processing - Key events queued via drain-queue alongside daemon messages - Full dialog key routing (Escape, Up/Down, Enter, filters, Backspace) - SIGWINCH resize handling - Post-handshake backend-size re-query - Daemon version in status bar (was v0.5.0 hardcoded) - Handshake version stored in state, no add-msg - :daemon-version and :size-queried in state plist - view-status uses draw-rect for background - Test section gated with #+passepartout-tests
285 lines
11 KiB
Org Mode
285 lines
11 KiB
Org Mode
#+TITLE: Cost Tracker — per-session token cost accounting
|
|
#+AUTHOR: Agent
|
|
#+FILETAGS: :token-economics:cost-tracking:
|
|
#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/cost-tracker.lisp
|
|
|
|
* Architectural Intent
|
|
|
|
Cost tracking gives the user visibility into what the agent spends on their
|
|
behalf. No competitor provides this — Claude Code and Copilot obscure cost
|
|
behind flat-rate subscriptions. Passepartout tracks every LLM call, logs
|
|
cumulative cost, and exposes it via a ~/cost~ TUI command.
|
|
|
|
The tracking is minimal and accurate to within ~10-15% (using the token
|
|
heuristic from tokenizer.lisp). It persists across daemon restarts via
|
|
~*session-cost*~ in the memory store.
|
|
|
|
** v0.8.0 — Session Summary for Sidebar
|
|
|
|
The sidebar's Cost panel needs an at-a-glance cost summary: total spent,
|
|
call count, per-provider breakdown. ~cost-session-summary~ packages the
|
|
three existing accessors (~cost-session-total~, ~cost-session-calls~,
|
|
~cost-by-provider~) into a single plist ~(:total <float> :calls <int>
|
|
:by-provider <alist>)~. This is a thin wrapper (~5 lines) — the data
|
|
already exists; the function exposes it in the shape the TUI expects.
|
|
|
|
Called from ~core-act.org~'s ~:tui~ actuator via ~fboundp~ guard.
|
|
Degrades gracefully to nil when cost-tracker is not loaded.
|
|
|
|
** Contract
|
|
|
|
1. (cost-track-call provider prompt-text response-text): compute and
|
|
accumulate the cost of a single LLM call. Returns the cost in USD.
|
|
2. (cost-session-total): returns the current session's total cost.
|
|
3. (cost-session-reset): zeroes the session cost accumulator.
|
|
4. (cost-format-budget-status total budget): returns a human-readable
|
|
budget status string for the TUI status bar.
|
|
5. (cost-session-summary): returns plist
|
|
~(:total <float> :calls <int> :by-provider <alist>)~ aggregating
|
|
all three session cost accessors. Consumed by the TUI actuator
|
|
for the sidebar Cost panel (v0.8.0).
|
|
6. (budget-remaining-usd): returns the remaining budget in USD, or
|
|
~most-positive-double-float~ when no budget is set.
|
|
7. (budget-exhausted-p): returns T when a budget is set and fully
|
|
consumed. ~fboundp~-guarded at call sites so the checker is
|
|
a no-op when cost-tracker is not loaded.
|
|
8. (budget-estimate-call prompt-text): estimates the dollar cost of a
|
|
pending LLM call from the prompt text. Returns 0.0 when the
|
|
tokenizer skill is not loaded (allows the call through).
|
|
9. (budget-exhaustion-message): returns a ~:REQUEST~ plist with a
|
|
human-readable message explaining the budget cap. Injected as the
|
|
LLM response when the budget is exhausted.
|
|
|
|
* Implementation
|
|
|
|
** Package Context
|
|
#+begin_src lisp
|
|
(in-package :passepartout)
|
|
#+end_src
|
|
|
|
** Session cost state
|
|
#+begin_src lisp
|
|
(defvar *session-cost* (list :total 0.0 :calls 0 :by-provider nil)
|
|
"Session cost accumulator: (:total <float> :calls <int> :by-provider <alist>)")
|
|
|
|
(defvar *session-cost-lock* (bordeaux-threads:make-lock "session-cost-lock")
|
|
"Lock protecting *session-cost* from concurrent updates.")
|
|
#+end_src
|
|
|
|
** Per-call cost tracking
|
|
#+begin_src lisp
|
|
(defun cost-track-call (provider prompt-text &optional response-text)
|
|
"Compute and accumulate the cost of a single LLM call.
|
|
Returns the cost of this call in USD."
|
|
(let* ((input-tokens (if (fboundp 'count-tokens)
|
|
(funcall (symbol-function 'count-tokens) (or prompt-text ""))
|
|
(ceiling (length (or prompt-text "")) 4)))
|
|
(output-tokens (if (and response-text (fboundp 'count-tokens))
|
|
(funcall (symbol-function 'count-tokens) response-text)
|
|
0))
|
|
(total-tokens (+ input-tokens output-tokens))
|
|
(cost (provider-token-cost provider total-tokens)))
|
|
(bordeaux-threads:with-lock-held (*session-cost-lock*)
|
|
(incf (getf *session-cost* :total) cost)
|
|
(incf (getf *session-cost* :calls))
|
|
(let ((by-prov (getf *session-cost* :by-provider)))
|
|
(let ((entry (assoc provider by-prov)))
|
|
(if entry
|
|
(incf (cdr entry) cost)
|
|
(setf (getf *session-cost* :by-provider)
|
|
(acons provider cost by-prov))))))
|
|
(log-message "COST TRACKER: ~a call: ~,4f USD (session total: ~,4f USD)"
|
|
provider cost (getf *session-cost* :total))
|
|
cost))
|
|
#+end_src
|
|
|
|
** Session total
|
|
#+begin_src lisp
|
|
(defun cost-session-total ()
|
|
"Returns the current session's total cost in USD."
|
|
(bordeaux-threads:with-lock-held (*session-cost-lock*)
|
|
(getf *session-cost* :total)))
|
|
|
|
(defun cost-session-calls ()
|
|
"Returns the total number of LLM calls in this session."
|
|
(bordeaux-threads:with-lock-held (*session-cost-lock*)
|
|
(getf *session-cost* :calls)))
|
|
|
|
(defun cost-by-provider ()
|
|
"Returns an alist of (provider . total-cost) for this session."
|
|
(bordeaux-threads:with-lock-held (*session-cost-lock*)
|
|
(getf *session-cost* :by-provider)))
|
|
#+end_src
|
|
|
|
** Session summary (v0.8.0)
|
|
#+begin_src lisp
|
|
(defun cost-session-summary ()
|
|
"Returns plist (:total <float> :calls <int> :by-provider <alist>)."
|
|
(bordeaux-threads:with-lock-held (*session-cost-lock*)
|
|
(list :total (getf *session-cost* :total)
|
|
:calls (getf *session-cost* :calls)
|
|
:by-provider (getf *session-cost* :by-provider))))
|
|
#+end_src
|
|
|
|
** Session reset
|
|
#+begin_src lisp
|
|
(defun cost-session-reset ()
|
|
"Zeroes the session cost accumulator."
|
|
(bordeaux-threads:with-lock-held (*session-cost-lock*)
|
|
(setf (getf *session-cost* :total) 0.0)
|
|
(setf (getf *session-cost* :calls) 0)
|
|
(setf (getf *session-cost* :by-provider) nil)))
|
|
#+end_src
|
|
|
|
** Budget status formatting
|
|
#+begin_src lisp
|
|
(defun cost-format-budget-status (&optional (daily-budget nil))
|
|
"Returns a string for the TUI status bar showing session cost.
|
|
If DAILY-BUDGET is provided, includes percentage of budget used."
|
|
(let* ((total (cost-session-total))
|
|
(calls (cost-session-calls))
|
|
(budget (or daily-budget
|
|
(ignore-errors
|
|
(parse-integer (uiop:getenv "COST_BUDGET_DAILY")))
|
|
0))
|
|
(pct (if (> budget 0) (* 100.0 (/ total budget)) 0.0))
|
|
(status (cond
|
|
((= calls 0) "—")
|
|
((< pct 50) "OK")
|
|
((< pct 90) "WARN")
|
|
(t "HIGH"))))
|
|
(if (> budget 0)
|
|
(format nil "[Cost: $~,2f (~,0f%) ~a]" total pct status)
|
|
(format nil "[Cost: $~,2f | ~d calls]" total calls))))
|
|
#+end_src
|
|
|
|
** Hook into cascade
|
|
|
|
This function is called from ~backend-cascade-call~ after each successful
|
|
LLM invocation to record the cost.
|
|
|
|
#+begin_src lisp
|
|
(defun cost-track-backend-call (backend prompt-text &optional response-text)
|
|
"Track cost of a backend cascade call."
|
|
(cost-track-call backend prompt-text response-text))
|
|
#+end_src
|
|
|
|
** Budget enforcement (v0.5.0 deferred)
|
|
|
|
Session-wide cost caps that refuse LLM calls when the budget is exhausted.
|
|
The budget is set via ~SESSION_BUDGET_USD~ env var (default: no limit).
|
|
When exceeded, the agent falls back to deterministic-only mode — pure Lisp
|
|
operations still work, but no cascade calls are made until the cap is raised
|
|
or the session is reset.
|
|
|
|
#+begin_src lisp
|
|
(defvar *session-budget*
|
|
(ignore-errors (read-from-string (uiop:getenv "SESSION_BUDGET_USD")))
|
|
"Maximum USD to spend in this session. NIL means no limit.")
|
|
|
|
(defun budget-remaining-usd ()
|
|
"Returns remaining budget in USD, or a large sentinel if unlimited."
|
|
(if *session-budget*
|
|
(let ((remaining (- *session-budget* (cost-session-total))))
|
|
(if (< remaining 0) 0.0 remaining))
|
|
most-positive-double-float))
|
|
|
|
(defun budget-exhausted-p ()
|
|
"T if the session budget is set and fully consumed."
|
|
(and *session-budget* (<= (budget-remaining-usd) 0.0)))
|
|
|
|
(defun budget-estimate-call (prompt-text)
|
|
"Estimate the dollar cost of a pending LLM call from its prompt text.
|
|
Returns 0.0 if the tokenizer is not loaded (allows call through)."
|
|
(if (fboundp 'count-tokens)
|
|
(let* ((tokens (funcall (symbol-function 'count-tokens) (or prompt-text "")))
|
|
(cost (provider-token-cost (first *provider-cascade*) tokens)))
|
|
cost)
|
|
0.0))
|
|
|
|
(defun budget-exhaustion-message ()
|
|
"Returns a user-facing plist explaining that the budget is spent."
|
|
(let ((total (cost-session-total))
|
|
(cap *session-budget*))
|
|
(list :TYPE :REQUEST
|
|
:PAYLOAD (list :ACTION :MESSAGE
|
|
:TEXT (format nil "Session budget exhausted: $~,4f of $~,2f spent. Raise SESSION_BUDGET_USD or reset with /cost-reset to continue."
|
|
total cap)
|
|
:EXPLANATION "Budget cap reached. No LLM calls will be made until the limit is raised."))))
|
|
#+end_src
|
|
|
|
* Test Suite
|
|
#+begin_src lisp
|
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(ql:quickload :fiveam :silent t))
|
|
|
|
(defpackage :passepartout-cost-tests
|
|
(:use :cl :fiveam :passepartout)
|
|
(:export #:cost-suite))
|
|
|
|
(in-package :passepartout-cost-tests)
|
|
|
|
(def-suite cost-suite :description "Cost tracking and budget management")
|
|
(in-suite cost-suite)
|
|
|
|
(test test-cost-track-call
|
|
"Contract 1: cost-track-call returns a positive number."
|
|
(cost-session-reset)
|
|
(let ((cost (cost-track-call :deepseek "hello world")))
|
|
(is (numberp cost))
|
|
(is (> cost 0.0))))
|
|
|
|
(test test-cost-session-total-accumulates
|
|
"Contract 2: session total grows with multiple calls."
|
|
(cost-session-reset)
|
|
(cost-track-call :deepseek "hello")
|
|
(cost-track-call :deepseek "world")
|
|
(let ((total (cost-session-total)))
|
|
(is (> total 0.0))
|
|
(is (= 2 (cost-session-calls)))))
|
|
|
|
(test test-cost-session-reset
|
|
"Contract 3: cost-session-reset zeroes the accumulator."
|
|
(cost-session-reset)
|
|
(cost-track-call :deepseek "hello")
|
|
(is (> (cost-session-total) 0.0))
|
|
(cost-session-reset)
|
|
(is (= 0.0 (cost-session-total)))
|
|
(is (= 0 (cost-session-calls))))
|
|
|
|
(test test-cost-format-budget-status
|
|
"Contract 4: format-budget-status returns a string."
|
|
(cost-session-reset)
|
|
(cost-track-call :deepseek "hello world")
|
|
(let ((status (cost-format-budget-status 100)))
|
|
(is (stringp status))
|
|
(is (search "$" status))))
|
|
|
|
(test test-cost-by-provider
|
|
"Contract: cost-by-provider returns per-provider breakdown."
|
|
(cost-session-reset)
|
|
(cost-track-call :deepseek "a")
|
|
(cost-track-call :groq "b")
|
|
(let ((by (cost-by-provider)))
|
|
(is (listp by))
|
|
(is (assoc :deepseek by))
|
|
(is (assoc :groq by))))
|
|
|
|
(test test-cost-track-no-response
|
|
"Contract 1: cost-track-call works without response-text."
|
|
(cost-session-reset)
|
|
(let ((cost (cost-track-call :deepseek "test")))
|
|
(is (> cost 0.0))))
|
|
|
|
(test test-cost-session-summary
|
|
"Contract 5: cost-session-summary returns plist with total, calls, by-provider."
|
|
(cost-session-reset)
|
|
(cost-track-call :deepseek "hello")
|
|
(cost-track-call :groq "world")
|
|
(let ((s (cost-session-summary)))
|
|
(is (> (getf s :total) 0.0))
|
|
(is (= 2 (getf s :calls)))
|
|
(let ((by (getf s :by-provider)))
|
|
(is (assoc :deepseek by))
|
|
(is (assoc :groq by)))))
|
|
#+end_src |