From: Jakub Czajka Date: Sun, 6 Sep 2026 12:12:17 +0000 (+0000) Subject: [proxy] Simplify claude-proxy implementation and shrink the file. X-Git-Url: https://git.ekhem.eu.org/?a=commitdiff_plain;h=9dc914c5e078e77e8b3e6a6dfc8876282b772e50;p=guix.git [proxy] Simplify claude-proxy implementation and shrink the file. Replace the proxy-wrapper launch wrapper with with-extensions on the program-file: gexp->script then emits an expansion-time prologue that puts the off-prefix (gnutls) and (json) module directories on the load paths, so the generated script runs with no GUILE_LOAD_PATH plumbing. Read all configuration from the environment in one block at the top of the script body, hoisting the orphan-watchdog interval next to the port, upstream and timeout reads, and document the contract in the header. Fold duplicated idioms without changing behavior: req-log via log, a deadline-ms helper, one select in wait!, flat put-strings in send-simple, a regex chunk-size parser, the abort-message case inside emit-error-frame, an optional-header helper in forward, body-allowed? inlined into serve-one, and the relay close path flattened. Trim docstrings that restate adjacent comments and drop the unused imports (guix packages) and (ice-9 receive). The claude-proxy tests stay green: the full VM suite passes 41/41, covering the deadline and streaming semantics that the rewrite must preserve. Add a make test-vps-live target that rehearses the proxy against the real DeepSeek API: it starts the built proxy pointed at the real upstream, reads the API key from the per-user runtime cache (/run/user/$(id -u)/claude-apikey) and sends one streaming and one non-streaming request. Verified live: both requests return HTTP 200 with real completions and the full event trace. Co-Authored-By: Claude --- diff --git a/Makefile b/Makefile index 752fb1e..dcd683f 100644 --- a/Makefile +++ b/Makefile @@ -83,6 +83,58 @@ test-vps-fresh: build-vps-system build-vps-home GUIX_PACKAGE_PATH=$(CURDIR) guix build -L $(CURDIR) \ -e '(@ (tests vps-base) %test-vps)' +# Live rehearsal of claude-proxy against the real DeepSeek API: +# starts the built proxy pointed at https://api.deepseek.com/anthropic +# and sends one streaming and one non-streaming request through it. +# The API key is read from the per-user runtime cache +# (/run/user/$(id -u)/claude-apikey); without a key the requests +# still exercise the chain and expect relayed 401s. Not hermetic — +# never part of the deterministic suite. +test-vps-live: + @key=""; \ + keyfile="/run/user/$$(id -u)/claude-apikey"; \ + if [ -r "$$keyfile" ] && [ -s "$$keyfile" ]; then \ + key="$$(/run/current-system/profile/bin/tr -d '\n' < "$$keyfile")"; \ + fi; \ + proxy="$$(GUIX_PACKAGE_PATH=$(CURDIR) guix build -L $(CURDIR) \ + -e '(@ (conf common claude-proxy) claude-proxy-script)' \ + 2>/dev/null)"; \ + log="/tmp/claude-proxy-live.log"; \ + rm -f "$$log"; \ + env -u GUILE_LOAD_PATH -u GUILE_LOAD_COMPILED_PATH \ + PROXY_PORT=16998 \ + CLAUDE_PROXY_UPSTREAM=https://api.deepseek.com/anthropic \ + CLAUDE_PROXY_TIMEOUT=60 "$$proxy" > "$$log" 2>&1 & \ + pid=$$!; \ + trap 'kill $$pid 2>/dev/null' EXIT; \ + sleep 1; \ + auth=""; \ + if [ -n "$$key" ]; then auth="x-api-key: $$key"; fi; \ + echo "--- proxy log:"; \ + /run/current-system/profile/bin/cat "$$log"; \ + body='{"stream":false,"model":"deepseek-chat","max_tokens":32,"messages":[{"role":"user","content":"Reply with the single word OK"}]}'; \ + echo "--- non-stream request:"; \ + /home/dak/.guix-profile/bin/curl -sS -m 90 \ + -w '\nHTTP %{http_code} in %{time_total}s\n' \ + http://127.0.0.1:16998/v1/messages \ + -H 'content-type: application/json' \ + $${auth:+-H "$$auth"} \ + -d "$$body" | /run/current-system/profile/bin/head -c 1500; \ + echo; \ + body='{"stream":true,"model":"deepseek-chat","max_tokens":32,"messages":[{"role":"user","content":"Reply with the single word OK"}]}'; \ + echo "--- stream request:"; \ + /home/dak/.guix-profile/bin/curl -sS -N -m 90 \ + -w '\nHTTP %{http_code} in %{time_total}s\n' \ + http://127.0.0.1:16998/v1/messages \ + -H 'content-type: application/json' \ + $${auth:+-H "$$auth"} \ + -d "$$body" | /run/current-system/profile/bin/head -c 2500; \ + echo; \ + echo "--- proxy log events:"; \ + /run/current-system/profile/bin/grep -o 'event=[a-z-]*' "$$log" \ + | /run/current-system/profile/bin/sort \ + | /run/current-system/profile/bin/uniq -c + tags: find $(guix-store) -wholename "*guix-$(guix-version)*.scm" -or \ -wholename "*guix-module-union*.scm" -or \ diff --git a/conf/common/claude-proxy.scm b/conf/common/claude-proxy.scm index e9ad008..68a0939 100644 --- a/conf/common/claude-proxy.scm +++ b/conf/common/claude-proxy.scm @@ -1,14 +1,17 @@ ;; Copyright (c) 2026 Jakub Czajka ;; License: GPL-3.0 or later. ;; -;; claude-proxy.scm — Guile HTTP proxy for Claude Code. -;; Forwards Anthropic-format requests to DeepSeek: injects -;; thinking:disabled on non-streaming requests that do not set a -;; thinking field, streams the upstream response back incrementally, -;; and bounds every network wait with an idle timeout. Logs one -;; line per event with a per-request id so a single request can be -;; traced with grep 'req='. Provides both the proxy -;; program-file and a home Shepherd service. +;; Guile HTTP proxy for Claude Code: forwards Anthropic-format +;; requests to DeepSeek, injects thinking:disabled on non-streaming +;; requests without a thinking field, streams responses back +;; incrementally, and bounds every wait with an idle timeout. Every +;; request logs one line per event, traceable by req=. +;; +;; Reads PROXY_PORT, CLAUDE_PROXY_UPSTREAM, CLAUDE_PROXY_TIMEOUT and +;; CLAUDE_PROXY_WATCHDOG_SECONDS from the environment in the +;; Configuration block at the top of the script body. The +;; program-file wraps the code in with-extensions, putting the +;; off-prefix (gnutls) and (json) modules on the load path. (define-module (conf common claude-proxy) #:use-module (gnu packages guile) @@ -16,15 +19,13 @@ #: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 - ;; The whole script is one top-level (begin ...), so use-modules - ;; here resolves its modules at expansion time. The launching - ;; wrapper therefore sets GUILE_LOAD_PATH and GUILE_LOAD_COMPILED_PATH - ;; to the store directories of the off-path (gnutls) and (json) - ;; modules before exec'ing guile. + ;; One top-level (begin ...): use-modules resolves at expansion + ;; time, after the with-extensions prologue (see + ;; claude-proxy-script) has put (gnutls) and (json) on the load + ;; paths. #~(begin (use-modules (gnutls) (web client) @@ -38,10 +39,9 @@ (ice-9 binary-ports) (ice-9 threads) (ice-9 match) - (ice-9 receive) (ice-9 rdelim) - (srfi srfi-1) - (srfi srfi-13)) + (ice-9 regex) + (srfi srfi-1)) ;; Make the GnuTLS bindings visible to (web client) so its ;; internal TLS helpers (certificate verification) resolve. @@ -69,6 +69,10 @@ (define idle-timeout (or (and=> (getenv "CLAUDE_PROXY_TIMEOUT") string->number) 60)) + ;; Orphan watchdog cadence in seconds. + (define watch-interval + (or (and=> (getenv "CLAUDE_PROXY_WATCHDOG_SECONDS") string->number) 15)) + ;; ── Logging and request ids ───────────────────── (define (log fmt . args) @@ -78,10 +82,8 @@ (force-output (current-error-port))) (define (req-log id fmt . args) - (apply format - (current-error-port) - (string-append "[claude-proxy] req=" id " " fmt "~%") args) - (force-output (current-error-port))) + (apply log + (string-append "req=" id " " fmt) args)) (define (ms-now) (let ((t (gettimeofday))) @@ -132,26 +134,28 @@ deadline passes before any data arrives." 0) (define stage-len 0) + (define (deadline-ms) + (+ (ms-now) + (* timeout-s 1000))) (define (wait! kind deadline-ms) (let ((left (- deadline-ms (ms-now)))) (when (<= left 0) (throw 'claude-proxy-timeout kind)) - (let* ((ready (if (eq? kind - 'read) - (select (list fdes) - '() - '() - (/ left 1000.0)) - (select '() - (list fdes) - '() - (/ left 1000.0)))) + (let* ((read? (eq? kind + 'read)) ;; SELECT returns lists of fds; the single fd shows ;; up in the first list when readable and in the ;; second when writable. - (got (if (eq? kind - 'read) + (ready (select (if read? + (list fdes) + '()) + (if read? + '() + (list fdes)) + '() + (/ left 1000.0))) + (got (if read? (car ready) (cadr ready)))) (if (pair? got) #t @@ -161,11 +165,9 @@ deadline passes before any data arrives." (and session (eq? err error/premature-termination))) (define (tls-again? err) - ;; GnuTLS asks to be called again: it consumed bytes that do - ;; not yet form a complete record (TLS 1.3 post-handshake - ;; messages, a partial record). SELECT cannot see the bytes - ;; GnuTLS already buffered, so on error/again wait for more - ;; and retry instead of reporting an error. + ;; GnuTLS consumed bytes that do not yet form a complete + ;; record; select cannot see them, so wait for more and + ;; retry instead of reporting an error. (and session (eq? err error/again))) (define (fill! deadline-ms) @@ -201,18 +203,15 @@ deadline passes before any data arrives." (bytevector-copy! stage stage-start bv start n) (set! stage-start (+ stage-start n)) n)) - (else (let ((deadline (+ (ms-now) - (* timeout-s 1000)))) - (if (eq? (fill! deadline) - 'eof) 0 - (read! bv start count)))))) + (else (if (eq? (fill! (deadline-ms)) + 'eof) 0 + (read! bv start count))))) (define (send-slice! slice) "Write SLICE, retrying when GnuTLS asks for more time." (let attempt () (wait! 'write - (+ (ms-now) - (* timeout-s 1000))) + (deadline-ms)) (catch 'gnutls-error (lambda () (if session @@ -226,8 +225,7 @@ deadline passes before any data arrives." (let loop ((off 0)) (if (= off count) count - (let* ((left (- (+ start count) - (+ start off))) + (let* ((left (- count off)) (slice (make-bytevector left)) (n (begin (bytevector-copy! bv @@ -251,10 +249,6 @@ deadline passes before any data arrives." ;; ── Upstream connection ───────────────────────── (define (wrap-tls sock host) - "Perform the (web client) tls-wrap handshake over SOCK for -HOST, reusing its certificate-verification helpers, but return the -GnuTLS session so reads can pull whole TLS records via -record-receive!." (define session (make-session connection-end/client)) (if (module-defined? (resolve-interface '(gnutls)) @@ -299,9 +293,8 @@ record-receive!." session) (define (uri-effective-port url) - "The port URL connects to: its explicit port, or the scheme - default when none is written (uri-port returns #f then, and - guile's own (web client) falls back the same way)." + ;; Portless URLs fall back to the scheme default, as guile's + ;; own (web client) does. (or (uri-port url) (match (uri-scheme url) ((or 'http @@ -313,9 +306,8 @@ record-receive!." (_ #f)))) (define (host-header url) - "Return the Host header value for URL as a (host . port) -pair — guile validates Host values in that shape — with the port -when it is not the scheme default." + ;; Host as a (host . port) pair — the shape guile validates — + ;; with the port omitted when it is the scheme default. (let ((p (uri-effective-port url))) (if (or (and (eq? (uri-scheme url) 'https) @@ -327,10 +319,8 @@ when it is not the scheme default." (cons (uri-host url) p)))) (define (open-upstream url) - "Connect to URL (with TLS when https) in a worker thread, -bounded by IDLE-TIMEOUT seconds, and return the deadline-wrapped -port. Throws 'claude-proxy-timeout on expiry or rethrows the -worker's error." + ;; Connect in a worker thread, bounded by IDLE-TIMEOUT; + ;; throws 'claude-proxy-timeout on expiry. (define host (uri-host url)) (define svc @@ -404,12 +394,9 @@ worker's error." (cadr result) (cddr result)))) (begin - ;; The worker may still be blocked in connect(2) or - ;; the TLS handshake; closing the socket bounds the - ;; damage. cancel-thread cannot interrupt C-level - ;; blocking, so the thread may linger until the - ;; kernel gives up — it only publishes a result - ;; nobody reads. + ;; Closing the socket bounds the damage if the worker + ;; is still blocked in connect(2) or the handshake; + ;; cancel-thread cannot interrupt C-level blocking. (cancel-thread worker-thread) (let ((sock (car sock-cell))) (when (port? sock) @@ -420,10 +407,8 @@ worker's error." ;; ── Request rewriting ─────────────────────────── (define (prepare-payload json id) - "Return JSON with thinking disabled on non-streaming -requests that do not set a thinking field themselves. DeepSeek -reasoning models default to thinking on, which stalls non-streaming -calls behind full reasoning time." + ;; DeepSeek reasoning models default to thinking on, which + ;; stalls non-streaming calls behind full reasoning time. (let ((stream? (eq? (assoc-ref json "stream") #t)) (thinking (assoc-ref json "thinking"))) (cond @@ -448,19 +433,18 @@ calls behind full reasoning time." reason content-type body-str) - (let ((body (string->utf8 body-str))) + (let* ((body (string->utf8 body-str)) + (len (bytevector-length body))) + (put-string cp + (format #f "HTTP/1.1 ~d ~a\r\n" code reason)) (put-string cp - (string-append (format #f "HTTP/1.1 ~d ~a\r\n" code - reason) - (format #f "Content-Type: ~a\r\n" - content-type) - (format #f "Content-Length: ~d\r\n" - (bytevector-length body)) - "Connection: close\r\n\r\n")) + (format #f "Content-Type: ~a\r\n" content-type)) + (put-string cp + (format #f "Content-Length: ~d\r\n" len)) + (put-string cp "Connection: close\r\n\r\n") (put-bytevector cp body) (force-output cp) - (req-log id "event=response code=~d bytes=~d ms=~d" code - (bytevector-length body) + (req-log id "event=response code=~d bytes=~d ms=~d" code len (- (ms-now) t0)))) (define (relay id @@ -494,18 +478,9 @@ framing, so each upstream chunk reaches the client as it arrives." #t) (define (parse-chunk-size line) ;; Chunk size is 1*HEXDIG with an optional extension. - (define (hex? c) - (or (char-numeric? c) - (and (char>=? c #\a) - (char<=? c #\f)) - (and (char>=? c #\A) - (char<=? c #\F)))) - (let ((end (or (string-index line - (lambda (c) - (not (hex? c)))) - (string-length line)))) - (if (zero? end) #f - (string->number (substring line 0 end) 16)))) + (let ((m (string-match "^[0-9a-fA-F]+" line))) + (and m + (string->number (match:substring m) 16)))) (put-string cp (string-append "HTTP/1.1 " (number->string status) " " reason "\r\n")) @@ -523,11 +498,9 @@ framing, so each upstream chunk reaches the client as it arrives." (let ((chunked? (equal? version '(1 . 1)))) (define (emit bv count) - "Write COUNT bytes of BV to the client as one chunk -(HTTP/1.1) or raw (HTTP/1.0), then flush CP itself. Chunk framing -is written by hand: make-chunked-output-port cannot relay -incrementally — its flush only moves bytes into CP's conversion -buffer, which is transmitted only when CP is flushed or closed." + ;; One client chunk (HTTP/1.1) or raw (HTTP/1.0), flushed + ;; directly: make-chunked-output-port buffers instead of + ;; relaying incrementally. (when chunked? (put-string cp (string-append (number->string count 16) "\r\n"))) @@ -542,9 +515,7 @@ buffer, which is transmitted only when CP is flushed or closed." (req-log id "event=first-byte ms=~d bytes=~d" (- (ms-now) t0) total))) (define (attempt thunk) - "Run THUNK; a deadline expiry logs a mid-stream timeout, -any other error a mid-stream error. Both abandon the relay with -the reason as the throw argument." + ;; Errors and deadline expiries abandon the relay. (catch #t thunk (lambda (key . args) (cond @@ -564,8 +535,6 @@ the reason as the throw argument." (throw 'relay-abort 'premature-eof)) (define (read-exact! left) - "Read exactly LEFT bytes from UP in buffer-sized slices, -emitting each; an EOF beforehand aborts the relay." (let loop ((left left)) (if (zero? left) @@ -580,8 +549,8 @@ emitting each; an EOF beforehand aborts the relay." (emit buf n) (loop (- left n)))))))) (define (decode-chunked) - "Relay a chunked body one chunk at a time. Exact-count -reads keep chunk data from bleeding into the next chunk header." + ;; Exact-count reads keep chunk data from bleeding into + ;; the next chunk header. (let loop () (let* ((line (attempt (lambda () @@ -631,30 +600,26 @@ reads keep chunk data from bleeding into the next chunk header." (emit chunk (bytevector-length chunk)) (loop)))))))) - (define (abort-message reason) - (case reason - ((claude-proxy-timeout) - "upstream idle timeout") - ((premature-eof) - "upstream connection closed") - ((bad-chunk-size) - "upstream sent invalid chunked framing") - (else "upstream error"))) (define (emit-error-frame reason) - "Terminate an SSE body with the Anthropic-style error -event: a leading newline keeps the frame line-aligned even when the -upstream stalled mid-frame. The body then ends normally, so the -client sees a typed error instead of a truncated stream." - (let* ((frame (string-append + ;; Leading newline keeps the frame line-aligned; the + ;; client sees a typed error, not a truncated stream. + (let* ((msg (case reason + ((claude-proxy-timeout) + "upstream idle timeout") + ((premature-eof) + "upstream connection closed") + ((bad-chunk-size) + "upstream sent invalid chunked framing") + (else "upstream error"))) + (frame (string-append "\nevent: error\ndata: {\"type\":\"error\"," "\"error\":{\"type\":\"api_error\",\"message\":\"" - (abort-message reason) "\"}}\n\n")) + msg "\"}}\n\n")) (b (string->utf8 frame))) (emit b (bytevector-length b)))) (define (try-error-frame reason) - "Emit the typed SSE error frame for REASON, surviving a -client that vanished mid-abort. Returns #t on success." + ;; Survive a client that vanished mid-abort. (catch #t (lambda () (emit-error-frame reason) #t) @@ -680,18 +645,15 @@ client that vanished mid-abort. Returns #t on success." ;; else keeps the hard truncation. (if sse? (try-error-frame reason) #f))))) - (if clean? - ;; Clean end: HTTP/1.1 bodies close with the final - ;; zero chunk; HTTP/1.0 clients end at the close. - (if chunked? - (begin - (false-if-exception (put-string cp "0\r\n\r\n")) - (force-output cp) - (false-if-exception (close-port cp))) - (false-if-exception (close-port cp))) - ;; Non-SSE abort: close without the terminating chunk - ;; so the client sees an incomplete body. - (false-if-exception (close-port cp)))))) + (when (and clean? chunked?) + ;; Clean end: HTTP/1.1 bodies close with the final zero + ;; chunk; HTTP/1.0 clients end at the close. Non-SSE + ;; aborts close without it so the client sees an + ;; incomplete body. + (false-if-exception (put-string cp "0\r\n\r\n"))) + (when clean? + (force-output cp)) + (false-if-exception (close-port cp))))) ;; ── Request handling ──────────────────────────── @@ -702,10 +664,9 @@ client that vanished mid-abort. Returns #t on success." url hdrs payload) - ;; Only the response is kept; the body port http-request - ;; returns is discarded. UP is read raw: RELAY decodes the - ;; framing itself, since that decoder port would swallow - ;; whole small bodies before yielding a single byte. + ;; UP is read raw: RELAY decodes the framing itself, since + ;; http-request's body port would swallow whole small bodies + ;; before yielding a single byte. (let* ((up (open-upstream url)) (request (lambda () (http-request url @@ -727,8 +688,7 @@ client that vanished mid-abort. Returns #t on success." rsp up t0)))) - (dynamic-wind (lambda () - #f) + (dynamic-wind (const #f) (lambda () (req-log id "event=upstream-connect ms=~d" (- (ms-now) t0)) @@ -742,10 +702,10 @@ client that vanished mid-abort. Returns #t on success." cp version t0) - (define timeout-body - "{\"error\":\"upstream timeout\"}") - (define unavailable-body - "{\"error\":\"upstream unavailable\"}") + (define (hdr name value) + (if value + (list (cons name value)) + '())) (define (fail code reason msg) (send-simple id cp @@ -774,12 +734,8 @@ client that vanished mid-abort. Returns #t on success." (host-header upstream)) (cons 'content-type (list 'application/json))) - (if auth - (list (cons 'x-api-key auth)) - '()) - (if av - (list (cons 'anthropic-version av)) - '())))) + (hdr 'x-api-key auth) + (hdr 'anthropic-version av)))) (req-log id "event=upstream url=~a ms=~d" (uri->string url) (- (ms-now) t0)) @@ -798,13 +754,15 @@ client that vanished mid-abort. Returns #t on success." 'claude-proxy-timeout) (req-log id "event=timeout phase=headers ms=~d" (- (ms-now) t0)) - (fail 504 "Gateway Timeout" timeout-body)) + (fail 504 "Gateway Timeout" + "{\"error\":\"upstream timeout\"}")) (else (req-log id - "event=error phase=headers key=~s ms=~d" key - (- (ms-now) t0)) - (req-log id "event=error phase=headers msg=~s" - args) - (fail 502 "Bad Gateway" unavailable-body))))))) + "event=error phase=headers key=~s args=~s" key + args) + (req-log id "event=error phase=headers ms=~d" + (- (ms-now) t0)) + (fail 502 "Bad Gateway" + "{\"error\":\"upstream unavailable\"}"))))))) (let ((json (catch #t (lambda () (json-string->scm (utf8->string body))) @@ -814,18 +772,9 @@ client that vanished mid-abort. Returns #t on success." (fail 400 "Bad Request" "{\"error\":\"invalid json\"}") (try-upstream json)))) + ;; 16 MiB request-body cap. (define max-body (expt 2 24)) - ;; 16 MiB request-body cap - - (define (body-allowed? request) - ;; read-headers decodes content-length to an integer; clients - ;; that omit it leave no header at all. - (let ((cl (assoc-ref (request-headers request) - 'content-length))) - (or (not cl) - (<= (if (number? cl) cl - (or (string->number cl) 0)) max-body)))) (define (read-request* id cp t0) (catch #t @@ -885,7 +834,13 @@ client that vanished mid-abort. Returns #t on success." "Method Not Allowed" "application/json" "{\"error\":\"method not allowed\"}")) - ((not (body-allowed? request)) + ((let ((cl (assoc-ref (request-headers request) + 'content-length))) + ;; read-headers decodes content-length to an + ;; integer; clients that omit it leave no header. + (and cl + (> (if (number? cl) cl + (or (string->number cl) 0)) max-body))) (send-simple id cp t0 @@ -916,24 +871,19 @@ client that vanished mid-abort. Returns #t on success." (let ((cp (make-deadline-port client-sock (fileno client-sock) idle-timeout #f))) - (dynamic-wind (lambda () - #f) + (dynamic-wind (const #f) (lambda () (serve-one id cp t0)) (lambda () (false-if-exception (close-port cp)))))) (lambda (key . args) - (req-log id "event=error phase=connection key=~s" key) - (req-log id "event=error phase=connection msg=~s" + (req-log id "event=error phase=connection key=~s msg=~s" + key (and (pair? args) (car args))) (req-log id "event=error phase=connection ms=~d" (- (ms-now) t0)))))) - ;; Orphan watchdog cadence in seconds. - (define watch-interval - (or (and=> (getenv "CLAUDE_PROXY_WATCHDOG_SECONDS") string->number) 15)) - (define (run-proxy) (sigaction SIGPIPE SIG_IGN) (let ((listener (socket PF_INET SOCK_STREAM 0)) @@ -1003,39 +953,16 @@ client that vanished mid-abort. Returns #t on success." (run-proxy))) (define claude-proxy-script - (program-file "claude-proxy" claude-proxy-code)) + (program-file "claude-proxy" + (with-extensions (list guile-gnutls guile-json-4) + #~#$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") - (setenv "CLAUDE_PROXY_TIMEOUT" "60") - ;; Off-path modules: (gnutls) and (json) live in - ;; these store directories, which shepherd does - ;; not put on GUILE_LOAD_PATH. - (setenv "GUILE_LOAD_PATH" - (string-append #$(file-append guile-gnutls - "/share/guile/site/3.0") ":" - #$(file-append guile-json-4 - "/share/guile/site/3.0"))) - (setenv "GUILE_LOAD_COMPILED_PATH" - (string-append #$(file-append guile-gnutls - "/lib/guile/3.0/site-ccache") - ":" - #$(file-append guile-json-4 - "/lib/guile/3.0/site-ccache"))) - (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) + (make-forkexec-constructor (list #$claude-proxy-script) #:log-file (string-append log-dir "/claude-proxy.log"))))