;;;; 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 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))