diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c8eb057 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +compiled/** diff --git a/gitlab.rkt b/gitlab.rkt new file mode 100644 index 0000000..1e0f52b --- /dev/null +++ b/gitlab.rkt @@ -0,0 +1,46 @@ +#lang racket + +(require net/url) +(require (prefix-in http: net/http-easy)) +(require (only-in srfi/1 alist-cons)) + +(provide gitlab-client%) + +(define (gitlab-token-auth token) + (lambda (uri headers params) + (values (hash-set headers 'private-token token) params))) + +(define gitlab-client% + (class object% + + (super-new) + + (init-field token + (api-url (string->url "https://gitlab.com"))) + + (define/public (url-for path-parts #:query [query-params '()]) + (struct-copy url api-url + [query query-params] + [path (map (lambda (p) (path/param p '())) (append (list "api" "v4") path-parts))])) + + (define/public (get path-parts #:query [query-params '()]) + (let* ([u (url-for path-parts #:query query-params)] + [res (http:get u #:auth (gitlab-token-auth token))]) + (if (> (http:response-status-code res) 299) + (raise-user-error 'gitlab-client/get (format "GET ~a: ~a" (url->string u) (http:response-status-message res))) + res))) + + (define/public (get-paged path-parts #:query [query-params '((per_page . "100"))]) + (define (get-pages response accum) + (let ([accum (append accum (http:response-json response))] + [next-page (bytes->string/utf-8 (http:response-headers-ref response 'x-next-page))]) + (if (non-empty-string? next-page) + (get-pages (get path-parts #:query (alist-cons 'page next-page query-params)) accum) + accum))) + (get-pages (get path-parts #:query query-params) '())) + + (define/public (list-descendant-groups group-id) + (get-paged (list "groups" group-id "descendant_groups"))) + + (define/public (list-projects group-id) + (get-paged (list "groups" group-id "projects"))))) \ No newline at end of file