ray/racket-utils
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Don't tie client to token-based authentication

Browse source
This commit is contained in:
Ray Miller 2024-05-06 20:19:40 +01:00
parent 7c36e6f49a
commit 9893d65081
1 changed files with 6 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
gitlab.rkt
View file

@ -5,6 +5,7 @@
(only-in srfi/1 alist-cons)) (only-in srfi/1 alist-cons))
(provide make-client (provide make-client
access-token-auth
api-url api-url
get get
get-paged get-paged
@ -12,14 +13,14 @@
list-group-projects list-group-projects
list-groups) list-groups)
(struct client (url token)) (struct client (url auth))
(define (gitlab-token-auth token) (define (access-token-auth token)
(lambda (uri headers params) (lambda (uri headers params)
(values (hash-set headers 'private-token token) params))) (values (hash-set headers 'private-token token) params)))
(define (make-client #:url (url (string->url "https://gitlab.com")) #:token token) (define (make-client #:url (url (string->url "https://gitlab.com")) #:auth auth)
(client url token)) (client url auth))
(define (api-url c path-parts (query-params '())) (define (api-url c path-parts (query-params '()))
(struct-copy url (struct-copy url
@ -29,7 +30,7 @@
(define (get c path-parts (query-params '())) (define (get c path-parts (query-params '()))
(let* ((u (api-url c path-parts query-params)) (let* ((u (api-url c path-parts query-params))
(res (http:get u #:auth (gitlab-token-auth (client-token c))))) (res (http:get u #:auth (client-auth c))))
(if (>= (http:response-status-code res) 300) (if (>= (http:response-status-code res) 300)
(raise-user-error 'gitlab/get (format "GET ~a: ~a" (url->string u) (http:response-status-message res))) (raise-user-error 'gitlab/get (format "GET ~a: ~a" (url->string u) (http:response-status-message res)))
res))) res)))