--- /dev/null
+;; Copyright (c) 2026 Jakub Czajka <jakub@ekhem.eu.org>
+;; 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)))
--- /dev/null
+;;; Copyright (c) 2026 Jakub Czajka <jakub@ekhem.eu.org>
+;;; 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))))
#: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)
#: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))
(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
(define vm
(virtual-machine (operating-system
%vps-test-os)
+ (memory-size 512)
(port-forwardings '((2222 . 72)))))
(define test
claude-code-test-cases
paseo-test-cases
dotfiles-test-cases
+ claude-proxy-test-cases
home-activation-test-cases)))))
#: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
(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)
projects / guix.git / commitdiff