Kyle Isom
0c441f5c4f
- clients/README.md: canonical API surface and error type reference - clients/testdata/: shared JSON response fixtures - clients/go/: mciasgoclient package; net/http + TLS 1.2+; sync.RWMutex token state; DisallowUnknownFields on all decoders; 25 tests pass - clients/rust/: async mcias-client crate; reqwest+rustls (no OpenSSL); thiserror MciasError enum; Arc<RwLock> token state; 22+1 tests pass; cargo clippy -D warnings clean - clients/lisp/: ASDF mcias-client; dexador HTTP, yason JSON; mcias-error condition hierarchy; Hunchentoot mock-dispatcher; 37 fiveam checks pass on SBCL 2.6.1; yason boolean normalisation in validate-token - clients/python/: mcias_client package (Python 3.11+); httpx sync; py.typed; dataclasses; 32 pytest tests; mypy --strict + ruff clean - test/mock/mockserver.go: in-memory mock server for Go client tests - ARCHITECTURE.md §19: updated per-language notes to match implementation - PROGRESS.md: Phase 9 marked complete - .gitignore: exclude clients/rust/target/, python .venv, .pytest_cache, .fasl files Security: token never logged or exposed in error messages in any library; TLS enforced in all four languages; token stored under lock/mutex/RwLock
289 lines
12 KiB
Common Lisp
289 lines
12 KiB
Common Lisp
;;;; client.lisp -- MCIAS REST API client implementation
|
|
|
|
(in-package #:mcias-client)
|
|
|
|
;;;; -----------------------------------------------------------------------
|
|
;;;; Client class
|
|
;;;; -----------------------------------------------------------------------
|
|
|
|
(defclass mcias-client ()
|
|
((base-url :initarg :base-url
|
|
:reader client-base-url
|
|
:documentation "Base URL of the MCIAS server (no trailing slash).")
|
|
(token :initarg :token
|
|
:initform nil
|
|
:accessor client-token
|
|
:documentation "Current Bearer token string, or NIL.")
|
|
(ca-cert :initarg :ca-cert
|
|
:initform nil
|
|
:reader client-ca-cert
|
|
:documentation "Path to CA certificate file for TLS verification, or NIL."))
|
|
(:documentation "Holds connection parameters for one MCIAS server."))
|
|
|
|
(defun make-client (base-url &key token ca-cert)
|
|
"Create an MCIAS client for BASE-URL.
|
|
Optional TOKEN pre-seeds the Bearer token; CA-CERT overrides TLS CA."
|
|
;; Strip any trailing slashes so we can always append /v1/... cleanly.
|
|
(let ((url (string-right-trim "/" base-url)))
|
|
(make-instance 'mcias-client
|
|
:base-url url
|
|
:token token
|
|
:ca-cert ca-cert)))
|
|
|
|
;;;; -----------------------------------------------------------------------
|
|
;;;; Internal helpers
|
|
;;;; -----------------------------------------------------------------------
|
|
|
|
(defun %encode-json (object)
|
|
"Encode OBJECT to a JSON string using yason."
|
|
(with-output-to-string (s)
|
|
(yason:encode object s)))
|
|
|
|
(defun %parse-json (string)
|
|
"Parse STRING as JSON. Returns NIL for empty or nil input."
|
|
(when (and string (> (length string) 0))
|
|
(yason:parse string)))
|
|
|
|
(defun %auth-headers (client)
|
|
"Return an alist of HTTP headers for CLIENT.
|
|
Includes Authorization: Bearer <token> when a token is set."
|
|
(let ((headers (list (cons "Content-Type" "application/json")
|
|
(cons "Accept" "application/json"))))
|
|
(when (client-token client)
|
|
(push (cons "Authorization"
|
|
(concatenate 'string "Bearer " (client-token client)))
|
|
headers))
|
|
headers))
|
|
|
|
(defun %check-status (status body-string)
|
|
"Signal an appropriate mcias-error if STATUS >= 400.
|
|
Extracts the 'error' field from the JSON body when possible."
|
|
(when (>= status 400)
|
|
(let* ((parsed (ignore-errors (%parse-json body-string)))
|
|
(message (if (hash-table-p parsed)
|
|
(or (gethash "error" parsed) body-string)
|
|
body-string)))
|
|
(signal-mcias-error status message))))
|
|
|
|
(defun %request (client method path &key body)
|
|
"Perform an HTTP request against the MCIAS server.
|
|
METHOD is a keyword (:GET :POST etc.), PATH is the API path string.
|
|
BODY (optional) is a hash table or list that will be JSON-encoded.
|
|
Returns the parsed JSON response body (hash-table/list/string/number)
|
|
or NIL for empty responses."
|
|
(let* ((url (concatenate 'string (client-base-url client) path))
|
|
(headers (%auth-headers client))
|
|
(content (when body (%encode-json body))))
|
|
(multiple-value-bind (resp-body status)
|
|
(handler-case
|
|
(dex:request url
|
|
:method method
|
|
:headers headers
|
|
:content content
|
|
:want-stream nil
|
|
:force-string t)
|
|
(dex:http-request-failed (e)
|
|
(values (dex:response-body e)
|
|
(dex:response-status e))))
|
|
(%check-status status resp-body)
|
|
(%parse-json resp-body))))
|
|
|
|
;;;; -----------------------------------------------------------------------
|
|
;;;; Account response helper
|
|
;;;; -----------------------------------------------------------------------
|
|
|
|
(defun %account->plist (ht)
|
|
"Convert a yason-parsed account hash-table HT to a plist."
|
|
(when ht
|
|
(list :id (gethash "id" ht)
|
|
:username (gethash "username" ht)
|
|
:account-type (gethash "account_type" ht)
|
|
:status (gethash "status" ht)
|
|
:created-at (gethash "created_at" ht)
|
|
:updated-at (gethash "updated_at" ht))))
|
|
|
|
;;;; -----------------------------------------------------------------------
|
|
;;;; Authentication
|
|
;;;; -----------------------------------------------------------------------
|
|
|
|
(defun login (client username password &key totp-code)
|
|
"Authenticate USERNAME/PASSWORD against MCIAS.
|
|
Stores the returned token in CLIENT-TOKEN.
|
|
Returns (values token expires-at)."
|
|
(let* ((body (let ((ht (make-hash-table :test 'equal)))
|
|
(setf (gethash "username" ht) username
|
|
(gethash "password" ht) password)
|
|
(when totp-code
|
|
(setf (gethash "totp_code" ht) totp-code))
|
|
ht))
|
|
(resp (%request client :post "/v1/auth/login" :body body))
|
|
(token (gethash "token" resp))
|
|
(expires-at (gethash "expires_at" resp)))
|
|
(setf (client-token client) token)
|
|
(values token expires-at)))
|
|
|
|
(defun logout (client)
|
|
"Revoke the current session token and clear CLIENT-TOKEN.
|
|
Returns T on success."
|
|
(%request client :post "/v1/auth/logout")
|
|
(setf (client-token client) nil)
|
|
t)
|
|
|
|
(defun renew-token (client)
|
|
"Renew the current Bearer token.
|
|
Stores the new token in CLIENT-TOKEN.
|
|
Returns (values new-token expires-at)."
|
|
(let* ((resp (%request client :post "/v1/auth/renew" :body (make-hash-table :test 'equal)))
|
|
(token (gethash "token" resp))
|
|
(expires-at (gethash "expires_at" resp)))
|
|
(setf (client-token client) token)
|
|
(values token expires-at)))
|
|
|
|
(defun validate-token (client token-string)
|
|
"Validate TOKEN-STRING with the MCIAS server.
|
|
Returns a plist with :valid :sub :roles :expires-at.
|
|
:valid is T for a valid token, NIL for invalid (not an error condition)."
|
|
(let* ((body (let ((ht (make-hash-table :test 'equal)))
|
|
(setf (gethash "token" ht) token-string)
|
|
ht))
|
|
(resp (%request client :post "/v1/token/validate" :body body))
|
|
;; yason parses JSON true -> T, JSON false -> :FALSE
|
|
(raw-valid (gethash "valid" resp))
|
|
(valid (if (eq raw-valid t) t nil)))
|
|
(list :valid valid
|
|
:sub (gethash "sub" resp)
|
|
:roles (gethash "roles" resp)
|
|
:expires-at (gethash "expires_at" resp))))
|
|
|
|
;;;; -----------------------------------------------------------------------
|
|
;;;; Server information
|
|
;;;; -----------------------------------------------------------------------
|
|
|
|
(defun health (client)
|
|
"Check server health. Returns T on success, signals on failure."
|
|
(%request client :get "/v1/health")
|
|
t)
|
|
|
|
(defun get-public-key (client)
|
|
"Fetch the server's public key (JWK).
|
|
Returns a plist with :kty :crv :x."
|
|
(let ((resp (%request client :get "/v1/keys/public")))
|
|
(list :kty (gethash "kty" resp)
|
|
:crv (gethash "crv" resp)
|
|
:x (gethash "x" resp))))
|
|
|
|
;;;; -----------------------------------------------------------------------
|
|
;;;; Account management (admin)
|
|
;;;; -----------------------------------------------------------------------
|
|
|
|
(defun create-account (client username account-type &key password)
|
|
"Create a new account. Requires admin token.
|
|
Returns an account plist."
|
|
(let ((body (let ((ht (make-hash-table :test 'equal)))
|
|
(setf (gethash "username" ht) username
|
|
(gethash "account_type" ht) account-type)
|
|
(when password
|
|
(setf (gethash "password" ht) password))
|
|
ht)))
|
|
(%account->plist (%request client :post "/v1/accounts" :body body))))
|
|
|
|
(defun list-accounts (client)
|
|
"List all accounts. Requires admin token.
|
|
Returns a list of account plists."
|
|
(let ((resp (%request client :get "/v1/accounts")))
|
|
;; Response is a JSON array
|
|
(mapcar #'%account->plist resp)))
|
|
|
|
(defun get-account (client id)
|
|
"Get account by ID. Requires admin token.
|
|
Returns an account plist."
|
|
(%account->plist (%request client :get (format nil "/v1/accounts/~A" id))))
|
|
|
|
(defun update-account (client id &key status)
|
|
"Update account fields. Requires admin token.
|
|
Returns updated account plist."
|
|
(let ((body (let ((ht (make-hash-table :test 'equal)))
|
|
(when status
|
|
(setf (gethash "status" ht) status))
|
|
ht)))
|
|
(%account->plist (%request client :patch
|
|
(format nil "/v1/accounts/~A" id)
|
|
:body body))))
|
|
|
|
(defun delete-account (client id)
|
|
"Delete account by ID. Requires admin token.
|
|
Returns T on success."
|
|
(%request client :delete (format nil "/v1/accounts/~A" id))
|
|
t)
|
|
|
|
;;;; -----------------------------------------------------------------------
|
|
;;;; Role management (admin)
|
|
;;;; -----------------------------------------------------------------------
|
|
|
|
(defun get-roles (client account-id)
|
|
"Get roles for ACCOUNT-ID. Requires admin token.
|
|
Returns a list of role strings."
|
|
(let ((resp (%request client :get (format nil "/v1/accounts/~A/roles" account-id))))
|
|
(gethash "roles" resp)))
|
|
|
|
(defun set-roles (client account-id roles)
|
|
"Set roles for ACCOUNT-ID to ROLES (list of strings). Requires admin token.
|
|
Returns T on success."
|
|
(let ((body (let ((ht (make-hash-table :test 'equal)))
|
|
(setf (gethash "roles" ht) roles)
|
|
ht)))
|
|
(%request client :put
|
|
(format nil "/v1/accounts/~A/roles" account-id)
|
|
:body body)
|
|
t))
|
|
|
|
;;;; -----------------------------------------------------------------------
|
|
;;;; Token management (admin)
|
|
;;;; -----------------------------------------------------------------------
|
|
|
|
(defun issue-service-token (client account-id)
|
|
"Issue a service token for ACCOUNT-ID. Requires admin token.
|
|
Returns (values token expires-at)."
|
|
(let* ((body (let ((ht (make-hash-table :test 'equal)))
|
|
(setf (gethash "account_id" ht) account-id)
|
|
ht))
|
|
(resp (%request client :post "/v1/token/issue" :body body))
|
|
(token (gethash "token" resp))
|
|
(expires-at (gethash "expires_at" resp)))
|
|
(values token expires-at)))
|
|
|
|
(defun revoke-token (client jti)
|
|
"Revoke token by JTI. Requires admin token.
|
|
Returns T on success."
|
|
(%request client :delete (format nil "/v1/token/~A" jti))
|
|
t)
|
|
|
|
;;;; -----------------------------------------------------------------------
|
|
;;;; PG credentials (admin)
|
|
;;;; -----------------------------------------------------------------------
|
|
|
|
(defun get-pg-creds (client account-id)
|
|
"Get PostgreSQL credentials for ACCOUNT-ID. Requires admin token.
|
|
Returns a plist with :host :port :database :username :password."
|
|
(let ((resp (%request client :get (format nil "/v1/accounts/~A/pgcreds" account-id))))
|
|
(list :host (gethash "host" resp)
|
|
:port (gethash "port" resp)
|
|
:database (gethash "database" resp)
|
|
:username (gethash "username" resp)
|
|
:password (gethash "password" resp))))
|
|
|
|
(defun set-pg-creds (client account-id host port database username password)
|
|
"Set PostgreSQL credentials for ACCOUNT-ID. Requires admin token.
|
|
Returns T on success."
|
|
(let ((body (let ((ht (make-hash-table :test 'equal)))
|
|
(setf (gethash "host" ht) host
|
|
(gethash "port" ht) port
|
|
(gethash "database" ht) database
|
|
(gethash "username" ht) username
|
|
(gethash "password" ht) password)
|
|
ht)))
|
|
(%request client :put
|
|
(format nil "/v1/accounts/~A/pgcreds" account-id)
|
|
:body body)
|
|
t))
|