diff --git a/guile/list-gitlab-merge-requests.scm b/guile/list-gitlab-merge-requests.scm new file mode 100644 index 0000000..8a5525f --- /dev/null +++ b/guile/list-gitlab-merge-requests.scm @@ -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 "")))) + (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")))))))