71 lines
2.5 KiB
Scheme
71 lines
2.5 KiB
Scheme
#!/usr/bin/guile \
|
|
--no-auto-compile -e main -s
|
|
!#
|
|
|
|
(use-modules (ice-9 binary-ports)
|
|
(ice-9 exceptions)
|
|
(ice-9 match)
|
|
(json)
|
|
(srfi srfi-1)
|
|
(srfi srfi-26)
|
|
(srfi srfi-71)
|
|
(web client)
|
|
(web response)
|
|
(web uri))
|
|
|
|
(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
|
|
(string-append s
|
|
(if (zero? (string-length s)) "" "&")
|
|
(symbol->string k)
|
|
"="
|
|
(uri-encode v))
|
|
s)))
|
|
""
|
|
alist))
|
|
|
|
(define (json-response? res)
|
|
(eq? 'application/json (car (response-content-type res))))
|
|
|
|
(define (json-ok? res)
|
|
(and (= 200 (response-code res))
|
|
(json-response? res)))
|
|
|
|
(define-exception-type &api-error &external-error
|
|
make-api-error
|
|
api-error?
|
|
(endpoint api-error-endpoint)
|
|
(status-code api-error-status-code)
|
|
(body api-error-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)
|
|
(api-call http-get "/merge_requests" #:query params #:post-proc vector->list))
|
|
|
|
(define (field-equal? field-name value)
|
|
(lambda (alist)
|
|
(equal? (assoc-ref alist field-name) value)))
|
|
|
|
(define (main args)
|
|
(for-each (cut format #t "~a~%" <>)
|
|
(map (cut assoc-ref <> "web_url")
|
|
(filter (field-equal? "title" "Build: add pip-audit to pipeline")
|
|
(list-merge-requests '((state . "opened") (author_username . "ray33")))))))
|