From 155e15e9f5d366a42c29d96a1bfe6c7811a57a5f Mon Sep 17 00:00:00 2001 From: Adam Mohammed Date: Fri, 7 Jun 2024 22:09:24 -0400 Subject: [PATCH] Starting a Scheme SDK for Equinix Metal --- metalapi/device.scm | 11 ++++ metalapi/project.scm | 20 +++++++ metalapi/requests.scm | 129 +++++++++++++++++++++++++++++++++++++++++ metalapi/vlan.scm | 34 +++++++++++ metalctrl/identity.scm | 53 +++++++++++++++++ 5 files changed, 247 insertions(+) create mode 100644 metalapi/device.scm create mode 100644 metalapi/project.scm create mode 100644 metalapi/requests.scm create mode 100644 metalapi/vlan.scm create mode 100644 metalctrl/identity.scm diff --git a/metalapi/device.scm b/metalapi/device.scm new file mode 100644 index 0000000..7173ea2 --- /dev/null +++ b/metalapi/device.scm @@ -0,0 +1,11 @@ +(define-module (metalapi device) + #:use-module (metalapi requests) + #:use-module (metalapi project) + #:export (build-device + list-all-devices)) + +(define (build-device device-alist) + (extract-attrs device-alist "id" "hostname")) + +(define (list-all-devices project) + (handle-pagination (format #f "/projects/~a/devices" (project->id project)) "devices" build-device)) diff --git a/metalapi/project.scm b/metalapi/project.scm new file mode 100644 index 0000000..ec6851c --- /dev/null +++ b/metalapi/project.scm @@ -0,0 +1,20 @@ +(define-module (metalapi project) + #:use-module (metalapi requests) + #:export (list-all-projects + build-project + project->id + project->organization)) + +(define (list-all-projects) + (handle-pagination "/projects?exclude=devices,memberships,members" "projects" build-project)) + +(define (build-project project-alist) + (extract-attrs project-alist "id" "name")) + +(define (project->id project) + (assoc-ref project "id")) + +(define (project->organization project) + (let ((project (GET (format #f "/projects/~a" (project->id project)) (headers)))) + (let ((org (GET (assoc-ref (assoc-ref project "organization") "href") (headers)))) + (list (assoc "id" org) (assoc "name" org))))) diff --git a/metalapi/requests.scm b/metalapi/requests.scm new file mode 100644 index 0000000..463ffb6 --- /dev/null +++ b/metalapi/requests.scm @@ -0,0 +1,129 @@ +(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))) diff --git a/metalapi/vlan.scm b/metalapi/vlan.scm new file mode 100644 index 0000000..6007066 --- /dev/null +++ b/metalapi/vlan.scm @@ -0,0 +1,34 @@ +(define-module (metalapi vlan) + #:use-module (metalapi requests) + #:use-module (metalapi project) + #:export (build-vlan + vlan->project + vlan->metro-code + vlan->vxlan + + vlan-request-body + + list-all-vlans)) + +(define (build-vlan vlan-alist) + (extract-attrs vlan-alist "id" "description" "vxlan" "metro_code")) + +(define (vlan->project vlan) + (project->id (assoc-ref vlan "project"))) + +(define (vlan->metro-code vlan) + (assoc-ref vlan "metro_code")) + +(define (vlan->description vlan) + (assoc-ref vlan "description")) + +(define (vlan-request-body vlan) + (scm->json-string + `(("metro" . ,(assoc-ref vlan "metro_code")) + ("description" . ,(vlan->description vlan))))) + +(define (vlan->vxlan vlan) + (assoc-ref vlan "vxlan")) + +(define (list-all-vlans project) + (handle-pagination (format #f "/projects/~a/virtual-networks" (project->id project)) "virtual_networks" build-vlan)) diff --git a/metalctrl/identity.scm b/metalctrl/identity.scm new file mode 100644 index 0000000..d8a937b --- /dev/null +++ b/metalctrl/identity.scm @@ -0,0 +1,53 @@ +(define-module (metalctrl identity) + #:use-module (json) + #:use-module (web client) + #:use-module (web uri) + #:use-module (ice-9 iconv) + #:use-module (srfi srfi-11)) + + +(define-public %base-identity-url "https://iam.metalctrl.io/") +(define (token-endpoint) (string-append %base-identity-url "token")) +(define (userinfo-endpoint) (string-append %base-identity-url "userinfo")) +(define (openid-configuration-endpoint) (string-append %base-identity-url "/.well-known/openid-configuration")) + + +(define token-exchange-headers '((Accept . "application/json") + (Content-Type . "application/x-www-form-urlencoded"))) + +;;curl -XPOST -d "grant_type=urn:ietf:params:oauth:grant-type:token-exchange&subject_token=$AUTH_TOKEN&subject_token_type=urn:ietf:params:oauth:token-type:jwt" http://localhost:8000/token +(define-public (exchange-token token) + (let-values (((resp port) (send-request + 'POST (token-endpoint) + token-exchange-headers + (string->bytevector (encode-token-params token) "utf-8")))) + (assoc-ref (unpack-json port) "access_token"))) + +(define-public (userinfo token) + (let ((headers (list `(Authorization . ,(string-append "Bearer " token))))) + (let-values (((resp port) (send-request 'GET (userinfo-endpoint) + headers + #f))) + (unpack-json port)))) + +(define (send-request method uri headers body) + (http-request uri + #:method method + #:headers headers + #:body body + #:decode-body? #f + #:streaming? #t)) + + +(define (encode-token-params token) + (let ((grant_type "urn:ietf:params:oauth:grant-type:token-exchange") + (subject_token token) + (subject_token_type "urn:ietf:params:oauth:token-type:jwt")) + (string-append (symbol->string 'grant_type) "=" grant_type "&" + (symbol->string 'subject_token) "=" subject_token "&" + (symbol->string 'subject_token_type) "=" subject_token_type))) + +(define (unpack-json port) + (with-input-from-port port + (lambda () + (json->scm))))