Compare commits

...

2 commits

Author SHA1 Message Date
Ray Miller
a2e936e608 Generalize the GitLab API client. 2025-06-18 09:56:14 +01:00
Ray Miller
c3e133073a Configure network for guix setup 2025-06-18 09:54:23 +01:00
2 changed files with 30 additions and 27 deletions

View file

@ -2,9 +2,9 @@
--no-auto-compile -e main -s
!#
(use-modules (ice-9 exceptions)
(use-modules (ice-9 binary-ports)
(ice-9 exceptions)
(ice-9 match)
(ice-9 textual-ports)
(json)
(srfi srfi-1)
(srfi srfi-26)
@ -13,10 +13,12 @@
(web response)
(web uri))
(define gitlab-token (string-trim-right (getenv "GITLAB_TOKEN")))
(define gitlab-token (string-trim (getenv "GITLAB_TOKEN")))
(define base-url "https://gitlab.com/api/v4")
(define (encode-query alist)
"Encode an association list as a query string. The keys should be symbols and the
values strings or #f, in which case the parameter is skipped."
(fold (match-lambda*
(((k . v) s)
(if v
@ -32,10 +34,6 @@
(define (json-response? res)
(eq? 'application/json (car (response-content-type res))))
(define (text-response? res)
(string-prefix? "text/"
(symbol->string (car (response-content-type res)))))
(define (json-ok? res)
(and (= 200 (response-code res))
(json-response? res)))
@ -47,28 +45,20 @@
(status-code api-error-status-code)
(body api-error-body))
(define-syntax check-api-response
(syntax-rules ()
((check-api-response endpoint res body-port)
(check-api-response endpoint res body-port (<= 100 (response-code res) 399)))
((check-api-response endpoint res body-port ok?)
(unless ok?
(let ((body (cond
((json-response? res) (json->scm body-port))
((text-response? res) (get-string-all body-port))
(else "<binary response body>"))))
(close-port body-port)
(raise-exception (make-api-error endpoint (response-code res) body)))))))
(define* (api-call method endpoint #:key query payload (ok? json-ok?) (post-proc identity))
(let* ((res body (method (if query
(string-append base-url endpoint "?" (encode-query query))
(string-append base-url endpoint))
#:headers `((private-token . ,gitlab-token)
(content-type . (application/json (charset . "utf-8"))))
#:body (if payload (scm->json payload) #f)))
(body (if (json-response? res) (call-with-input-bytevector body json->scm) body)))
(if (ok? res)
(post-proc body)
(raise-exception (make-api-error endpoint (response-code res) body)))))
(define (list-merge-requests params)
(let ((res body-port (http-get (string-append base-url "/merge_requests?" (encode-query params))
#:headers `((private-token . ,gitlab-token))
#:streaming? #t)))
(check-api-response "list-merge-requests" res body-port json-ok?)
(let ((body (json->scm body-port)))
(close-port body-port)
(vector->list body))))
(api-call http-get "/merge_requests" #:query params #:post-proc vector->list))
(define (field-equal? field-name value)
(lambda (alist)

View file

@ -7,6 +7,7 @@ systemctl --user stop guix.service || true
systemctl --user stop gnu-store-volume.service || true
systemctl --user stop guix-home-volume.service || true
systemctl --user stop guix-var-volume.service || true
systemctl --user stop guix-network.service || true
(
cd $(mktemp -d)
@ -28,6 +29,16 @@ QUADLETS="${HOME}/.config/containers/systemd/"
mkdir -p "${QUADLETS}"
cat > "${QUADLETS}/guix.network" <<EOF
[Unit]
Description = Network for Guix service
[Network]
[Install]
WantedBy = multi-user.target default.target
EOF
cat > "${QUADLETS}/gnu-store.volume" <<EOF
[Unit]
Description = Create GNU Store data volume
@ -79,6 +90,7 @@ Volume = guix-var.volume:/var/guix
Volume = guix-home.volume:/home/guix
Volume = gnu-store.volume:/gnu/store
PodmanArgs = --privileged
Network = guix.network
[Install]
WantedBy = multi-user.target default.target
@ -86,6 +98,7 @@ EOF
systemctl --user daemon-reload
systemctl --user start guix-network.service
systemctl --user start guix-var-volume.service
systemctl --user start gnu-store-volume.service
systemctl --user start guix-home-volume.service