From b3fdb84f91c78bf2c038f6dd57e91ef73c4d759d Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Mon, 4 May 2026 00:17:43 +0000 Subject: [PATCH 1/3] Implement OpenAPI 3.0 spec using cl-json: types, decode, parse, tests, qlfile Agent-Logs-Url: https://github.com/cl-sdk/cl-openapi/sessions/a206de3d-d5bd-42bc-baf0-28fc745c370f Co-authored-by: diasbruno <362368+diasbruno@users.noreply.github.com> --- .github/workflows/ci.yml | 2 +- cl-openapi.asd | 6 +- decode.lisp | 577 +++++++++++++++++++++++++++++++++++++++ package.lisp | 256 ++++++++++++++++- qlfile | 2 + t/cl-openapi-tests.lisp | 229 ++++++++++++++++ t/package.lisp | 2 +- types.lisp | 308 +++++++++++++++++++++ 8 files changed, 1377 insertions(+), 5 deletions(-) create mode 100644 decode.lisp create mode 100644 qlfile create mode 100644 types.lisp diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 2490e0d..7debda9 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -61,4 +61,4 @@ jobs: - name: run run: | ros use sbcl - LISP="ros run --" make tests 2> /dev/null + LISP="qlot exec ros run --" make tests 2> /dev/null diff --git a/cl-openapi.asd b/cl-openapi.asd index e2cbe08..c3f6db1 100644 --- a/cl-openapi.asd +++ b/cl-openapi.asd @@ -2,6 +2,8 @@ :description "Open API Specification for Common Lisp." :license "Unlicense" :version "0.0.1" - :depends-on () + :depends-on (#:cl-json) :serial t - :components ((:file "package"))) + :components ((:file "package") + (:file "types") + (:file "decode"))) diff --git a/decode.lisp b/decode.lisp new file mode 100644 index 0000000..d71e62e --- /dev/null +++ b/decode.lisp @@ -0,0 +1,577 @@ +(in-package #:cl-openapi) + +;;; JSON decoding for OpenAPI objects. +;;; +;;; Each OpenAPI object type gets a JSON:DECODE-JSON method dispatched on its +;;; class symbol. The top-level PARSE function calls JSON:PARSE to produce a +;;; raw hash-table and then calls JSON:DECODE-JSON to convert it to a typed +;;; OPENAPI-DOCUMENT. +;;; +;;; Absent optional fields are left unbound on the resulting instance. +;;; Boolean fields (e.g. required, deprecated) are stored as T or NIL as +;;; returned by the JSON reader. + +;;; ── helpers ───────────────────────────────────────────────────────────────── + +(defun %ht (ht key) + "Return the value for KEY string in hash-table HT, or NIL when absent." + (gethash key ht)) + +(defmacro %set-when (instance accessor ht key) + "Set ACCESSOR on INSTANCE to (gethash KEY HT) when the key is present." + (let ((val (gensym "VAL")) + (found (gensym "FOUND"))) + `(multiple-value-bind (,val ,found) (gethash ,key ,ht) + (when ,found + (setf (,accessor ,instance) ,val))))) + +(defmacro %set-decoded (instance accessor ht key decoder) + "Set ACCESSOR on INSTANCE to (DECODER (gethash KEY HT)) when the key is present." + (let ((val (gensym "VAL")) + (found (gensym "FOUND"))) + `(multiple-value-bind (,val ,found) (gethash ,key ,ht) + (when ,found + (setf (,accessor ,instance) (funcall ,decoder ,val)))))) + +(defun %decode-or-ref (ht decoder) + "Return a REFERENCE when HT contains \"$ref\", otherwise call DECODER on HT." + (if (gethash "$ref" ht) + (make-instance 'reference :ref (gethash "$ref" ht)) + (funcall decoder ht))) + +(defun %decode-array (arr decoder) + "Decode a JSON array (vector) by applying DECODER to each element." + (when arr + (map 'vector decoder arr))) + +(defun %decode-map (ht decoder) + "Decode a JSON object (hash-table) into a new hash-table with values decoded by DECODER." + (when ht + (let ((result (make-hash-table :test 'equal))) + (maphash (lambda (k v) + (setf (gethash k result) (funcall decoder v))) + ht) + result))) + +(defun %decode-schema-or-ref (val) + "Decode VAL as a SCHEMA or a REFERENCE (if $ref is present)." + (when val + (%decode-or-ref val (lambda (ht) (json:decode-json 'schema ht))))) + +(defun %decode-param-or-ref (val) + "Decode VAL as a PARAMETER or a REFERENCE." + (when val + (%decode-or-ref val (lambda (ht) (json:decode-json 'parameter ht))))) + +(defun %decode-response-or-ref (val) + "Decode VAL as a RESPONSE or a REFERENCE." + (when val + (%decode-or-ref val (lambda (ht) (json:decode-json 'response ht))))) + +(defun %decode-header-or-ref (val) + "Decode VAL as a HEADER or a REFERENCE." + (when val + (%decode-or-ref val (lambda (ht) (json:decode-json 'header ht))))) + +(defun %decode-example-or-ref (val) + "Decode VAL as an EXAMPLE or a REFERENCE." + (when val + (%decode-or-ref val (lambda (ht) (json:decode-json 'example ht))))) + +(defun %decode-link-or-ref (val) + "Decode VAL as a LINK or a REFERENCE." + (when val + (%decode-or-ref val (lambda (ht) (json:decode-json 'link ht))))) + +(defun %decode-request-body-or-ref (val) + "Decode VAL as a REQUEST-BODY or a REFERENCE." + (when val + (%decode-or-ref val (lambda (ht) (json:decode-json 'request-body ht))))) + +(defun %decode-security-scheme-or-ref (val) + "Decode VAL as a SECURITY-SCHEME or a REFERENCE." + (when val + (%decode-or-ref val (lambda (ht) (json:decode-json 'security-scheme ht))))) + +;;; ── Reference ─────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'reference)) ht) + (make-instance 'reference :ref (gethash "$ref" ht))) + +;;; ── Contact ───────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'contact)) ht) + (let ((obj (make-instance 'contact))) + (%set-when obj contact-name ht "name") + (%set-when obj contact-url ht "url") + (%set-when obj contact-email ht "email") + obj)) + +;;; ── License ───────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'license)) ht) + (let ((obj (make-instance 'license))) + (%set-when obj license-name ht "name") + (%set-when obj license-url ht "url") + obj)) + +;;; ── Info ──────────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'info)) ht) + (let ((obj (make-instance 'info))) + (%set-when obj info-title ht "title") + (%set-when obj info-description ht "description") + (%set-when obj info-terms-of-service ht "termsOfService") + (%set-when obj info-version ht "version") + (%set-decoded obj info-contact ht "contact" + (lambda (v) (json:decode-json 'contact v))) + (%set-decoded obj info-license ht "license" + (lambda (v) (json:decode-json 'license v))) + obj)) + +;;; ── Server Variable ───────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'server-variable)) ht) + (let ((obj (make-instance 'server-variable))) + (%set-when obj server-variable-enum ht "enum") + (%set-when obj server-variable-default ht "default") + (%set-when obj server-variable-description ht "description") + obj)) + +;;; ── Server ────────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'server)) ht) + (let ((obj (make-instance 'server))) + (%set-when obj server-url ht "url") + (%set-when obj server-description ht "description") + (%set-decoded obj server-variables ht "variables" + (lambda (vars) + (%decode-map vars + (lambda (v) (json:decode-json 'server-variable v))))) + obj)) + +;;; ── External Documentation ────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'external-documentation)) ht) + (let ((obj (make-instance 'external-documentation))) + (%set-when obj external-documentation-description ht "description") + (%set-when obj external-documentation-url ht "url") + obj)) + +;;; ── Tag ───────────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'tag)) ht) + (let ((obj (make-instance 'tag))) + (%set-when obj tag-name ht "name") + (%set-when obj tag-description ht "description") + (%set-decoded obj tag-external-docs ht "externalDocs" + (lambda (v) (json:decode-json 'external-documentation v))) + obj)) + +;;; ── Discriminator ─────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'discriminator)) ht) + (let ((obj (make-instance 'discriminator))) + (%set-when obj discriminator-property-name ht "propertyName") + (%set-when obj discriminator-mapping ht "mapping") + obj)) + +;;; ── XML ───────────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'xml)) ht) + (let ((obj (make-instance 'xml))) + (%set-when obj xml-name ht "name") + (%set-when obj xml-namespace ht "namespace") + (%set-when obj xml-prefix ht "prefix") + (%set-when obj xml-attribute ht "attribute") + (%set-when obj xml-wrapped ht "wrapped") + obj)) + +;;; ── Schema ────────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'schema)) ht) + ;; A $ref at this level means the whole schema is a reference. + (when (gethash "$ref" ht) + (return-from json:decode-json + (make-instance 'reference :ref (gethash "$ref" ht)))) + (let ((obj (make-instance 'schema))) + ;; Metadata + (%set-when obj schema-title ht "title") + (%set-when obj schema-description ht "description") + (%set-when obj schema-deprecated ht "deprecated") + ;; Type & format + (%set-when obj schema-type ht "type") + (%set-when obj schema-format ht "format") + (%set-when obj schema-nullable ht "nullable") + ;; Number constraints + (%set-when obj schema-multiple-of ht "multipleOf") + (%set-when obj schema-maximum ht "maximum") + (%set-when obj schema-exclusive-maximum ht "exclusiveMaximum") + (%set-when obj schema-minimum ht "minimum") + (%set-when obj schema-exclusive-minimum ht "exclusiveMinimum") + ;; String constraints + (%set-when obj schema-max-length ht "maxLength") + (%set-when obj schema-min-length ht "minLength") + (%set-when obj schema-pattern ht "pattern") + ;; Array constraints + (%set-when obj schema-max-items ht "maxItems") + (%set-when obj schema-min-items ht "minItems") + (%set-when obj schema-unique-items ht "uniqueItems") + (%set-decoded obj schema-items ht "items" + #'%decode-schema-or-ref) + ;; Object constraints + (%set-when obj schema-max-properties ht "maxProperties") + (%set-when obj schema-min-properties ht "minProperties") + (%set-when obj schema-required ht "required") + (%set-decoded obj schema-properties ht "properties" + (lambda (props) + (%decode-map props #'%decode-schema-or-ref))) + (multiple-value-bind (ap ap-present) (gethash "additionalProperties" ht) + (when ap-present + (setf (schema-additional-properties obj) + ;; additionalProperties can be a boolean or a schema/ref. + (if (typep ap 'hash-table) + (%decode-schema-or-ref ap) + ap)))) + ;; Enum & default + (%set-when obj schema-enum ht "enum") + (%set-when obj schema-default ht "default") + (%set-when obj schema-example ht "example") + ;; Composition + (%set-decoded obj schema-all-of ht "allOf" + (lambda (arr) (%decode-array arr #'%decode-schema-or-ref))) + (%set-decoded obj schema-one-of ht "oneOf" + (lambda (arr) (%decode-array arr #'%decode-schema-or-ref))) + (%set-decoded obj schema-any-of ht "anyOf" + (lambda (arr) (%decode-array arr #'%decode-schema-or-ref))) + (%set-decoded obj schema-not ht "not" + #'%decode-schema-or-ref) + ;; Validation hints + (%set-when obj schema-read-only ht "readOnly") + (%set-when obj schema-write-only ht "writeOnly") + ;; Extended + (%set-decoded obj schema-discriminator ht "discriminator" + (lambda (v) (json:decode-json 'discriminator v))) + (%set-decoded obj schema-xml ht "xml" + (lambda (v) (json:decode-json 'xml v))) + (%set-decoded obj schema-external-docs ht "externalDocs" + (lambda (v) (json:decode-json 'external-documentation v))) + obj)) + +;;; ── Example ───────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'example)) ht) + (let ((obj (make-instance 'example))) + (%set-when obj example-summary ht "summary") + (%set-when obj example-description ht "description") + (%set-when obj example-value ht "value") + (%set-when obj example-external-value ht "externalValue") + obj)) + +;;; ── Encoding ──────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'encoding)) ht) + (let ((obj (make-instance 'encoding))) + (%set-when obj encoding-content-type ht "contentType") + (%set-decoded obj encoding-headers ht "headers" + (lambda (headers) + (%decode-map headers #'%decode-header-or-ref))) + (%set-when obj encoding-style ht "style") + (%set-when obj encoding-explode ht "explode") + (%set-when obj encoding-allow-reserved ht "allowReserved") + obj)) + +;;; ── Media Type ────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'media-type)) ht) + (let ((obj (make-instance 'media-type))) + (%set-decoded obj media-type-schema ht "schema" + #'%decode-schema-or-ref) + (%set-when obj media-type-example ht "example") + (%set-decoded obj media-type-examples ht "examples" + (lambda (exs) + (%decode-map exs #'%decode-example-or-ref))) + (%set-decoded obj media-type-encoding ht "encoding" + (lambda (encs) + (%decode-map encs + (lambda (v) (json:decode-json 'encoding v))))) + obj)) + +;;; ── Parameter ─────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'parameter)) ht) + (when (gethash "$ref" ht) + (return-from json:decode-json + (make-instance 'reference :ref (gethash "$ref" ht)))) + (let ((obj (make-instance 'parameter))) + (%set-when obj parameter-name ht "name") + (%set-when obj parameter-in ht "in") + (%set-when obj parameter-description ht "description") + (%set-when obj parameter-required ht "required") + (%set-when obj parameter-deprecated ht "deprecated") + (%set-when obj parameter-allow-empty-value ht "allowEmptyValue") + (%set-when obj parameter-style ht "style") + (%set-when obj parameter-explode ht "explode") + (%set-when obj parameter-allow-reserved ht "allowReserved") + (%set-decoded obj parameter-schema ht "schema" + #'%decode-schema-or-ref) + (%set-when obj parameter-example ht "example") + (%set-decoded obj parameter-examples ht "examples" + (lambda (exs) + (%decode-map exs #'%decode-example-or-ref))) + (%set-decoded obj parameter-content ht "content" + (lambda (content) + (%decode-map content + (lambda (v) (json:decode-json 'media-type v))))) + obj)) + +;;; ── Header ────────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'header)) ht) + (when (gethash "$ref" ht) + (return-from json:decode-json + (make-instance 'reference :ref (gethash "$ref" ht)))) + (let ((obj (make-instance 'header))) + (%set-when obj header-description ht "description") + (%set-when obj header-required ht "required") + (%set-when obj header-deprecated ht "deprecated") + (%set-when obj header-allow-empty-value ht "allowEmptyValue") + (%set-when obj header-style ht "style") + (%set-when obj header-explode ht "explode") + (%set-when obj header-allow-reserved ht "allowReserved") + (%set-decoded obj header-schema ht "schema" + #'%decode-schema-or-ref) + (%set-when obj header-example ht "example") + (%set-decoded obj header-examples ht "examples" + (lambda (exs) + (%decode-map exs #'%decode-example-or-ref))) + (%set-decoded obj header-content ht "content" + (lambda (content) + (%decode-map content + (lambda (v) (json:decode-json 'media-type v))))) + obj)) + +;;; ── Request Body ──────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'request-body)) ht) + (when (gethash "$ref" ht) + (return-from json:decode-json + (make-instance 'reference :ref (gethash "$ref" ht)))) + (let ((obj (make-instance 'request-body))) + (%set-when obj request-body-description ht "description") + (%set-when obj request-body-required ht "required") + (%set-decoded obj request-body-content ht "content" + (lambda (content) + (%decode-map content + (lambda (v) (json:decode-json 'media-type v))))) + obj)) + +;;; ── Link ──────────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'link)) ht) + (when (gethash "$ref" ht) + (return-from json:decode-json + (make-instance 'reference :ref (gethash "$ref" ht)))) + (let ((obj (make-instance 'link))) + (%set-when obj link-operation-ref ht "operationRef") + (%set-when obj link-operation-id ht "operationId") + (%set-when obj link-parameters ht "parameters") + (%set-when obj link-request-body ht "requestBody") + (%set-when obj link-description ht "description") + (%set-decoded obj link-server ht "server" + (lambda (v) (json:decode-json 'server v))) + obj)) + +;;; ── Response ──────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'response)) ht) + (when (gethash "$ref" ht) + (return-from json:decode-json + (make-instance 'reference :ref (gethash "$ref" ht)))) + (let ((obj (make-instance 'response))) + (%set-when obj response-description ht "description") + (%set-decoded obj response-headers ht "headers" + (lambda (headers) + (%decode-map headers #'%decode-header-or-ref))) + (%set-decoded obj response-content ht "content" + (lambda (content) + (%decode-map content + (lambda (v) (json:decode-json 'media-type v))))) + (%set-decoded obj response-links ht "links" + (lambda (links) + (%decode-map links #'%decode-link-or-ref))) + obj)) + +;;; ── Operation ─────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'operation)) ht) + (let ((obj (make-instance 'operation))) + (%set-when obj operation-tags ht "tags") + (%set-when obj operation-summary ht "summary") + (%set-when obj operation-description ht "description") + (%set-when obj operation-id ht "operationId") + (%set-when obj operation-deprecated ht "deprecated") + (%set-when obj operation-security ht "security") + (%set-decoded obj operation-external-docs ht "externalDocs" + (lambda (v) (json:decode-json 'external-documentation v))) + (%set-decoded obj operation-parameters ht "parameters" + (lambda (params) + (%decode-array params #'%decode-param-or-ref))) + (%set-decoded obj operation-request-body ht "requestBody" + #'%decode-request-body-or-ref) + (%set-decoded obj operation-responses ht "responses" + (lambda (responses) + (%decode-map responses #'%decode-response-or-ref))) + (%set-decoded obj operation-callbacks ht "callbacks" + (lambda (cbs) + (%decode-map cbs + (lambda (v) + (%decode-or-ref v + (lambda (pi) + (%decode-map pi + (lambda (item) + (%decode-or-ref item (lambda (pi2) (json:decode-json 'path-item pi2))))))))))) + (%set-decoded obj operation-servers ht "servers" + (lambda (servers) + (%decode-array servers + (lambda (v) (json:decode-json 'server v))))) + obj)) + +;;; ── Path Item ─────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'path-item)) ht) + (let ((obj (make-instance 'path-item))) + (%set-when obj path-item-ref ht "$ref") + (%set-when obj path-item-summary ht "summary") + (%set-when obj path-item-description ht "description") + (flet ((decode-op (v) (json:decode-json 'operation v))) + (%set-decoded obj path-item-get ht "get" #'decode-op) + (%set-decoded obj path-item-put ht "put" #'decode-op) + (%set-decoded obj path-item-post ht "post" #'decode-op) + (%set-decoded obj path-item-delete ht "delete" #'decode-op) + (%set-decoded obj path-item-options ht "options" #'decode-op) + (%set-decoded obj path-item-head ht "head" #'decode-op) + (%set-decoded obj path-item-patch ht "patch" #'decode-op) + (%set-decoded obj path-item-trace ht "trace" #'decode-op)) + (%set-decoded obj path-item-servers ht "servers" + (lambda (servers) + (%decode-array servers + (lambda (v) (json:decode-json 'server v))))) + (%set-decoded obj path-item-parameters ht "parameters" + (lambda (params) + (%decode-array params #'%decode-param-or-ref))) + obj)) + +;;; ── Security Scheme ───────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'oauth-flow)) ht) + (let ((obj (make-instance 'oauth-flow))) + (%set-when obj oauth-flow-authorization-url ht "authorizationUrl") + (%set-when obj oauth-flow-token-url ht "tokenUrl") + (%set-when obj oauth-flow-refresh-url ht "refreshUrl") + (%set-when obj oauth-flow-scopes ht "scopes") + obj)) + +(defmethod json:decode-json ((type (eql 'oauth-flows)) ht) + (let ((obj (make-instance 'oauth-flows))) + (flet ((decode-flow (v) (json:decode-json 'oauth-flow v))) + (%set-decoded obj oauth-flows-implicit ht "implicit" #'decode-flow) + (%set-decoded obj oauth-flows-password ht "password" #'decode-flow) + (%set-decoded obj oauth-flows-client-credentials ht "clientCredentials" #'decode-flow) + (%set-decoded obj oauth-flows-authorization-code ht "authorizationCode" #'decode-flow)) + obj)) + +(defmethod json:decode-json ((type (eql 'security-scheme)) ht) + (when (gethash "$ref" ht) + (return-from json:decode-json + (make-instance 'reference :ref (gethash "$ref" ht)))) + (let ((obj (make-instance 'security-scheme))) + (%set-when obj security-scheme-type ht "type") + (%set-when obj security-scheme-description ht "description") + (%set-when obj security-scheme-name ht "name") + (%set-when obj security-scheme-in ht "in") + (%set-when obj security-scheme-scheme ht "scheme") + (%set-when obj security-scheme-bearer-format ht "bearerFormat") + (%set-when obj security-scheme-open-id-connect-url ht "openIdConnectUrl") + (%set-decoded obj security-scheme-flows ht "flows" + (lambda (v) (json:decode-json 'oauth-flows v))) + obj)) + +;;; ── Components ────────────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'components)) ht) + (let ((obj (make-instance 'components))) + (%set-decoded obj components-schemas ht "schemas" + (lambda (schemas) + (%decode-map schemas #'%decode-schema-or-ref))) + (%set-decoded obj components-responses ht "responses" + (lambda (responses) + (%decode-map responses #'%decode-response-or-ref))) + (%set-decoded obj components-parameters ht "parameters" + (lambda (params) + (%decode-map params #'%decode-param-or-ref))) + (%set-decoded obj components-examples ht "examples" + (lambda (exs) + (%decode-map exs #'%decode-example-or-ref))) + (%set-decoded obj components-request-bodies ht "requestBodies" + (lambda (rbs) + (%decode-map rbs #'%decode-request-body-or-ref))) + (%set-decoded obj components-headers ht "headers" + (lambda (headers) + (%decode-map headers #'%decode-header-or-ref))) + (%set-decoded obj components-security-schemes ht "securitySchemes" + (lambda (schemes) + (%decode-map schemes #'%decode-security-scheme-or-ref))) + (%set-decoded obj components-links ht "links" + (lambda (links) + (%decode-map links #'%decode-link-or-ref))) + (%set-decoded obj components-callbacks ht "callbacks" + (lambda (cbs) + (%decode-map cbs + (lambda (v) + (%decode-or-ref v + (lambda (pi) + (%decode-map pi + (lambda (item) + (%decode-or-ref item (lambda (pi2) (json:decode-json 'path-item pi2))))))))))) + obj)) + +;;; ── OpenAPI Document ──────────────────────────────────────────────────────── + +(defmethod json:decode-json ((type (eql 'openapi-document)) ht) + (let ((doc (make-instance 'openapi-document))) + (%set-when doc openapi-version ht "openapi") + (%set-decoded doc openapi-info ht "info" + (lambda (v) (json:decode-json 'info v))) + (%set-decoded doc openapi-servers ht "servers" + (lambda (servers) + (%decode-array servers + (lambda (v) (json:decode-json 'server v))))) + (%set-decoded doc openapi-paths ht "paths" + (lambda (paths) + (%decode-map paths + (lambda (v) + (%decode-or-ref v + (lambda (pi) (json:decode-json 'path-item pi))))))) + (%set-decoded doc openapi-components ht "components" + (lambda (v) (json:decode-json 'components v))) + (%set-when doc openapi-security ht "security") + (%set-decoded doc openapi-tags ht "tags" + (lambda (tags) + (%decode-array tags + (lambda (v) (json:decode-json 'tag v))))) + (%set-decoded doc openapi-external-docs ht "externalDocs" + (lambda (v) (json:decode-json 'external-documentation v))) + doc)) + +;;; ── Public API ────────────────────────────────────────────────────────────── + +(defun parse (input) + "Parse an OpenAPI 3.0 document from INPUT and return an OPENAPI-DOCUMENT. + +INPUT may be a JSON string, a character stream, or a binary (octet) stream. +Binary streams are decoded as UTF-8 via flexi-streams (delegated to cl-json). + +Example: + (cl-openapi:parse \"{\\\"openapi\\\":\\\"3.0.0\\\",\\\"info\\\":{...},...}\")" + (json:decode-json 'openapi-document (json:parse input))) diff --git a/package.lisp b/package.lisp index 3b0e818..1956e19 100644 --- a/package.lisp +++ b/package.lisp @@ -1,5 +1,259 @@ (defpackage #:cl-openapi (:use #:cl) - (:export)) + (:export + ;; Top-level entry point + #:parse + + ;; Document + #:openapi-document + #:openapi-version + #:openapi-info + #:openapi-servers + #:openapi-paths + #:openapi-components + #:openapi-security + #:openapi-tags + #:openapi-external-docs + + ;; Info + #:info + #:info-title + #:info-description + #:info-terms-of-service + #:info-contact + #:info-license + #:info-version + + ;; Contact + #:contact + #:contact-name + #:contact-url + #:contact-email + + ;; License + #:license + #:license-name + #:license-url + + ;; Server + #:server + #:server-url + #:server-description + #:server-variables + + ;; Server variable + #:server-variable + #:server-variable-enum + #:server-variable-default + #:server-variable-description + + ;; Components + #:components + #:components-schemas + #:components-responses + #:components-parameters + #:components-examples + #:components-request-bodies + #:components-headers + #:components-security-schemes + #:components-links + #:components-callbacks + + ;; Path item + #:path-item + #:path-item-ref + #:path-item-summary + #:path-item-description + #:path-item-get + #:path-item-put + #:path-item-post + #:path-item-delete + #:path-item-options + #:path-item-head + #:path-item-patch + #:path-item-trace + #:path-item-servers + #:path-item-parameters + + ;; Operation + #:operation + #:operation-tags + #:operation-summary + #:operation-description + #:operation-external-docs + #:operation-id + #:operation-parameters + #:operation-request-body + #:operation-responses + #:operation-callbacks + #:operation-deprecated + #:operation-security + #:operation-servers + + ;; External documentation + #:external-documentation + #:external-documentation-description + #:external-documentation-url + + ;; Parameter + #:parameter + #:parameter-name + #:parameter-in + #:parameter-description + #:parameter-required + #:parameter-deprecated + #:parameter-allow-empty-value + #:parameter-style + #:parameter-explode + #:parameter-allow-reserved + #:parameter-schema + #:parameter-example + #:parameter-examples + #:parameter-content + + ;; Request body + #:request-body + #:request-body-description + #:request-body-content + #:request-body-required + + ;; Media type + #:media-type + #:media-type-schema + #:media-type-example + #:media-type-examples + #:media-type-encoding + + ;; Encoding + #:encoding + #:encoding-content-type + #:encoding-headers + #:encoding-style + #:encoding-explode + #:encoding-allow-reserved + + ;; Response + #:response + #:response-description + #:response-headers + #:response-content + #:response-links + + ;; Example + #:example + #:example-summary + #:example-description + #:example-value + #:example-external-value + + ;; Link + #:link + #:link-operation-ref + #:link-operation-id + #:link-parameters + #:link-request-body + #:link-description + #:link-server + + ;; Header + #:header + #:header-description + #:header-required + #:header-deprecated + #:header-allow-empty-value + #:header-style + #:header-explode + #:header-allow-reserved + #:header-schema + #:header-example + #:header-examples + #:header-content + + ;; Tag + #:tag + #:tag-name + #:tag-description + #:tag-external-docs + + ;; Schema + #:schema + #:schema-ref + #:schema-title + #:schema-multiple-of + #:schema-maximum + #:schema-exclusive-maximum + #:schema-minimum + #:schema-exclusive-minimum + #:schema-max-length + #:schema-min-length + #:schema-pattern + #:schema-max-items + #:schema-min-items + #:schema-unique-items + #:schema-max-properties + #:schema-min-properties + #:schema-required + #:schema-enum + #:schema-type + #:schema-all-of + #:schema-one-of + #:schema-any-of + #:schema-not + #:schema-items + #:schema-properties + #:schema-additional-properties + #:schema-description + #:schema-format + #:schema-default + #:schema-nullable + #:schema-discriminator + #:schema-read-only + #:schema-write-only + #:schema-xml + #:schema-external-docs + #:schema-example + #:schema-deprecated + + ;; Discriminator + #:discriminator + #:discriminator-property-name + #:discriminator-mapping + + ;; XML + #:xml + #:xml-name + #:xml-namespace + #:xml-prefix + #:xml-attribute + #:xml-wrapped + + ;; Security scheme + #:security-scheme + #:security-scheme-type + #:security-scheme-description + #:security-scheme-name + #:security-scheme-in + #:security-scheme-scheme + #:security-scheme-bearer-format + #:security-scheme-flows + #:security-scheme-open-id-connect-url + + ;; OAuth flows + #:oauth-flows + #:oauth-flows-implicit + #:oauth-flows-password + #:oauth-flows-client-credentials + #:oauth-flows-authorization-code + + ;; OAuth flow + #:oauth-flow + #:oauth-flow-authorization-url + #:oauth-flow-token-url + #:oauth-flow-refresh-url + #:oauth-flow-scopes + + ;; Reference ($ref) + #:reference + #:reference-ref)) (in-package :cl-openapi) diff --git a/qlfile b/qlfile new file mode 100644 index 0000000..e1b85bd --- /dev/null +++ b/qlfile @@ -0,0 +1,2 @@ +github cl-json cl-sdk/cl-json +github meta-definitions cl-sdk/meta-definitions diff --git a/t/cl-openapi-tests.lisp b/t/cl-openapi-tests.lisp index 92756c0..959af43 100644 --- a/t/cl-openapi-tests.lisp +++ b/t/cl-openapi-tests.lisp @@ -5,3 +5,232 @@ (test sanity (is (= 1 1))) + +;;; ── helpers ───────────────────────────────────────────────────────────────── + +(defun minimal-doc () + "Return a minimal valid OpenAPI 3.0 document string." + "{\"openapi\":\"3.0.0\",\"info\":{\"title\":\"Test API\",\"version\":\"1.0.0\"},\"paths\":{}}") + +;;; ── parse ─────────────────────────────────────────────────────────────────── + +(test parse-returns-openapi-document + (let ((doc (cl-openapi:parse (minimal-doc)))) + (is (typep doc 'cl-openapi:openapi-document)))) + +(test parse-openapi-version + (let ((doc (cl-openapi:parse (minimal-doc)))) + (is (string= "3.0.0" (cl-openapi:openapi-version doc))))) + +;;; ── info ──────────────────────────────────────────────────────────────────── + +(test parse-info + (let* ((doc (cl-openapi:parse (minimal-doc))) + (info (cl-openapi:openapi-info doc))) + (is (typep info 'cl-openapi:info)) + (is (string= "Test API" (cl-openapi:info-title info))) + (is (string= "1.0.0" (cl-openapi:info-version info))))) + +(test parse-info-contact-and-license + (let* ((json "{\"openapi\":\"3.0.0\", + \"info\":{\"title\":\"A\",\"version\":\"0\", + \"contact\":{\"name\":\"Alice\",\"email\":\"a@example.com\"}, + \"license\":{\"name\":\"MIT\",\"url\":\"https://mit-license.org\"}}, + \"paths\":{}}") + (info (cl-openapi:openapi-info (cl-openapi:parse json)))) + (is (typep (cl-openapi:info-contact info) 'cl-openapi:contact)) + (is (string= "Alice" (cl-openapi:contact-name (cl-openapi:info-contact info)))) + (is (string= "a@example.com" (cl-openapi:contact-email (cl-openapi:info-contact info)))) + (is (typep (cl-openapi:info-license info) 'cl-openapi:license)) + (is (string= "MIT" (cl-openapi:license-name (cl-openapi:info-license info)))))) + +;;; ── servers ───────────────────────────────────────────────────────────────── + +(test parse-servers + (let* ((json "{\"openapi\":\"3.0.0\", + \"info\":{\"title\":\"A\",\"version\":\"0\"}, + \"servers\":[{\"url\":\"https://api.example.com\", + \"description\":\"Production\"}], + \"paths\":{}}") + (doc (cl-openapi:parse json)) + (servers (cl-openapi:openapi-servers doc))) + (is (= 1 (length servers))) + (let ((srv (aref servers 0))) + (is (typep srv 'cl-openapi:server)) + (is (string= "https://api.example.com" (cl-openapi:server-url srv))) + (is (string= "Production" (cl-openapi:server-description srv)))))) + +;;; ── paths ─────────────────────────────────────────────────────────────────── + +(test parse-paths-empty + (let* ((doc (cl-openapi:parse (minimal-doc))) + (paths (cl-openapi:openapi-paths doc))) + (is (hash-table-p paths)) + (is (zerop (hash-table-count paths))))) + +(test parse-path-item-get-operation + (let* ((json "{\"openapi\":\"3.0.0\", + \"info\":{\"title\":\"A\",\"version\":\"0\"}, + \"paths\":{\"/pets\":{\"get\":{\"operationId\":\"listPets\", + \"summary\":\"List all pets\", + \"responses\":{\"200\":{\"description\":\"OK\"}}}}}}") + (doc (cl-openapi:parse json)) + (path (gethash "/pets" (cl-openapi:openapi-paths doc))) + (get-op (cl-openapi:path-item-get path))) + (is (typep path 'cl-openapi:path-item)) + (is (typep get-op 'cl-openapi:operation)) + (is (string= "listPets" (cl-openapi:operation-id get-op))) + (is (string= "List all pets" (cl-openapi:operation-summary get-op))))) + +(test parse-operation-parameters + (let* ((json "{\"openapi\":\"3.0.0\", + \"info\":{\"title\":\"A\",\"version\":\"0\"}, + \"paths\":{\"/pets/{id}\":{\"get\":{ + \"operationId\":\"getPet\", + \"parameters\":[{\"name\":\"id\",\"in\":\"path\",\"required\":true, + \"schema\":{\"type\":\"integer\"}}], + \"responses\":{\"200\":{\"description\":\"OK\"}}}}}}") + (doc (cl-openapi:parse json)) + (op (cl-openapi:path-item-get + (gethash "/pets/{id}" (cl-openapi:openapi-paths doc)))) + (params (cl-openapi:operation-parameters op)) + (param (aref params 0))) + (is (= 1 (length params))) + (is (typep param 'cl-openapi:parameter)) + (is (string= "id" (cl-openapi:parameter-name param))) + (is (string= "path" (cl-openapi:parameter-in param))) + (is (eq t (cl-openapi:parameter-required param))))) + +(test parse-operation-request-body + (let* ((json "{\"openapi\":\"3.0.0\", + \"info\":{\"title\":\"A\",\"version\":\"0\"}, + \"paths\":{\"/pets\":{\"post\":{ + \"operationId\":\"createPet\", + \"requestBody\":{\"required\":true, + \"content\":{\"application/json\":{\"schema\":{\"type\":\"object\"}}}}, + \"responses\":{\"201\":{\"description\":\"Created\"}}}}}}") + (doc (cl-openapi:parse json)) + (op (cl-openapi:path-item-post + (gethash "/pets" (cl-openapi:openapi-paths doc)))) + (rb (cl-openapi:operation-request-body op))) + (is (typep rb 'cl-openapi:request-body)) + (is (eq t (cl-openapi:request-body-required rb))) + (is (hash-table-p (cl-openapi:request-body-content rb))) + (let ((mt (gethash "application/json" (cl-openapi:request-body-content rb)))) + (is (typep mt 'cl-openapi:media-type)) + (let ((schema (cl-openapi:media-type-schema mt))) + (is (typep schema 'cl-openapi:schema)) + (is (string= "object" (cl-openapi:schema-type schema))))))) + +;;; ── schemas ───────────────────────────────────────────────────────────────── + +(test parse-schema-basic + (let* ((json "{\"openapi\":\"3.0.0\", + \"info\":{\"title\":\"A\",\"version\":\"0\"}, + \"paths\":{}, + \"components\":{\"schemas\":{\"Pet\":{ + \"type\":\"object\", + \"required\":[\"id\",\"name\"], + \"properties\":{ + \"id\":{\"type\":\"integer\"}, + \"name\":{\"type\":\"string\"}}}}}}") + (doc (cl-openapi:parse json)) + (schemas (cl-openapi:components-schemas + (cl-openapi:openapi-components doc))) + (pet (gethash "Pet" schemas))) + (is (typep pet 'cl-openapi:schema)) + (is (string= "object" (cl-openapi:schema-type pet))) + (is (hash-table-p (cl-openapi:schema-properties pet))) + (let ((id-schema (gethash "id" (cl-openapi:schema-properties pet)))) + (is (typep id-schema 'cl-openapi:schema)) + (is (string= "integer" (cl-openapi:schema-type id-schema)))))) + +(test parse-schema-ref + (let* ((json "{\"openapi\":\"3.0.0\", + \"info\":{\"title\":\"A\",\"version\":\"0\"}, + \"paths\":{}, + \"components\":{\"schemas\":{ + \"Pets\":{\"type\":\"array\", + \"items\":{\"$ref\":\"#/components/schemas/Pet\"}}, + \"Pet\":{\"type\":\"object\"}}}}") + (doc (cl-openapi:parse json)) + (schemas (cl-openapi:components-schemas + (cl-openapi:openapi-components doc))) + (pets (gethash "Pets" schemas)) + (items (cl-openapi:schema-items pets))) + (is (typep pets 'cl-openapi:schema)) + (is (string= "array" (cl-openapi:schema-type pets))) + (is (typep items 'cl-openapi:reference)) + (is (string= "#/components/schemas/Pet" (cl-openapi:reference-ref items))))) + +(test parse-schema-composition + (let* ((json "{\"openapi\":\"3.0.0\", + \"info\":{\"title\":\"A\",\"version\":\"0\"}, + \"paths\":{}, + \"components\":{\"schemas\":{ + \"Combined\":{\"allOf\":[ + {\"type\":\"object\",\"properties\":{\"a\":{\"type\":\"string\"}}}, + {\"$ref\":\"#/components/schemas/Other\"} + ]}, + \"Other\":{\"type\":\"object\"}}}}") + (doc (cl-openapi:parse json)) + (schemas (cl-openapi:components-schemas + (cl-openapi:openapi-components doc))) + (combined (gethash "Combined" schemas)) + (all-of (cl-openapi:schema-all-of combined))) + (is (= 2 (length all-of))) + (is (typep (aref all-of 0) 'cl-openapi:schema)) + (is (typep (aref all-of 1) 'cl-openapi:reference)))) + +;;; ── components ────────────────────────────────────────────────────────────── + +(test parse-components-security-schemes + (let* ((json "{\"openapi\":\"3.0.0\", + \"info\":{\"title\":\"A\",\"version\":\"0\"}, + \"paths\":{}, + \"components\":{\"securitySchemes\":{ + \"bearerAuth\":{\"type\":\"http\",\"scheme\":\"bearer\", + \"bearerFormat\":\"JWT\"}}}}") + (doc (cl-openapi:parse json)) + (schemes (cl-openapi:components-security-schemes + (cl-openapi:openapi-components doc))) + (bearer (gethash "bearerAuth" schemes))) + (is (typep bearer 'cl-openapi:security-scheme)) + (is (string= "http" (cl-openapi:security-scheme-type bearer))) + (is (string= "bearer" (cl-openapi:security-scheme-scheme bearer))) + (is (string= "JWT" (cl-openapi:security-scheme-bearer-format bearer))))) + +(test parse-tags + (let* ((json "{\"openapi\":\"3.0.0\", + \"info\":{\"title\":\"A\",\"version\":\"0\"}, + \"paths\":{}, + \"tags\":[{\"name\":\"pets\",\"description\":\"Everything about pets\"}]}") + (doc (cl-openapi:parse json)) + (tags (cl-openapi:openapi-tags doc))) + (is (= 1 (length tags))) + (let ((tag (aref tags 0))) + (is (typep tag 'cl-openapi:tag)) + (is (string= "pets" (cl-openapi:tag-name tag))) + (is (string= "Everything about pets" (cl-openapi:tag-description tag)))))) + +;;; ── response ──────────────────────────────────────────────────────────────── + +(test parse-response + (let* ((json "{\"openapi\":\"3.0.0\", + \"info\":{\"title\":\"A\",\"version\":\"0\"}, + \"paths\":{\"/items\":{\"get\":{ + \"operationId\":\"getItems\", + \"responses\":{ + \"200\":{\"description\":\"OK\", + \"content\":{\"application/json\":{\"schema\":{\"type\":\"array\",\"items\":{\"type\":\"string\"}}}}}, + \"404\":{\"description\":\"Not Found\"}}}}}}") + (doc (cl-openapi:parse json)) + (op (cl-openapi:path-item-get + (gethash "/items" (cl-openapi:openapi-paths doc)))) + (resp-200 (gethash "200" (cl-openapi:operation-responses op))) + (resp-404 (gethash "404" (cl-openapi:operation-responses op)))) + (is (typep resp-200 'cl-openapi:response)) + (is (string= "OK" (cl-openapi:response-description resp-200))) + (is (typep resp-404 'cl-openapi:response)) + (is (string= "Not Found" (cl-openapi:response-description resp-404))))) + diff --git a/t/package.lisp b/t/package.lisp index 0bac507..c77ac15 100644 --- a/t/package.lisp +++ b/t/package.lisp @@ -1,4 +1,4 @@ (defpackage #:cl-openapi.test - (:use #:cl #:5am)) + (:use #:cl #:5am #:cl-openapi)) (in-package :cl-openapi.test) diff --git a/types.lisp b/types.lisp new file mode 100644 index 0000000..6d44f5a --- /dev/null +++ b/types.lisp @@ -0,0 +1,308 @@ +(in-package #:cl-openapi) + +;;; CLOS class definitions for the OpenAPI 3.0 Specification objects. +;;; +;;; Each class mirrors an object defined in the OAS 3.0 specification. +;;; Slots are named after the specification field names, converted to +;;; Lisp kebab-case. All slots have a corresponding accessor whose name +;;; is -. Slots are unbound by default; use SLOT-BOUNDP to +;;; test whether an optional field was present in the source document. + +;;; ── Reference Object ──────────────────────────────────────────────────────── + +(defclass reference () + ((ref :initarg :ref :accessor reference-ref)) + (:documentation "An OpenAPI Reference Object ($ref pointer).")) + +;;; ── Info Objects ──────────────────────────────────────────────────────────── + +(defclass contact () + ((name :initarg :name :accessor contact-name) + (url :initarg :url :accessor contact-url) + (email :initarg :email :accessor contact-email)) + (:documentation "Contact information for the exposed API.")) + +(defclass license () + ((name :initarg :name :accessor license-name) + (url :initarg :url :accessor license-url)) + (:documentation "License information for the exposed API.")) + +(defclass info () + ((title :initarg :title :accessor info-title) + (description :initarg :description :accessor info-description) + (terms-of-service :initarg :terms-of-service :accessor info-terms-of-service) + (contact :initarg :contact :accessor info-contact) + (license :initarg :license :accessor info-license) + (version :initarg :version :accessor info-version)) + (:documentation "Metadata about the API.")) + +;;; ── Server Objects ────────────────────────────────────────────────────────── + +(defclass server-variable () + ((enum :initarg :enum :accessor server-variable-enum) + (default :initarg :default :accessor server-variable-default) + (description :initarg :description :accessor server-variable-description)) + (:documentation "An object representing a Server Variable for server URL template substitution.")) + +(defclass server () + ((url :initarg :url :accessor server-url) + (description :initarg :description :accessor server-description) + (variables :initarg :variables :accessor server-variables)) + (:documentation "An object representing a Server.")) + +;;; ── External Documentation ────────────────────────────────────────────────── + +(defclass external-documentation () + ((description :initarg :description :accessor external-documentation-description) + (url :initarg :url :accessor external-documentation-url)) + (:documentation "Allows referencing an external resource for extended documentation.")) + +;;; ── Tag ───────────────────────────────────────────────────────────────────── + +(defclass tag () + ((name :initarg :name :accessor tag-name) + (description :initarg :description :accessor tag-description) + (external-docs :initarg :external-docs :accessor tag-external-docs)) + (:documentation "Adds metadata to a single tag used by the Operation Object.")) + +;;; ── Schema Objects ────────────────────────────────────────────────────────── + +(defclass discriminator () + ((property-name :initarg :property-name :accessor discriminator-property-name) + (mapping :initarg :mapping :accessor discriminator-mapping)) + (:documentation "Adds support for polymorphism by specifying the discriminator field.")) + +(defclass xml () + ((name :initarg :name :accessor xml-name) + (namespace :initarg :namespace :accessor xml-namespace) + (prefix :initarg :prefix :accessor xml-prefix) + (attribute :initarg :attribute :accessor xml-attribute) + (wrapped :initarg :wrapped :accessor xml-wrapped)) + (:documentation "Metadata that allows for more fine-tuned XML model definitions.")) + +(defclass schema () + (;; $ref + (ref :initarg :ref :accessor schema-ref) + ;; Metadata + (title :initarg :title :accessor schema-title) + (description :initarg :description :accessor schema-description) + (default :initarg :default :accessor schema-default) + (example :initarg :example :accessor schema-example) + (deprecated :initarg :deprecated :accessor schema-deprecated) + ;; Type + (type :initarg :type :accessor schema-type) + (format :initarg :format :accessor schema-format) + (nullable :initarg :nullable :accessor schema-nullable) + ;; Number constraints + (multiple-of :initarg :multiple-of :accessor schema-multiple-of) + (maximum :initarg :maximum :accessor schema-maximum) + (exclusive-maximum :initarg :exclusive-maximum :accessor schema-exclusive-maximum) + (minimum :initarg :minimum :accessor schema-minimum) + (exclusive-minimum :initarg :exclusive-minimum :accessor schema-exclusive-minimum) + ;; String constraints + (max-length :initarg :max-length :accessor schema-max-length) + (min-length :initarg :min-length :accessor schema-min-length) + (pattern :initarg :pattern :accessor schema-pattern) + ;; Array constraints + (max-items :initarg :max-items :accessor schema-max-items) + (min-items :initarg :min-items :accessor schema-min-items) + (unique-items :initarg :unique-items :accessor schema-unique-items) + (items :initarg :items :accessor schema-items) + ;; Object constraints + (max-properties :initarg :max-properties :accessor schema-max-properties) + (min-properties :initarg :min-properties :accessor schema-min-properties) + (required :initarg :required :accessor schema-required) + (properties :initarg :properties :accessor schema-properties) + (additional-properties :initarg :additional-properties :accessor schema-additional-properties) + ;; Enum + (enum :initarg :enum :accessor schema-enum) + ;; Composition + (all-of :initarg :all-of :accessor schema-all-of) + (one-of :initarg :one-of :accessor schema-one-of) + (any-of :initarg :any-of :accessor schema-any-of) + (not :initarg :not :accessor schema-not) + ;; Validation hints + (read-only :initarg :read-only :accessor schema-read-only) + (write-only :initarg :write-only :accessor schema-write-only) + ;; Extended + (discriminator :initarg :discriminator :accessor schema-discriminator) + (xml :initarg :xml :accessor schema-xml) + (external-docs :initarg :external-docs :accessor schema-external-docs)) + (:documentation "The Schema Object allows the definition of input and output data types.")) + +;;; ── Parameter / Header ────────────────────────────────────────────────────── + +(defclass parameter () + ((name :initarg :name :accessor parameter-name) + (in :initarg :in :accessor parameter-in) + (description :initarg :description :accessor parameter-description) + (required :initarg :required :accessor parameter-required) + (deprecated :initarg :deprecated :accessor parameter-deprecated) + (allow-empty-value :initarg :allow-empty-value :accessor parameter-allow-empty-value) + (style :initarg :style :accessor parameter-style) + (explode :initarg :explode :accessor parameter-explode) + (allow-reserved :initarg :allow-reserved :accessor parameter-allow-reserved) + (schema :initarg :schema :accessor parameter-schema) + (example :initarg :example :accessor parameter-example) + (examples :initarg :examples :accessor parameter-examples) + (content :initarg :content :accessor parameter-content)) + (:documentation "Describes a single operation parameter.")) + +(defclass header () + ((description :initarg :description :accessor header-description) + (required :initarg :required :accessor header-required) + (deprecated :initarg :deprecated :accessor header-deprecated) + (allow-empty-value :initarg :allow-empty-value :accessor header-allow-empty-value) + (style :initarg :style :accessor header-style) + (explode :initarg :explode :accessor header-explode) + (allow-reserved :initarg :allow-reserved :accessor header-allow-reserved) + (schema :initarg :schema :accessor header-schema) + (example :initarg :example :accessor header-example) + (examples :initarg :examples :accessor header-examples) + (content :initarg :content :accessor header-content)) + (:documentation "Follows the structure of the Parameter Object with some changes.")) + +;;; ── Example ───────────────────────────────────────────────────────────────── + +(defclass example () + ((summary :initarg :summary :accessor example-summary) + (description :initarg :description :accessor example-description) + (value :initarg :value :accessor example-value) + (external-value :initarg :external-value :accessor example-external-value)) + (:documentation "Example Object.")) + +;;; ── Encoding ──────────────────────────────────────────────────────────────── + +(defclass encoding () + ((content-type :initarg :content-type :accessor encoding-content-type) + (headers :initarg :headers :accessor encoding-headers) + (style :initarg :style :accessor encoding-style) + (explode :initarg :explode :accessor encoding-explode) + (allow-reserved :initarg :allow-reserved :accessor encoding-allow-reserved)) + (:documentation "A single encoding definition applied to a single schema property.")) + +;;; ── Media Type ────────────────────────────────────────────────────────────── + +(defclass media-type () + ((schema :initarg :schema :accessor media-type-schema) + (example :initarg :example :accessor media-type-example) + (examples :initarg :examples :accessor media-type-examples) + (encoding :initarg :encoding :accessor media-type-encoding)) + (:documentation "Each Media Type Object provides schema and examples for the media type.")) + +;;; ── Request Body ──────────────────────────────────────────────────────────── + +(defclass request-body () + ((description :initarg :description :accessor request-body-description) + (content :initarg :content :accessor request-body-content) + (required :initarg :required :accessor request-body-required)) + (:documentation "Describes a single request body.")) + +;;; ── Link ──────────────────────────────────────────────────────────────────── + +(defclass link () + ((operation-ref :initarg :operation-ref :accessor link-operation-ref) + (operation-id :initarg :operation-id :accessor link-operation-id) + (parameters :initarg :parameters :accessor link-parameters) + (request-body :initarg :request-body :accessor link-request-body) + (description :initarg :description :accessor link-description) + (server :initarg :server :accessor link-server)) + (:documentation "The Link object represents a possible design-time link for a response.")) + +;;; ── Response ──────────────────────────────────────────────────────────────── + +(defclass response () + ((description :initarg :description :accessor response-description) + (headers :initarg :headers :accessor response-headers) + (content :initarg :content :accessor response-content) + (links :initarg :links :accessor response-links)) + (:documentation "Describes a single response from an API Operation.")) + +;;; ── Operation ─────────────────────────────────────────────────────────────── + +(defclass operation () + ((tags :initarg :tags :accessor operation-tags) + (summary :initarg :summary :accessor operation-summary) + (description :initarg :description :accessor operation-description) + (external-docs :initarg :external-docs :accessor operation-external-docs) + (operation-id :initarg :operation-id :accessor operation-id) + (parameters :initarg :parameters :accessor operation-parameters) + (request-body :initarg :request-body :accessor operation-request-body) + (responses :initarg :responses :accessor operation-responses) + (callbacks :initarg :callbacks :accessor operation-callbacks) + (deprecated :initarg :deprecated :accessor operation-deprecated) + (security :initarg :security :accessor operation-security) + (servers :initarg :servers :accessor operation-servers)) + (:documentation "Describes a single API operation on a path.")) + +;;; ── Path Item ─────────────────────────────────────────────────────────────── + +(defclass path-item () + ((ref :initarg :ref :accessor path-item-ref) + (summary :initarg :summary :accessor path-item-summary) + (description :initarg :description :accessor path-item-description) + (get :initarg :get :accessor path-item-get) + (put :initarg :put :accessor path-item-put) + (post :initarg :post :accessor path-item-post) + (delete :initarg :delete :accessor path-item-delete) + (options :initarg :options :accessor path-item-options) + (head :initarg :head :accessor path-item-head) + (patch :initarg :patch :accessor path-item-patch) + (trace :initarg :trace :accessor path-item-trace) + (servers :initarg :servers :accessor path-item-servers) + (parameters :initarg :parameters :accessor path-item-parameters)) + (:documentation "Describes the operations available on a single path.")) + +;;; ── Security Scheme ───────────────────────────────────────────────────────── + +(defclass oauth-flow () + ((authorization-url :initarg :authorization-url :accessor oauth-flow-authorization-url) + (token-url :initarg :token-url :accessor oauth-flow-token-url) + (refresh-url :initarg :refresh-url :accessor oauth-flow-refresh-url) + (scopes :initarg :scopes :accessor oauth-flow-scopes)) + (:documentation "Configuration details for a supported OAuth Flow.")) + +(defclass oauth-flows () + ((implicit :initarg :implicit :accessor oauth-flows-implicit) + (password :initarg :password :accessor oauth-flows-password) + (client-credentials :initarg :client-credentials :accessor oauth-flows-client-credentials) + (authorization-code :initarg :authorization-code :accessor oauth-flows-authorization-code)) + (:documentation "Allows configuration of the supported OAuth Flows.")) + +(defclass security-scheme () + ((type :initarg :type :accessor security-scheme-type) + (description :initarg :description :accessor security-scheme-description) + (name :initarg :name :accessor security-scheme-name) + (in :initarg :in :accessor security-scheme-in) + (scheme :initarg :scheme :accessor security-scheme-scheme) + (bearer-format :initarg :bearer-format :accessor security-scheme-bearer-format) + (flows :initarg :flows :accessor security-scheme-flows) + (open-id-connect-url :initarg :open-id-connect-url :accessor security-scheme-open-id-connect-url)) + (:documentation "Defines a security scheme that can be used by the operations.")) + +;;; ── Components ────────────────────────────────────────────────────────────── + +(defclass components () + ((schemas :initarg :schemas :accessor components-schemas) + (responses :initarg :responses :accessor components-responses) + (parameters :initarg :parameters :accessor components-parameters) + (examples :initarg :examples :accessor components-examples) + (request-bodies :initarg :request-bodies :accessor components-request-bodies) + (headers :initarg :headers :accessor components-headers) + (security-schemes :initarg :security-schemes :accessor components-security-schemes) + (links :initarg :links :accessor components-links) + (callbacks :initarg :callbacks :accessor components-callbacks)) + (:documentation "Holds a set of reusable objects for different aspects of the OAS.")) + +;;; ── OpenAPI Document ──────────────────────────────────────────────────────── + +(defclass openapi-document () + ((openapi :initarg :openapi :accessor openapi-version) + (info :initarg :info :accessor openapi-info) + (servers :initarg :servers :accessor openapi-servers) + (paths :initarg :paths :accessor openapi-paths) + (components :initarg :components :accessor openapi-components) + (security :initarg :security :accessor openapi-security) + (tags :initarg :tags :accessor openapi-tags) + (external-docs :initarg :external-docs :accessor openapi-external-docs)) + (:documentation "The root document object of the OpenAPI document.")) From 29ead60259f4a6bb33dbc16182dc384799211b09 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Mon, 4 May 2026 00:18:59 +0000 Subject: [PATCH 2/3] Fix alignment of :in slot initargs in types and decode Agent-Logs-Url: https://github.com/cl-sdk/cl-openapi/sessions/a206de3d-d5bd-42bc-baf0-28fc745c370f Co-authored-by: diasbruno <362368+diasbruno@users.noreply.github.com> --- decode.lisp | 4 ++-- types.lisp | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/decode.lisp b/decode.lisp index d71e62e..51d99b9 100644 --- a/decode.lisp +++ b/decode.lisp @@ -305,7 +305,7 @@ (make-instance 'reference :ref (gethash "$ref" ht)))) (let ((obj (make-instance 'parameter))) (%set-when obj parameter-name ht "name") - (%set-when obj parameter-in ht "in") + (%set-when obj parameter-in ht "in") (%set-when obj parameter-description ht "description") (%set-when obj parameter-required ht "required") (%set-when obj parameter-deprecated ht "deprecated") @@ -489,7 +489,7 @@ (%set-when obj security-scheme-type ht "type") (%set-when obj security-scheme-description ht "description") (%set-when obj security-scheme-name ht "name") - (%set-when obj security-scheme-in ht "in") + (%set-when obj security-scheme-in ht "in") (%set-when obj security-scheme-scheme ht "scheme") (%set-when obj security-scheme-bearer-format ht "bearerFormat") (%set-when obj security-scheme-open-id-connect-url ht "openIdConnectUrl") diff --git a/types.lisp b/types.lisp index 6d44f5a..3a1b9bd 100644 --- a/types.lisp +++ b/types.lisp @@ -134,7 +134,7 @@ (defclass parameter () ((name :initarg :name :accessor parameter-name) - (in :initarg :in :accessor parameter-in) + (in :initarg :in :accessor parameter-in) (description :initarg :description :accessor parameter-description) (required :initarg :required :accessor parameter-required) (deprecated :initarg :deprecated :accessor parameter-deprecated) @@ -273,7 +273,7 @@ ((type :initarg :type :accessor security-scheme-type) (description :initarg :description :accessor security-scheme-description) (name :initarg :name :accessor security-scheme-name) - (in :initarg :in :accessor security-scheme-in) + (in :initarg :in :accessor security-scheme-in) (scheme :initarg :scheme :accessor security-scheme-scheme) (bearer-format :initarg :bearer-format :accessor security-scheme-bearer-format) (flows :initarg :flows :accessor security-scheme-flows) From 9eddb86f0f286ab8b9dec84cf3e812bc1edc28bd Mon Sep 17 00:00:00 2001 From: Bruno Dias Date: Sun, 3 May 2026 21:33:49 -0300 Subject: [PATCH 3/3] Install dependencies before run the tests. --- .github/workflows/ci.yml | 5 ++-- .gitignore | 1 + decode.lisp | 14 ++++----- flake.lock | 61 ++++++++++++++++++++++++++++++++++++++++ flake.nix | 46 ++++++++++++++++++++++++++++++ qlfile | 4 +-- qlfile.lock | 12 ++++++++ t/cl-openapi-tests.lisp | 2 ++ tests-runner.lisp | 10 +++---- 9 files changed, 138 insertions(+), 17 deletions(-) create mode 100644 .gitignore create mode 100644 flake.lock create mode 100644 flake.nix create mode 100644 qlfile.lock diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 7debda9..9903b82 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -55,10 +55,11 @@ jobs: echo .qlot/bin >> $GITHUB_PATH if: steps.cache.outputs.cache-hit == 'true' - - uses: 40ants/setup-lisp@v2 + - uses: 40ants/setup-lisp@v4 if: steps.cache.outputs.cache-hit != 'true' - name: run run: | ros use sbcl - LISP="qlot exec ros run --" make tests 2> /dev/null + qlot install + LISP="ros run --" make tests 2> /dev/null diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..ae40749 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +.qlot/ diff --git a/decode.lisp b/decode.lisp index 51d99b9..a92adbf 100644 --- a/decode.lisp +++ b/decode.lisp @@ -427,10 +427,10 @@ (%decode-map cbs (lambda (v) (%decode-or-ref v - (lambda (pi) - (%decode-map pi + (lambda (aa) + (%decode-map aa (lambda (item) - (%decode-or-ref item (lambda (pi2) (json:decode-json 'path-item pi2))))))))))) + (%decode-or-ref item (lambda (bb) (json:decode-json 'path-item bb))))))))))) (%set-decoded obj operation-servers ht "servers" (lambda (servers) (%decode-array servers @@ -530,10 +530,10 @@ (%decode-map cbs (lambda (v) (%decode-or-ref v - (lambda (pi) - (%decode-map pi + (lambda (aa) + (%decode-map aa (lambda (item) - (%decode-or-ref item (lambda (pi2) (json:decode-json 'path-item pi2))))))))))) + (%decode-or-ref item (lambda (bb) (json:decode-json 'path-item bb))))))))))) obj)) ;;; ── OpenAPI Document ──────────────────────────────────────────────────────── @@ -552,7 +552,7 @@ (%decode-map paths (lambda (v) (%decode-or-ref v - (lambda (pi) (json:decode-json 'path-item pi))))))) + (lambda (aa) (json:decode-json 'path-item aa))))))) (%set-decoded doc openapi-components ht "components" (lambda (v) (json:decode-json 'components v))) (%set-when doc openapi-security ht "security") diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..317fe33 --- /dev/null +++ b/flake.lock @@ -0,0 +1,61 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1731533236, + "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1777673416, + "narHash": "sha256-5c2POKPOjU40Kh0MirOdScBLG0bu9TAuPYAtPRNZMBs=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "26ef669cffa904b6f6832ab57b77892a37c1a671", + "type": "github" + }, + "original": { + "owner": "nixos", + "ref": "nixos-25.11", + "repo": "nixpkgs", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..dc36c66 --- /dev/null +++ b/flake.nix @@ -0,0 +1,46 @@ +{ + description = "cl-openapi"; + + inputs = { + nixpkgs.url = "github:nixos/nixpkgs?ref=nixos-25.11"; + flake-utils.url = "github:numtide/flake-utils"; + }; + + outputs = { self, nixpkgs, flake-utils }: + flake-utils.lib.eachDefaultSystem (system: + let + pkgs = import nixpkgs { inherit system; }; + + quicklisp = pkgs.fetchurl { + url = "https://beta.quicklisp.org/quicklisp.lisp"; + sha256 = "4a7a5c2aebe0716417047854267397e24a44d0cce096127411e9ce9ccfeb2c17"; + }; + in + { + devShells.default = pkgs.mkShell { + packages = [ + pkgs.sbcl + pkgs.roswell + pkgs.sbclPackages.qlot + pkgs.sbclPackages.qlot-cli + pkgs.git + ]; + + shellHook = '' + export QUICKLISP_HOME=$PWD/.quicklisp + + if [ ! -d "$QUICKLISP_HOME" ]; then + echo "Installing Quicklisp locally..." + sbcl --non-interactive \ + --load ${quicklisp} \ + --eval "(quicklisp-quickstart:install :path \"$QUICKLISP_HOME\")" \ + --eval "(ql:add-to-init-file)" \ + --quit + fi + + echo "SBCL + Quicklisp ready" + echo "Run: sbcl" + ''; + }; + }); +} diff --git a/qlfile b/qlfile index e1b85bd..6691243 100644 --- a/qlfile +++ b/qlfile @@ -1,2 +1,2 @@ -github cl-json cl-sdk/cl-json -github meta-definitions cl-sdk/meta-definitions +github cl-json cl-sdk/cl-json :branch main +github meta-definitions cl-sdk/meta-definitions :branch main diff --git a/qlfile.lock b/qlfile.lock new file mode 100644 index 0000000..7d16083 --- /dev/null +++ b/qlfile.lock @@ -0,0 +1,12 @@ +("quicklisp" . + (:class qlot/source/dist:source-dist + :initargs (:distribution "https://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest) + :version "2026-01-01")) +("cl-json" . + (:class qlot/source/github:source-github + :initargs (:repos "cl-sdk/cl-json" :ref nil :branch "main" :tag nil) + :version "github-1302ed661ebb365842920c21b54d82393bd1e2f9")) +("meta-definitions" . + (:class qlot/source/github:source-github + :initargs (:repos "cl-sdk/meta-definitions" :ref nil :branch "main" :tag nil) + :version "github-41e5c29f68181d0d6eee0a627b94b70ab2402019")) diff --git a/t/cl-openapi-tests.lisp b/t/cl-openapi-tests.lisp index 959af43..fc6bff1 100644 --- a/t/cl-openapi-tests.lisp +++ b/t/cl-openapi-tests.lisp @@ -1,3 +1,5 @@ +(in-package :cl-openapi.test) + (def-suite cl-openapi-suite :description "Test suite for cl-openapi.") diff --git a/tests-runner.lisp b/tests-runner.lisp index 66e644a..47ae22b 100644 --- a/tests-runner.lisp +++ b/tests-runner.lisp @@ -1,12 +1,10 @@ (push *default-pathname-defaults* ql:*local-project-directories*) -(asdf:oos 'asdf:load-op :cl-openapi.test :force t) +(setf asdf/source-registry::*source-registry-file* #P"./.qlot/") -(setf *debugger-hook* - (lambda (c h) - (declare (ignore c h)) - (uiop:quit -1)) - 5am:*on-error* nil) +(asdf:initialize-source-registry) + +(ql:quickload :cl-openapi.test) (unless (5am:run-all-tests) (uiop:quit -1))