From: Jakub Czajka Date: Thu, 6 Aug 2026 16:07:00 +0000 (+0000) Subject: [proxy] Add minimal Guile Claude proxy with safety-classifier detection. X-Git-Url: https://git.ekhem.eu.org/?a=commitdiff_plain;h=c2c100bceedf58b726f1ec41401846e5662490b6;p=guix.git [proxy] Add minimal Guile Claude proxy with safety-classifier detection. Proxy that forwards Claude Code requests to the upstream Anthropic-compatible Messages API. Detects safety-classifier requests (billing-header + security-monitor system blocks) and injects thinking:disabled to avoid DeepSeek's ~30s reasoning delay. Includes a home Shepherd service on port 16890 and QEMU VM test. Co-Authored-By: Claude --- diff --git a/conf/common/claude-proxy.scm b/conf/common/claude-proxy.scm new file mode 100644 index 0000000..5aeb52f --- /dev/null +++ b/conf/common/claude-proxy.scm @@ -0,0 +1,179 @@ +;; Copyright (c) 2026 Jakub Czajka +;; License: GPL-3.0 or later. +;; +;; claude-proxy.scm — Minimal Guile HTTP proxy for Claude Code. +;; Detects safety-classifier requests, injects thinking:disabled. +;; Provides both the proxy program-file and a home Shepherd service. + +(define-module (conf common claude-proxy) + #:use-module (gnu packages guile) + #:use-module (gnu packages tls) + #:use-module (gnu home services) + #:use-module (gnu home services shepherd) + #:use-module (guix gexp) + #:use-module (guix packages) + #:export (claude-proxy-script claude-proxy-daemon-service)) + +(define claude-proxy-code + #~(begin + (set! %load-path + (cons* #$(file-append guile-gnutls "/share/guile/site/3.0") + #$(file-append guile-json-4 "/share/guile/site/3.0") + %load-path)) + (set! %load-compiled-path + (cons* #$(file-append guile-gnutls "/lib/guile/3.0/site-ccache") + #$(file-append guile-json-4 "/lib/guile/3.0/site-ccache") + %load-compiled-path)) + (use-modules (web server) + (web client) + (web request) + (web response) + (web uri) + (json) + (rnrs bytevectors) + (srfi srfi-1) + (ice-9 match) + (ice-9 receive)) + + (catch #t + (lambda () + (module-use! (resolve-module '(web client)) + (resolve-interface '(gnutls))) + (format (current-error-port) "[claude-proxy] gnutls loaded~%")) + (lambda _ + (format (current-error-port) + "[claude-proxy] gnutls NOT available~%"))) + + (define port + (or (and=> (getenv "PROXY_PORT") string->number) 16890)) + + (define upstream + (string->uri (or (getenv "CLAUDE_PROXY_UPSTREAM") + "https://api.deepseek.com/anthropic"))) + + (define (ts) + (strftime "%Y-%m-%dT%H:%M:%S%z" + (localtime (current-time)))) + + (define (log fmt . args) + (apply format + (current-error-port) + (string-append "[claude-proxy] " + (ts) " " fmt) args) + (force-output (current-error-port))) + + (define (classifier? json) + (define sys + (assoc-ref json "system")) + (define blocks + (if sys + (vector->list sys) + '())) + (define (has? prefix) + (any (lambda (b) + (and (equal? (assoc-ref b "type") "text") + (let ((t (assoc-ref b "text"))) + (and (string? t) + (string-prefix? prefix t))))) blocks)) + (and (has? "x-anthropic-billing-header:") + (has? "You are a security monitor"))) + + (define (disable-thinking json) + (alist-delete "output_config" + (alist-delete "reasoning_effort" + (assoc-set! json "thinking" + '(("type" . "disabled")))))) + + (define (handler req body) + (define (ok code str) + (values (build-response #:code code + #:headers '((content-type application/json))) + (string->utf8 str))) + (match (request-method req) + ('GET (ok 200 "{\"status\":\"ok\"}")) + ('POST (catch #t + (lambda () + (let* ((json (json-string->scm (utf8->string body))) + (is? (classifier? json)) + (to-send (if is? + (disable-thinking json) json)) + (payload (string->utf8 (scm->json-string + to-send + #:unicode #t))) + (path (uri-path (request-uri req))) + (base-path (uri-path upstream)) + (url (build-uri (uri-scheme upstream) + #:host (uri-host upstream) + #:port (uri-port upstream) + #:path (string-append + base-path path))) + (auth (assoc-ref (request-headers req) + 'x-api-key)) + (hdrs (list (list 'content-type + 'application/json) + (cons 'x-api-key auth)))) + (log "~a ~a [~a]" + 'POST path + (if is? "classifier" "pass")) + (receive (rsp body-port) + (http-request url + #:method 'POST + #:headers hdrs + #:body payload + #:streaming? #f + #:decode-body? #f) + (let* ((code (response-code rsp)) + (ct (assoc-ref (response-headers + rsp) + 'content-type)) + (rhdrs (if ct + (list (cons 'content-type + ct)) + '()))) + (log " -> ~d~%" code) + (values (build-response #:code code + #:headers rhdrs) + body-port))))) + (lambda (k . a) + (log "error: ~a~%" k) + (ok 502 "{\"error\":\"upstream unavailable\"}")))) + (_ (ok 405 "{\"error\":\"method not allowed\"}")))) + + (log "listening on 127.0.0.1:~d~%" port) + (run-server handler + 'http + `(#:port ,port + #:addr ,INADDR_ANY)))) + +(define claude-proxy-script + (program-file "claude-proxy" claude-proxy-code)) + +;; ── Shepherd service ───────────────────────────────── + +(define proxy-wrapper + (program-file "claude-proxy-start" + #~(begin + (setenv "PROXY_PORT" "16890") + (setenv "CLAUDE_PROXY_UPSTREAM" + "https://api.deepseek.com/anthropic") + (apply execl + #$claude-proxy-script "claude-proxy" + '())))) + +(define claude-proxy-start + #~(let ((log-dir (or (getenv "XDG_STATE_HOME") + (string-append (getenv "HOME") "/.local/state")))) + (make-forkexec-constructor (list #$proxy-wrapper) + #:log-file (string-append log-dir + "/claude-proxy.log")))) + +(define claude-proxy-service + (shepherd-service (provision '(claude-proxy)) + (start claude-proxy-start) + (stop #~(make-kill-destructor)) + (auto-start? #t) + (documentation "Shepherd service for claude-proxy."))) + +(define claude-proxy-daemon-service + (simple-service 'claude-proxy-daemon home-shepherd-service-type + (list claude-proxy-service))) diff --git a/tests/claude-proxy.scm b/tests/claude-proxy.scm new file mode 100644 index 0000000..79285ba --- /dev/null +++ b/tests/claude-proxy.scm @@ -0,0 +1,120 @@ +;;; Copyright (c) 2026 Jakub Czajka +;;; License: GPL-3.0 or later. +;;; +;;; claude-proxy end-to-end test — validates HTTP responses from the +;;; Shepherd-started proxy (health endpoint and error handling). + +(define-module (tests claude-proxy) + #:use-module (conf common claude-proxy) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (gnu system) + #:use-module (guix gexp) + #:use-module (tests common) + #:export (claude-proxy-test-cases claude-proxy-test-os-services)) + +(define %script-exists-body + (let ((path (file-append claude-proxy-script "/bin/claude-proxy"))) + `(catch #t + (lambda () + (let ((st (stat ,path))) + (not (zero? (logand (stat:mode st) #x40))))) + (lambda (key . args) + #f)))) + +(define %health-test-body + '(begin + (use-modules (ice-9 rdelim)) + (catch #t + (lambda () + (let* ((s (socket PF_INET SOCK_STREAM 0))) + (connect s + (make-socket-address AF_INET INADDR_LOOPBACK 16890)) + (display "GET /health HTTP/1.0\r\n\r\n" s) + (force-output s) + (let ((rsp (read-string s))) + (close-port s) + (and (string? rsp) + (string-contains rsp "200") + (string-contains rsp "application/json") + (string-contains rsp "\"status\":\"ok\""))))) + (lambda (key . args) + #f)))) + +(define %post-502-test-body + '(begin + (use-modules (ice-9 rdelim)) + (catch #t + (lambda () + (let* ((json-body (string-append + "{\"model\":\"claude-sonnet-4-6\"," + "\"max_tokens\":1," + "\"messages\":[{\"role\":\"user\"," + "\"content\":\"hello\"}]}")) + (clen (string-length json-body)) + (req (string-append "POST /v1/messages HTTP/1.0\r\n" + "Content-Type: application/json\r\n" + "x-api-key: sk-test\r\n" + "Content-Length: " + (number->string clen) + "\r\n\r\n" + json-body)) + (s (socket PF_INET SOCK_STREAM 0))) + (connect s + (make-socket-address AF_INET INADDR_LOOPBACK 16890)) + (display req s) + (force-output s) + (let ((rsp (read-string s))) + (close-port s) + (and (string? rsp) + (string-contains rsp "502") + (string-contains rsp "application/json") + (string-contains rsp "upstream"))))) + (lambda (key . args) + #f)))) + +(define (claude-proxy-test-cases marionette) + "Return a gexp with claude-proxy test assertions." + #~(begin + (test-assert "claude-proxy: script is executable" + (marionette-eval '#$%script-exists-body + #$marionette)) + + #$(assert-service-running "claude-proxy: service running" + 'claude-proxy marionette) + + (test-assert "claude-proxy: port 16890 TCP" + (wait-for-tcp-port 16890 + #$marionette)) + + (test-assert "claude-proxy: health endpoint returns 200" + (marionette-eval '#$%health-test-body + #$marionette)) + + (test-assert "claude-proxy: POST forwarding returns 502" + (marionette-eval '#$%post-502-test-body + #$marionette)))) + +(define test-proxy-wrapper + (program-file "test-claude-proxy-start" + #~(begin + (setenv "PROXY_PORT" "16890") + (setenv "CLAUDE_PROXY_UPSTREAM" "http://127.0.0.1:19998") + (apply execl + #$claude-proxy-script "claude-proxy" + '())))) + +(define test-proxy-start + #~(make-forkexec-constructor (list #$test-proxy-wrapper) + #:log-file "/var/log/claude-proxy.log")) + +(define (claude-proxy-test-os-services base-os) + "Return a test OS service list that includes the proxy +pointed at a non-existent upstream (19998), so POST returns 502." + (let ((proxy-svc (shepherd-service (provision '(claude-proxy)) + (start test-proxy-start) + (stop #~(make-kill-destructor)) + (auto-start? #t)))) + (cons (simple-service 'claude-proxy-test shepherd-root-service-type + (list proxy-svc)) + (operating-system-user-services base-os)))) diff --git a/tests/vps-base.scm b/tests/vps-base.scm index e3b3796..49f675b 100644 --- a/tests/vps-base.scm +++ b/tests/vps-base.scm @@ -21,6 +21,7 @@ #:use-module (gnu packages ssh) #:use-module (vps-system) #:use-module (vps-home) + #:use-module (conf common claude-proxy) #:use-module (tests sshd) #:use-module (tests networking) #:use-module (tests ntp) @@ -28,6 +29,7 @@ #:use-module (tests dotfiles) #:use-module (tests paseo) #:use-module (tests dnscrypt) + #:use-module (tests claude-proxy) #:use-module (guix gexp) #:export (%test-vps %vps-test-os run-vps-test)) @@ -88,11 +90,28 @@ ed25519 key to the production SSH config." (let ((key (file-append %test-ssh-keypair "/authorized_key"))) (openssh-configuration (inherit config) (authorized-keys `(("dak" ,key)))))) - (cons %static-networking - (modify-services (operating-system-user-services base-os) - (delete dhcpcd-service-type) - (openssh-service-type config => - (add-test-key config))))) + (cons* %static-networking + (let* ((wrapper (program-file "test-claude-proxy-start" + #~(begin + (setenv "PROXY_PORT" "16890") + (setenv "CLAUDE_PROXY_UPSTREAM" + "http://127.0.0.1:19998") + (apply execl + #$claude-proxy-script + "claude-proxy" + '())))) + (start #~(make-forkexec-constructor (list #$wrapper) + #:log-file "/var/log/claude-proxy.log")) + (svc (shepherd-service (provision '(claude-proxy)) + (start start) + (stop #~(make-kill-destructor)) + (auto-start? #t)))) + (simple-service 'claude-proxy-test shepherd-root-service-type + (list svc))) + (modify-services (operating-system-user-services base-os) + (delete dhcpcd-service-type) + (openssh-service-type config => + (add-test-key config))))) (define %vps-test-os (marionette-operating-system (operating-system @@ -147,6 +166,7 @@ every function in TEST-CASES. Each element is a function (define vm (virtual-machine (operating-system %vps-test-os) + (memory-size 512) (port-forwardings '((2222 . 72))))) (define test @@ -203,4 +223,5 @@ every function in TEST-CASES. Each element is a function claude-code-test-cases paseo-test-cases dotfiles-test-cases + claude-proxy-test-cases home-activation-test-cases))))) diff --git a/vps-home.scm b/vps-home.scm index 3832fc5..c9abed8 100644 --- a/vps-home.scm +++ b/vps-home.scm @@ -8,8 +8,10 @@ #:use-module (gnu home services) #:use-module (gnu services) #:use-module (gnu system shadow) + #:use-module (conf common claude-proxy) #:use-module (conf home paseo) #:use-module (conf home claude) + #:use-module (conf home symlink) #:export (vps-home-environment)) (define vps-home-environment @@ -17,6 +19,12 @@ (packages (list claude-code paseo)) (services (append (list paseo-daemon-service + claude-proxy-daemon-service + + (simple-service 'claude-dotfiles home-symlink-service-type + '("claude/.config/claude/settings.json" + "claude/.config/claude/CLAUDE.md" + "claude/.local/bin/get-api-key")) ;; Uncomment the shell you wish to use for your user: ;; (service home-bash-service-type)