130 lines
3.4 KiB
Scheme
130 lines
3.4 KiB
Scheme
(define-module (metalapi requests)
|
|
#:use-module (web client)
|
|
#:use-module (json)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-11)
|
|
#:export (api-key
|
|
consumer-token
|
|
|
|
toggle-http-debug
|
|
%default-headers
|
|
with-staff-headers
|
|
headers
|
|
|
|
GET
|
|
POST
|
|
PUT
|
|
DELETE
|
|
|
|
handle-pagination
|
|
|
|
extract-attrs)
|
|
#:re-export (scm->json))
|
|
|
|
(define (api-key) (getenv "API_KEY"))
|
|
(define (consumer-token) (getenv "CONSUMER_TOKEN"))
|
|
(define auth-header-key 'x-auth-token)
|
|
(define consumer-header-key 'x-consumer-token)
|
|
(define staff-header (cons 'x-packet-staff "true"))
|
|
(define base-url "https://api.equinix.com/metal/v1")
|
|
(define metal-prefix "/metal/v1")
|
|
|
|
(define %default-headers
|
|
`((x-auth-token . ,(api-key))
|
|
(CONTENT-TYPE . "application/json")
|
|
(ACCEPT . "application/json")))
|
|
|
|
(define http-debug? #f)
|
|
|
|
(define (toggle-http-debug)
|
|
(set! http-debug? (not http-debug?)))
|
|
|
|
(define (with-staff-headers thunk)
|
|
(let ((old-headers %default-headers))
|
|
(dynamic-wind
|
|
(lambda () (set! %default-headers (append %default-headers
|
|
(list (cons 'X-CONSUMER-TOKEN (consumer-token))
|
|
(cons 'X-PACKET-STAFF "true")))))
|
|
thunk
|
|
(lambda () (set! %default-headers old-headers)))))
|
|
|
|
(define (headers)
|
|
%default-headers)
|
|
|
|
(define (http-debug method path headers body)
|
|
(display (format #f "method: ~a\npath: ~a\nheaders: ~a\nbody: ~a\n" method path headers body)))
|
|
|
|
(define (staff-headers)
|
|
(let ((consumer-token (getenv "CONSUMER_TOKEN")))
|
|
(cons (car (headers))
|
|
(list
|
|
(cons consumer-header-key consumer-token)
|
|
staff-header))))
|
|
|
|
(define (http-req method path headers body)
|
|
(let ((fixed-path (combine-path path)))
|
|
(when http-debug? (http-debug method fixed-path headers body))
|
|
(let-values (((resp port) (http-request fixed-path #:headers headers
|
|
#:method method
|
|
#:streaming? #t
|
|
#:decode-body? #f
|
|
#:body body)))
|
|
(handle-json port))))
|
|
|
|
|
|
(define (handle-json port)
|
|
(with-input-from-port port
|
|
(lambda ()
|
|
(let ((res (json->scm port)))
|
|
(close-port port)
|
|
res))))
|
|
|
|
(define (GET path headers)
|
|
(http-req 'GET path headers #f))
|
|
|
|
(define (POST path headers body)
|
|
(http-req 'POST path headers body))
|
|
|
|
(define (PUT path headers body)
|
|
(http-req 'PUT path headers body))
|
|
|
|
(define (DELETE path headers body)
|
|
(http-req 'DELETE path headers body))
|
|
|
|
(define (strip-prefix s prefix)
|
|
(substring s (string-length prefix)))
|
|
|
|
(define (combine-path path)
|
|
(if (string-contains path metal-prefix)
|
|
(string-append base-url (strip-prefix path metal-prefix))
|
|
(string-append base-url path)))
|
|
|
|
(define (meta paginated-json)
|
|
(assoc-ref paginated-json "meta"))
|
|
|
|
(define (meta->current-page meta)
|
|
(assoc-ref meta "current_page"))
|
|
|
|
(define (meta->last-page meta)
|
|
(assoc-ref meta "last_page"))
|
|
|
|
(define (meta->next meta)
|
|
(assoc-ref (assoc-ref meta "next") "href"))
|
|
|
|
(define (extract-attrs alist . args)
|
|
(fold (lambda (key lst) (cons (assoc key alist) lst)) '() args))
|
|
|
|
|
|
(define (handle-pagination start-path array-key model-fn)
|
|
(let ((pagination (meta (GET start-path (headers))))
|
|
(collection '()))
|
|
(define (process-page url)
|
|
(let ((full-page (GET url (headers))))
|
|
(map (lambda (item)
|
|
(set! collection (cons (model-fn item) collection)))
|
|
(vector->list (assoc-ref full-page array-key)))
|
|
(if (meta->next (meta full-page))
|
|
(process-page (meta->next (meta full-page)))
|
|
(reverse collection))))
|
|
(process-page start-path)))
|