Quick hack to list GitLab MRs
This commit is contained in:
parent
91b7c1b554
commit
52462ffa40
1 changed files with 81 additions and 0 deletions
81
guile/list-gitlab-merge-requests.scm
Normal file
81
guile/list-gitlab-merge-requests.scm
Normal file
|
@ -0,0 +1,81 @@
|
|||
#!/usr/bin/guile \
|
||||
--no-auto-compile -e main -s
|
||||
!#
|
||||
|
||||
(use-modules (ice-9 exceptions)
|
||||
(ice-9 match)
|
||||
(ice-9 textual-ports)
|
||||
(json)
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-26)
|
||||
(srfi srfi-71)
|
||||
(web client)
|
||||
(web response)
|
||||
(web uri))
|
||||
|
||||
(define gitlab-token (string-trim-right (getenv "GITLAB_TOKEN")))
|
||||
(define base-url "https://gitlab.com/api/v4")
|
||||
|
||||
(define (encode-query alist)
|
||||
(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 (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)))
|
||||
|
||||
(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-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 (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))))
|
||||
|
||||
(define (field-eq? 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-eq? "title" "Build: add pip-audit to pipeline")
|
||||
(list-merge-requests '((state . "opened") (author_username . "ray33")))))))
|
Loading…
Add table
Add a link
Reference in a new issue