grok-auth: new ~/.grok session-token reader (add-grok phase 1)
ober
998d347b66a7345b242e6cbbf5ce4153fc77afc3
new file mode 100644 --- /dev/null +++ b/src/jcode/core/grok-auth.ss @@ -0,0 +1,215 @@ +;;; jcode Grok CLI local-state reader +;;; +;;; The Grok CLI (`grok login`) authenticates via browser/OIDC and stores a +;;; session token under ~/.grok. This module reads that state so the `grok` +;;; provider can reuse an existing login instead of requiring a copied API key. +;;; +;;; SECURITY: never log or trace the token, refresh_token, email, user_id, +;;; principal_id, or team_id. read-grok-json deliberately swallows parse errors +;;; WITHOUT logging the error text, because a JSON parse error message can echo +;;; the malformed file content (which here contains the bearer token). + +(export grok-home + grok-auth-path + grok-models-cache-path + grok-auth-token + grok-auth-expired? + grok-provider-available? + grok-default-model-info + grok-fallback-model-info + grok-model-info-ref + grok-models-cache-models + ;; Pure helpers over already-parsed JSON (hermetic unit tests): + grok-auth-token-from + grok-auth-expired-from? + grok-model-info-from + grok-models-from + iso8601->epoch) + +(import :std/text/json + :std/os/path + :std/misc/string + :jerboa/core + :jerboa/runtime) + +;; ---- Fallback model metadata (used when models_cache.json is absent) ---- +;; Mirrors the observed ~/.grok/models_cache.json grok-build entry. + +(def *grok-default-model* "grok-build") +(def *grok-default-base-url* "https://cli-chat-proxy.grok.com/v1") +(def *grok-default-context-window* 512000) +(def *grok-auth-key-prefix* "https://auth.x.ai::") + +;; ---- Paths ---- + +(def (grok-home) + "~/.grok — the Grok CLI state directory. Read-only; never created here." + (path-join (or (getenv "HOME") ".") ".grok")) + +(def (grok-auth-path) + (path-join (grok-home) "auth.json")) + +(def (grok-models-cache-path) + (path-join (grok-home) "models_cache.json")) + +;; ---- Safe JSON read ---- + +(def (read-grok-json path) + ;; Parse a ~/.grok JSON file, or #f if missing/unparseable. Does NOT log the + ;; error text — auth.json holds the bearer token and a parse error can echo + ;; file content. Callers treat #f as "absent". + (and (file-exists? path) + (guard (e [#t #f]) + (call-with-input-file path read-json)))) + +;; ---- small coercions over JSON values ---- +;; std/text/json decodes JSON null as (void); string?/number? reject it. + +(def (string-or-false v) (and (string? v) v)) +(def (num-or-false v) (and (number? v) v)) + +;; ---- expiry ---- + +(def (iso8601->epoch s) + ;; Parse an ISO-8601 UTC timestamp "YYYY-MM-DDTHH:MM:SS[.frac]Z" to epoch + ;; seconds, or #f if it is not a parseable string. Uses Howard Hinnant's + ;; days-from-civil algorithm (exact integer arithmetic, valid for y>=1970). + (guard (e [#t #f]) + (and (string? s) + (>= (string-length s) 19) + (let ((y (string->number (substring s 0 4))) + (mo (string->number (substring s 5 7))) + (d (string->number (substring s 8 10))) + (h (string->number (substring s 11 13))) + (mi (string->number (substring s 14 16))) + (se (string->number (substring s 17 19)))) + (and y mo d h mi se + (let* ((yy (if (<= mo 2) (- y 1) y)) + (era (quotient yy 400)) + (yoe (- yy (* era 400))) + (doy (+ (quotient (+ (* 153 (+ mo (if (> mo 2) -3 9))) 2) 5) + (- d 1))) + (doe (+ (* yoe 365) (quotient yoe 4) + (- (quotient yoe 100)) doy)) + (days (+ (* era 146097) doe -719468))) + (+ (* days 86400) (* h 3600) (* mi 60) se))))))) + +(def (entry-expired? v) + ;; #t only when expires_at parses AND is at/before now. Conservative: an + ;; unparseable or absent expires_at is treated as NOT expired so we try the + ;; token and let the proxy return 401. + (let ((exp (and (hash-table? v) (iso8601->epoch (hash-get v "expires_at"))))) + (and exp (>= (time-second (current-time)) exp)))) + +;; ---- auth.json parsing ---- + +(def (grok-auth-usable-entries data) + ;; Return the value-hashes that carry a non-empty string "key", preferring + ;; entries whose top-level key starts with https://auth.x.ai:: . If none + ;; match the prefix, fall back to any usable entry. + (let* ((keys (hash-keys data)) + (usable (filter + (lambda (k) + (let ((v (hash-get data k))) + (and (hash-table? v) + (let ((tok (hash-get v "key"))) + (and (string? tok) (> (string-length tok) 0)))))) + keys)) + (preferred (filter (lambda (k) (string-prefix? *grok-auth-key-prefix* k)) + usable))) + (map (lambda (k) (hash-get data k)) + (if (pair? preferred) preferred usable)))) + +(def (grok-auth-entries-from data) + (if (hash-table? data) (grok-auth-usable-entries data) '())) + +(def (grok-auth-token-from data) + ;; Token string or #f. Prefers a non-expired entry; if all are expired, + ;; returns the first usable token anyway (the proxy will 401 on a stale one). + (let ((entries (grok-auth-entries-from data))) + (and (pair? entries) + (hash-get (or (find (lambda (v) (not (entry-expired? v))) entries) + (car entries)) + "key")))) + +(def (grok-auth-expired-from? data) + ;; #t when an auth entry exists but every usable token is expired. + (let ((entries (grok-auth-entries-from data))) + (and (pair? entries) + (not (find (lambda (v) (not (entry-expired? v))) entries))))) + +;; ---- models_cache.json parsing ---- + +(def (info->alist info) + `(("model" . ,(or (string-or-false (hash-get info "model")) *grok-default-model*)) + ("base_url" . ,(or (string-or-false (hash-get info "base_url")) *grok-default-base-url*)) + ("api_backend" . ,(or (string-or-false (hash-get info "api_backend")) "responses")) + ("auth_scheme" . ,(or (string-or-false (hash-get info "auth_scheme")) "bearer")) + ("context_window" . ,(or (num-or-false (hash-get info "context_window")) *grok-default-context-window*)) + ("name" . ,(or (string-or-false (hash-get info "name")) "Grok Build")))) + +(def (grok-model-info-from data model-id) + ;; Look up models.<model-id>.info in a parsed models_cache.json and return an + ;; alist (model base_url api_backend auth_scheme context_window name), or #f. + (and (hash-table? data) + (let ((models (hash-get data "models"))) + (and (hash-table? models) + (let ((entry (hash-get models model-id))) + (and (hash-table? entry) + (let ((info (hash-get entry "info"))) + (and (hash-table? info) (info->alist info))))))))) + +(def (grok-models-from data) + ;; Return ((id . display-name) ...) for every non-hidden model in a parsed + ;; models_cache.json, or '() when absent/empty. + (or (and (hash-table? data) + (let ((models (hash-get data "models"))) + (and (hash-table? models) + (filter-map + (lambda (id) + (let ((entry (hash-get models id))) + (and (hash-table? entry) + (let* ((info (hash-get entry "info")) + (hidden (and (hash-table? info) (hash-get info "hidden"))) + (name (or (and (hash-table? info) + (string-or-false (hash-get info "name"))) + id))) + (and (not (eq? hidden #t)) (cons id name)))))) + (hash-keys models))))) + '())) + +;; ---- public, file-backed API ---- + +(def (grok-auth-token) + (grok-auth-token-from (read-grok-json (grok-auth-path)))) + +(def (grok-auth-expired?) + (grok-auth-expired-from? (read-grok-json (grok-auth-path)))) + +(def (grok-provider-available?) + ;; True when env API key or a usable ~/.grok token exists. Does NOT consult + ;; the encrypted store (that would force a passphrase prompt at startup). + (or (let ((e (getenv "XAI_API_KEY"))) (and e (not (string=? e "")) #t)) + (let ((e (getenv "GROK_CODE_XAI_API_KEY"))) (and e (not (string=? e "")) #t)) + (and (grok-auth-token) #t))) + +(def (grok-fallback-model-info) + `(("model" . ,*grok-default-model*) + ("base_url" . ,*grok-default-base-url*) + ("api_backend" . "responses") + ("auth_scheme" . "bearer") + ("context_window" . ,*grok-default-context-window*) + ("name" . "Grok Build"))) + +(def (grok-default-model-info) + ;; Prefer the cached grok-build metadata; else the hardcoded fallback. + (or (grok-model-info-from (read-grok-json (grok-models-cache-path)) *grok-default-model*) + (grok-fallback-model-info))) + +(def (grok-model-info-ref info key default) + (let ((p (assoc key info))) + (if p (cdr p) default))) + +(def (grok-models-cache-models) + ;; ((id . display) ...) from ~/.grok/models_cache.json, or '() when absent. + (grok-models-from (read-grok-json (grok-models-cache-path)))) --- a/test/run.ss +++ b/test/run.ss @@ -4,6 +4,7 @@ (import (chezscheme) (jcode core log) (jcode core message) + (jcode core grok-auth) (jcode provider provider) (jcode tool registry) (jcode tool file) @@ -625,13 +626,15 @@ (check! "body on+known: temperature" (hashtable-ref body "temperature" #f) 0.6) (check! "body on+known: top_k" (hashtable-ref body "top_k" #f) 20)) -;; 'on + unknown mlx model: legacy LoRA safety net (0.3 / 0.9 / 1.05) +;; 'on + unknown mlx model: mlx safety net (0.6 / 0.95 / top_k 20 / rep 1.1). +;; Raised from the old near-greedy 0.3/1.05 net in 566e65c — see the comment on +;; apply-sampling-to-body! for why (Qwen3 endless-repetition under greedy decode). (let ([body (make-hashtable equal-hash equal?)]) (parameterize ([forge-sampling-policy 'on]) (apply-sampling-to-body! body "jerboa-mlx-lora" "mlx")) - (check! "body on+unknown mlx: temp net" (hashtable-ref body "temperature" #f) 0.3) + (check! "body on+unknown mlx: temp net" (hashtable-ref body "temperature" #f) 0.6) (check! "body on+unknown mlx: rep net" - (hashtable-ref body "repetition_penalty" #f) 1.05)) + (hashtable-ref body "repetition_penalty" #f) 1.1)) ;; 'on + unknown cloud model: nothing applied (no mlx net) (let ([body (make-hashtable equal-hash equal?)]) @@ -651,7 +654,7 @@ (let ([body (make-hashtable equal-hash equal?)]) (parameterize ([forge-sampling-policy 'off]) (apply-sampling-to-body! body "jerboa-mlx-lora" "mlx")) - (check! "body off+mlx: net still fires" (hashtable-ref body "temperature" #f) 0.3)) + (check! "body off+mlx: net still fires" (hashtable-ref body "temperature" #f) 0.6)) ;; ── compaction strategies (Phase 4) ──────────────────────────────── (section "=== compaction strategies ===") @@ -1520,6 +1523,96 @@ (slurp vr-path) "correct")) (guard (e [#t (void)]) (delete-file vr-path))) +;; ── grok-auth ───────────────────────────────────────────────────── +;; Hermetic: drive the pure *-from helpers with JSON parsed from strings +;; (string->json-object yields the same hashtables read-json produces), so no +;; ~/.grok fixture files are needed. + +(section "=== grok-auth ===") + +;; iso8601->epoch: valid → number, ordering preserved, junk → #f. +(check-pred! "iso8601 valid → number" (iso8601->epoch "2026-05-28T02:15:10.5Z") number?) +(check! "iso8601 junk → #f" (iso8601->epoch "not-a-date") #f) +(check! "iso8601 non-string → #f" (iso8601->epoch 12345) #f) +(check! "iso8601 ordering past<future" + (< (iso8601->epoch "2020-01-01T00:00:00Z") + (iso8601->epoch "2026-01-01T00:00:00Z")) + #t) + +;; auth.json: single fresh token. +(let ([d (string->json-object + "{\"https://auth.x.ai::u1\":{\"key\":\"tok-fresh\",\"expires_at\":\"2999-01-01T00:00:00Z\"}}")]) + (check! "grok token: single fresh" (grok-auth-token-from d) "tok-fresh") + (check! "grok expired?: fresh" (grok-auth-expired-from? d) #f)) + +;; auth.json: expired token still returned (proxy will 401), expired? = #t. +(let ([d (string->json-object + "{\"https://auth.x.ai::u1\":{\"key\":\"tok-old\",\"expires_at\":\"2000-01-01T00:00:00Z\"}}")]) + (check! "grok token: expired returned" (grok-auth-token-from d) "tok-old") + (check! "grok expired?: expired" (grok-auth-expired-from? d) #t)) + +;; auth.json: multiple entries → prefer the non-expired one regardless of order. +(let ([d (string->json-object + "{\"https://auth.x.ai::a\":{\"key\":\"tok-old\",\"expires_at\":\"2000-01-01T00:00:00Z\"},\"https://auth.x.ai::b\":{\"key\":\"tok-new\",\"expires_at\":\"2999-01-01T00:00:00Z\"}}")]) + (check! "grok token: prefer non-expired" (grok-auth-token-from d) "tok-new") + (check! "grok expired?: multi has fresh" (grok-auth-expired-from? d) #f)) + +;; auth.json: empty key is unusable; missing file / empty object → #f. +(check! "grok token: empty key → #f" + (grok-auth-token-from (string->json-object "{\"https://auth.x.ai::u1\":{\"key\":\"\"}}")) #f) +(check! "grok token: #f data → #f" (grok-auth-token-from #f) #f) +(check! "grok token: empty object → #f" (grok-auth-token-from (string->json-object "{}")) #f) + +;; auth.json: missing expires_at is conservatively NOT expired. +(let ([d (string->json-object "{\"https://auth.x.ai::u1\":{\"key\":\"tok-x\"}}")]) + (check! "grok token: no expires_at returned" (grok-auth-token-from d) "tok-x") + (check! "grok expired?: no expires_at → #f" (grok-auth-expired-from? d) #f)) + +;; auth.json: non-prefixed key still usable as a fallback. +(check! "grok token: non-prefixed fallback" + (grok-auth-token-from (string->json-object "{\"other\":{\"key\":\"tok-fb\"}}")) "tok-fb") + +;; models_cache.json: full grok-build info. +(let ([info (grok-model-info-from + (string->json-object + "{\"models\":{\"grok-build\":{\"info\":{\"model\":\"grok-build\",\"base_url\":\"https://cli-chat-proxy.grok.com/v1\",\"name\":\"Grok Build\",\"api_backend\":\"responses\",\"auth_scheme\":\"bearer\",\"context_window\":512000}}}}") + "grok-build")]) + (check! "grok info base_url" (grok-model-info-ref info "base_url" #f) "https://cli-chat-proxy.grok.com/v1") + (check! "grok info api_backend" (grok-model-info-ref info "api_backend" #f) "responses") + (check! "grok info auth_scheme" (grok-model-info-ref info "auth_scheme" #f) "bearer") + (check! "grok info context_window" (grok-model-info-ref info "context_window" #f) 512000) + (check! "grok info name" (grok-model-info-ref info "name" #f) "Grok Build")) + +;; models_cache.json: missing fields fall back to hardcoded defaults. +(let ([info (grok-model-info-from + (string->json-object "{\"models\":{\"grok-build\":{\"info\":{}}}}") "grok-build")]) + (check! "grok info ctx fallback" (grok-model-info-ref info "context_window" #f) 512000) + (check! "grok info backend fallback" (grok-model-info-ref info "api_backend" #f) "responses") + (check! "grok info base_url fallback" (grok-model-info-ref info "base_url" #f) "https://cli-chat-proxy.grok.com/v1")) + +(check! "grok info: missing model → #f" + (grok-model-info-from (string->json-object "{\"models\":{}}") "grok-build") #f) +(check! "grok info: #f data → #f" (grok-model-info-from #f "grok-build") #f) + +;; The hardcoded fallback matches the observed grok-build metadata. +(let ([fb (grok-fallback-model-info)]) + (check! "grok fallback base_url" (grok-model-info-ref fb "base_url" #f) "https://cli-chat-proxy.grok.com/v1") + (check! "grok fallback api_backend" (grok-model-info-ref fb "api_backend" #f) "responses") + (check! "grok fallback context_window" (grok-model-info-ref fb "context_window" #f) 512000)) + +;; models_cache.json → (id . display) list; hidden models excluded; absent → (). +(check! "grok models-from list" + (grok-models-from + (string->json-object + "{\"models\":{\"grok-build\":{\"info\":{\"name\":\"Grok Build\"}}}}")) + '(("grok-build" . "Grok Build"))) +(check! "grok models-from hides hidden" + (grok-models-from + (string->json-object + "{\"models\":{\"grok-build\":{\"info\":{\"name\":\"Grok Build\"}},\"sekret\":{\"info\":{\"name\":\"Sekret\",\"hidden\":true}}}}")) + '(("grok-build" . "Grok Build"))) +(check! "grok models-from #f → ()" (grok-models-from #f) '()) + ;; ── Results ─────────────────────────────────────────────────────── (printf "~n~a passed, ~a failed~n" pass-count fail-count)