├── .github └── workflows │ └── test.yml ├── .gitignore ├── README.markdown ├── apispec.asd ├── examples ├── api.yaml └── ningle │ └── app.lisp ├── src ├── body.lisp ├── body │ ├── encoder.lisp │ ├── encoder │ │ ├── custom.lisp │ │ └── json.lisp │ ├── errors.lisp │ ├── parser.lisp │ └── parser │ │ ├── json.lisp │ │ ├── multipart.lisp │ │ └── urlencoded.lisp ├── classes │ ├── encoding.lisp │ ├── encoding │ │ ├── class.lisp │ │ ├── errors.lisp │ │ └── parse.lisp │ ├── header.lisp │ ├── media-type.lisp │ ├── media-type │ │ ├── class.lisp │ │ └── parse.lisp │ ├── operation.lisp │ ├── parameter.lisp │ ├── parameter │ │ ├── class.lisp │ │ ├── errors.lisp │ │ └── parse.lisp │ ├── path.lisp │ ├── request-body.lisp │ ├── request-body │ │ ├── class.lisp │ │ ├── errors.lisp │ │ └── parse.lisp │ ├── response.lisp │ ├── response │ │ ├── class.lisp │ │ ├── encode.lisp │ │ └── errors.lisp │ ├── schema.lisp │ └── schema │ │ ├── coerce.lisp │ │ ├── composition.lisp │ │ ├── core.lisp │ │ ├── errors.lisp │ │ └── validate.lisp ├── complex.lisp ├── errors.lisp ├── file-loader.lisp ├── main.lisp ├── router.lisp ├── utils.lisp └── utils │ ├── media-type.lisp │ └── path-template.lisp └── tests ├── body └── encode.lisp ├── classes ├── encoding.lisp ├── header.lisp ├── media-type.lisp ├── operation.lisp ├── parameter.lisp ├── path.lisp ├── request-body.lisp ├── response.lisp └── schema │ ├── coerce.lisp │ ├── core.lisp │ └── validate.lisp ├── complex.lisp ├── example.yaml ├── file-loader.lisp ├── router.lisp └── utils.lisp /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [ '*' ] 6 | pull_request: 7 | branches: [ '*' ] 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | 13 | steps: 14 | - uses: actions/checkout@v2 15 | with: 16 | path: ./apispec 17 | - name: Install Roswell 18 | env: 19 | LISP: ${{ matrix.lisp }} 20 | run: | 21 | curl -L https://raw.githubusercontent.com/roswell/roswell/master/scripts/install-for-ci.sh | sh 22 | - name: Install Rove 23 | run: ros install rove 24 | - name: Run tests 25 | run: | 26 | PATH="~/.roswell/bin:$PATH" 27 | mkdir -p ~/.roswell/local-projects/cxxxr 28 | mv $GITHUB_WORKSPACE/apispec ~/.roswell/local-projects/cxxxr/apispec 29 | cd ~/.roswell/local-projects/cxxxr/apispec 30 | rove apispec.asd 31 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | report 3 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | # apispec 2 | 3 | [![Build Status](https://travis-ci.org/fukamachi/apispec.svg?branch=master)](https://travis-ci.org/fukamachi/apispec) 4 | [![Coverage Status](https://coveralls.io/repos/fukamachi/apispec/badge.svg?branch=master)](https://coveralls.io/r/fukamachi/apispec) 5 | 6 | A Common Lisp library for handling Web API specifications. This allows to validate and parse HTTP request headers, parameters and bodies with OpenAPI3 specification. 7 | 8 | ## Warning 9 | 10 | This software is still ALPHA quality. The APIs will be likely to change. 11 | 12 | ## Prerequisite 13 | 14 | * [libyaml](http://pyyaml.org/wiki/LibYAML) for loading OpenAPI spec files. 15 | 16 | ## Usage 17 | 18 | ### Loading specification file 19 | 20 | ```common-lisp 21 | (defvar *spec* 22 | (apispec:load-from-file #P"docs/api.yaml")) 23 | 24 | (apispec:spec-version *spec*) 25 | ;=> "3.0.2" 26 | ``` 27 | 28 | ### Getting the operation 29 | 30 | ```common-lisp 31 | (defvar *router* (apispec:spec-router *spec*)) 32 | 33 | (apispec:find-route *router* :GET "/users/12") 34 | ;=> # 35 | ``` 36 | 37 | ### Parsing and Validating HTTP requests 38 | 39 | ```common-lisp 40 | (import '(lack.request:request-query-parameters 41 | lack.request:request-body-parameters 42 | lack.request:request-cookies 43 | apispec:request-path-parameters)) 44 | 45 | ;; Clack application 46 | (defvar *app* 47 | (lambda (env) 48 | (multiple-value-bind (operation path-parameters) 49 | (apispec:find-route (spec-router *spec*) 50 | (getf env :request-method) 51 | (getf env :path-info)) 52 | ;; Getting Lack.Request 53 | (let ((request (apispec:validate-request operation env 54 | :path-parameters path-parameters))) 55 | ;; Write the main application here. 56 | 57 | ;; Accessors for getting each parameters. 58 | (request-query-parameters request) ;=> Query parameters (alist) 59 | (request-body-parameters request) ;=> Body parameters (alist) 60 | (request-path-parameters request) ;=> Path parameters (alist) 61 | (request-cookies) ;=> Cookie parameters (alist) 62 | 63 | )))) 64 | 65 | ;; Start the server 66 | (clack:clackup *app*) 67 | ``` 68 | 69 | ### Validating and Encoding HTTP responses 70 | 71 | ```common-lisp 72 | (import 'lack.response:make-response) 73 | 74 | (apispec:validate-response operation 75 | (make-response 200 76 | '(:content-type "application/json") 77 | '(("id" . 3) 78 | ("name" . "初音ミク") 79 | ("is_admin" . nil)))) 80 | ;=> (200 (:CONTENT-TYPE "application/json") ("{\"id\":3,\"name\":\"初音ミク\",\"is_admin\":false}")) 81 | ``` 82 | 83 | ### Custom Encoder for standard objects 84 | 85 | ```common-lisp 86 | (import 'lack.response:make-response) 87 | 88 | ;; Custom class 89 | (defclass user () 90 | ((id :initarg :id) 91 | (name :initarg :name) 92 | (is-admin :initarg :is-admin))) 93 | 94 | ;; Define APISPEC:ENCODE-OBJECT for the class 95 | (defmethod apispec:encode-object ((user user)) 96 | `(("id" . ,(slot-value user 'id)) 97 | ("name" . ,(slot-value user 'name)) 98 | ("is_admin" . ,(slot-value user 'is-admin)))) 99 | 100 | (defvar *yukari* 101 | (make-instance 'user 102 | :id 14 103 | :name "結月ゆかり" 104 | :is-admin nil)) 105 | 106 | (apispec:validate-response operation 107 | (make-response 200 108 | '(:content-type "application/json") 109 | *yukari*)) 110 | ;=> (200 (:CONTENT-TYPE "application/json") ("{\"id\":14,\"name\":\"結月ゆかり\",\"is_admin\":false}")) 111 | ``` 112 | 113 | ## Examples 114 | 115 | See [examples/](examples/). 116 | 117 | ## See Also 118 | 119 | * [OpenAPI Specification](https://github.com/OAI/OpenAPI-Specification) 120 | * [Lack](https://github.com/fukamachi/lack) 121 | 122 | ## Author 123 | 124 | * Eitaro Fukamachi (e.arrows@gmail.com) 125 | 126 | ## Copyright 127 | 128 | Copyright (c) 2019 Eitaro Fukamachi (e.arrows@gmail.com) 129 | 130 | ## License 131 | 132 | Licensed under the BSD 3-Clause License. 133 | -------------------------------------------------------------------------------- /apispec.asd: -------------------------------------------------------------------------------- 1 | (defsystem "apispec" 2 | :class :package-inferred-system 3 | :version "0.1.0" 4 | :author "Eitaro Fukamachi" 5 | :license "BSD 3-Clause" 6 | :description "API request / response validations" 7 | :depends-on ("openapi-parser" 8 | "apispec/main") 9 | :pathname "src" 10 | :in-order-to ((test-op (test-op "apispec/tests")))) 11 | 12 | (register-system-packages "lack-request" '(#:lack.request)) 13 | (register-system-packages "lack-response" '(#:lack.response)) 14 | (asdf:register-system-packages "openapi-parser" '(#:openapi-parser 15 | #:openapi-parser/schema 16 | #:openapi-parser/schema/3/interface)) 17 | 18 | (defsystem "apispec/tests" 19 | :depends-on ("apispec" 20 | "cl-interpol" 21 | "assoc-utils" 22 | "rove") 23 | :pathname "tests" 24 | :components 25 | ((:module "classes" 26 | :components 27 | ((:module "schema" 28 | :components 29 | ((:file "core") 30 | (:file "coerce") 31 | (:file "validate"))) 32 | (:file "header") 33 | (:file "encoding") 34 | (:file "parameter") 35 | (:file "request-body") 36 | (:file "media-type") 37 | (:file "response") 38 | (:file "path") 39 | (:file "operation"))) 40 | (:file "complex") 41 | (:module "body" 42 | :components 43 | ((:file "encode"))) 44 | (:file "router") 45 | (:file "file-loader") 46 | (:file "utils")) 47 | :perform (test-op (o c) (symbol-call :rove '#:run c :style :dot))) 48 | -------------------------------------------------------------------------------- /examples/api.yaml: -------------------------------------------------------------------------------- 1 | openapi: '3.0.1' 2 | info: 3 | description: >- 4 | Sample RESTful APIs 5 | title: Sample RESTful APIs 6 | version: 0.9.1 7 | paths: 8 | /users: 9 | get: 10 | summary: Show a list of users. 11 | parameters: 12 | - name: name 13 | in: query 14 | description: Search by user names 15 | schema: 16 | type: string 17 | responses: 18 | '200': 19 | description: Successfully returns a list of users. 20 | content: 21 | application/json: 22 | schema: 23 | type: array 24 | items: 25 | $ref: '#/components/schemas/User' 26 | post: 27 | summary: Create a new user. 28 | requestBody: 29 | content: 30 | application/json: 31 | schema: 32 | properties: 33 | name: 34 | type: string 35 | is_admin: 36 | type: boolean 37 | required: [name] 38 | responses: 39 | '204': 40 | description: Successfully created a new user. 41 | /users/{id}: 42 | get: 43 | summary: Get an information of the specified user. 44 | parameters: 45 | - name: id 46 | in: path 47 | required: true 48 | schema: 49 | type: integer 50 | responses: 51 | '200': 52 | description: Successfully returns a user. 53 | content: 54 | application/json: 55 | schema: 56 | $ref: '#/components/schemas/User' 57 | '404': 58 | description: No user found 59 | content: 60 | application/json: 61 | schema: 62 | properties: 63 | error: 64 | type: string 65 | components: 66 | schemas: 67 | User: 68 | properties: 69 | id: 70 | type: integer 71 | name: 72 | type: string 73 | is_admin: 74 | type: boolean 75 | -------------------------------------------------------------------------------- /examples/ningle/app.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Usage: 3 | $ cd examples/ 4 | $ clackup -s apispec -s ningle ningle/app.lisp 5 | |# 6 | 7 | (defpackage #:apispec/examples/ningle/app 8 | (:use #:cl) 9 | (:import-from #:apispec 10 | #:find-route 11 | #:spec-router 12 | #:validate-request 13 | #:validate-response 14 | #:request-path-parameters) 15 | (:import-from #:ningle 16 | #:*request* 17 | #:*response*) 18 | (:import-from #:lack.component 19 | #:call) 20 | (:import-from #:lack.response 21 | #:response-body 22 | #:response-headers 23 | #:response-status) 24 | (:import-from #:assoc-utils 25 | #:aget) 26 | (:export #:*app*)) 27 | (in-package #:apispec/examples/ningle/app) 28 | 29 | (defclass web (ningle:app) 30 | ((spec :initarg :spec))) 31 | 32 | (defvar *operation*) 33 | 34 | (defmethod ningle:make-request ((app web) env) 35 | (if *operation* 36 | (apispec:validate-request *operation* env 37 | :path-parameters (getf env :apispec.path-parameters)) 38 | (call-next-method))) 39 | 40 | (defmethod ningle:process-response ((app web) result) 41 | (if *operation* 42 | (progn 43 | (when result 44 | (setf (response-body *response*) result)) 45 | (call-next-method app 46 | (apispec:validate-response *operation* *response*))) 47 | (call-next-method))) 48 | 49 | (defmethod call :around ((app web) env) 50 | (multiple-value-bind (*operation* path-parameters) 51 | (apispec:find-route (spec-router (slot-value app 'spec)) 52 | (getf env :request-method) 53 | (getf env :path-info)) 54 | (call-next-method app 55 | (append (list :apispec.path-parameters path-parameters) 56 | env)))) 57 | 58 | (defparameter *app* 59 | (make-instance 'web 60 | :spec (apispec:load-from-file #P"api.yaml"))) 61 | 62 | (defvar *db* '()) 63 | (defvar *id* 0) 64 | 65 | (defclass user () 66 | ((id :initform (incf *id*) 67 | :reader user-id) 68 | (name :initarg :name 69 | :reader user-name) 70 | (is-admin :initarg :is-admin 71 | :initform nil 72 | :reader user-admin-p))) 73 | 74 | (defmethod apispec:encode-object ((user user)) 75 | `(("id" . ,(user-id user)) 76 | ("name" . ,(user-name user)) 77 | ("is_admin" . ,(user-admin-p user)))) 78 | 79 | (setf (ningle:route *app* "/users" :method :GET) 80 | (lambda (params) 81 | (let ((name (aget params "name"))) 82 | (setf (response-headers *response*) 83 | '(:content-type "application/json")) 84 | (if name 85 | (remove-if-not 86 | (lambda (user) 87 | (search name (user-name user))) 88 | *db*) 89 | *db*)))) 90 | 91 | (setf (ningle:route *app* "/users" :method :POST) 92 | (lambda (params) 93 | (let ((new-user 94 | (make-instance 'user 95 | :name (aget params "name") 96 | :is-admin (aget params "is_admin")))) 97 | (push new-user *db*) 98 | (setf (response-status *response*) 204) 99 | (values)))) 100 | 101 | (setf (ningle:route *app* "/users/:id" :method :GET) 102 | (lambda (params) 103 | (declare (ignore params)) 104 | (let* ((id (aget (request-path-parameters *request*) "id")) 105 | (user (find id *db* :key #'user-id))) 106 | (or user 107 | (progn 108 | (setf (response-status *response*) 404) 109 | '(("error" . "User not found"))))))) 110 | 111 | *app* 112 | -------------------------------------------------------------------------------- /src/body.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:apispec/body 2 | (:use-reexport #:apispec/body/parser 3 | #:apispec/body/encoder 4 | #:apispec/body/errors)) 5 | -------------------------------------------------------------------------------- /src/body/encoder.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/body/encoder 2 | (:use #:cl) 3 | (:import-from #:apispec/body/encoder/json 4 | #:encode-data-to-json) 5 | (:import-from #:apispec/body/encoder/custom 6 | #:encode-object) 7 | (:import-from #:alexandria 8 | #:starts-with-subseq) 9 | (:export #:encode-data 10 | #:encode-object)) 11 | (in-package #:apispec/body/encoder) 12 | 13 | (defun encode-data (value schema content-type) 14 | (check-type content-type string) 15 | (cond 16 | ((starts-with-subseq "application/json" content-type) 17 | (with-output-to-string (*standard-output*) 18 | (encode-data-to-json (encode-object value) schema))) 19 | (t (encode-object value)))) 20 | -------------------------------------------------------------------------------- /src/body/encoder/custom.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/body/encoder/custom 2 | (:use #:cl) 3 | (:export #:encode-object)) 4 | (in-package #:apispec/body/encoder/custom) 5 | 6 | (defgeneric encode-object (value) 7 | (:method (value) 8 | (typecase value 9 | ((or standard-object 10 | structure-object) (call-next-method)) 11 | (otherwise value)))) 12 | -------------------------------------------------------------------------------- /src/body/encoder/json.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/body/encoder/json 2 | (:use #:cl 3 | #:apispec/body/errors) 4 | (:import-from #:apispec/body/encoder/custom 5 | #:encode-object) 6 | (:import-from #:apispec/classes/schema 7 | #:object 8 | #:binary 9 | #:object-properties 10 | #:schema-nullable-p 11 | #:property-name 12 | #:property-type) 13 | (:shadowing-import-from #:apispec/classes/schema 14 | #:schema 15 | #:number 16 | #:string 17 | #:boolean 18 | #:array 19 | #:array-items) 20 | (:import-from #:assoc-utils 21 | #:delete-from-alist) 22 | (:export #:encode-data-to-json)) 23 | (in-package #:apispec/body/encoder/json) 24 | 25 | (declaim (ftype (function (t schema)) encode-data-to-json)) 26 | 27 | (defvar *empty* '#:empty) 28 | 29 | (defun encode-json-object (value schema) 30 | (setf value (encode-object value)) 31 | (write-char #\{) 32 | (let ((rest-value (copy-seq value)) 33 | missing) 34 | (loop for (prop . rest) on (object-properties schema) 35 | for name = (property-name prop) 36 | for (key . field-value) = (assoc name rest-value :test #'string=) 37 | if (and (null key) 38 | (not (schema-nullable-p (property-type prop)))) 39 | do (push name missing) 40 | else 41 | do (prin1 name) 42 | (write-char #\:) 43 | (encode-data-to-json field-value (property-type prop)) 44 | (setf rest-value (delete-from-alist rest-value name)) 45 | when rest 46 | do (write-char #\,)) 47 | (when (or missing rest-value) 48 | (error 'body-encode-object-error 49 | :value value 50 | :schema schema 51 | :missing (nreverse missing) 52 | :unpermitted (mapcar #'car rest-value)))) 53 | (write-char #\}) 54 | (values)) 55 | 56 | (defun encode-json-array (value schema) 57 | (let ((items-schema (array-items schema))) 58 | (write-char #\[) 59 | (if (listp value) 60 | (mapl (lambda (items) 61 | (encode-data-to-json (first items) items-schema) 62 | (when (rest items) 63 | (write-char #\,))) 64 | value) 65 | (loop with first = t 66 | for item across value 67 | do (unless first 68 | (write-char #\,)) 69 | (setf first nil) 70 | (encode-data-to-json item items-schema))) 71 | (write-char #\]))) 72 | 73 | (defun encode-json-boolean (value) 74 | (princ (cond 75 | ((eq value t) "true") 76 | ((eq value nil) "false") 77 | (t (error 'body-encode-error 78 | :value value 79 | :schema (schema boolean))))) 80 | (values)) 81 | 82 | (defun encode-data-to-json (value schema) 83 | (typecase schema 84 | (object (encode-json-object value schema)) 85 | (array (encode-json-array value schema)) 86 | (boolean (encode-json-boolean value)) 87 | (binary (error "Can't encode binary data to JSON")) 88 | (otherwise 89 | (typecase value 90 | (null 91 | (if (schema-nullable-p schema) 92 | (princ "null") 93 | ;; Not nullable error 94 | (error 'body-encode-error 95 | :value value 96 | :schema schema))) 97 | (otherwise (jojo:with-output (*standard-output*) 98 | (jojo:%to-json value)))))) 99 | (values)) 100 | -------------------------------------------------------------------------------- /src/body/errors.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/body/errors 2 | (:use #:cl 3 | #:apispec/errors) 4 | (:export #:body-parse-error 5 | #:body-encode-error 6 | #:body-encode-object-error)) 7 | (in-package #:apispec/body/errors) 8 | 9 | (define-condition body-parse-error (apispec-error) 10 | ((value :initarg :value) 11 | (content-type :initarg :content-type)) 12 | (:report (lambda (condition stream) 13 | (with-slots (value content-type) condition 14 | (format stream "Failed to parse ~A as Content-Type '~A'" 15 | value content-type))))) 16 | 17 | (define-condition body-encode-error (apispec-error) 18 | ((value :initarg :value) 19 | (schema :initarg :schema)) 20 | (:report (lambda (condition stream) 21 | (with-slots (value schema missing unpermitted) condition 22 | (format stream "~S is invalid for ~A" 23 | value schema))))) 24 | 25 | (define-condition body-encode-object-error (body-encode-error) 26 | ((missing :initarg :missing 27 | :initform nil) 28 | (unpermitted :initarg :unpermitted 29 | :initform nil)) 30 | (:report (lambda (condition stream) 31 | (with-slots (value schema missing unpermitted) condition 32 | (format stream "~S is invalid for ~A~@[:~% missing: ~{~A~^, ~}~]~@[~% unpermitted: ~{~A~^, ~}~]" 33 | value schema 34 | missing unpermitted))))) 35 | -------------------------------------------------------------------------------- /src/body/parser.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/body/parser 2 | (:use #:cl 3 | #:apispec/body/parser/json 4 | #:apispec/body/parser/urlencoded 5 | #:apispec/body/parser/multipart 6 | #:apispec/body/errors) 7 | (:import-from #:apispec/utils 8 | #:detect-charset 9 | #:slurp-stream) 10 | (:import-from #:babel) 11 | (:import-from #:alexandria 12 | #:starts-with-subseq) 13 | (:export #:parse-body)) 14 | (in-package #:apispec/body/parser) 15 | 16 | (defun parse-body (value content-type &optional content-length) 17 | (check-type value (or string stream)) 18 | (check-type content-type string) 19 | (check-type content-length (or integer null)) 20 | (handler-bind ((error 21 | (lambda (e) 22 | (error 'body-parse-error 23 | :value value 24 | :content-type content-type)))) 25 | (cond 26 | ((starts-with-subseq "application/json" (string-downcase content-type)) 27 | (etypecase value 28 | (string (parse-json-string value content-type)) 29 | (stream (parse-json-stream value content-type content-length)))) 30 | ((starts-with-subseq "application/x-www-form-urlencoded" (string-downcase content-type)) 31 | (etypecase value 32 | (string (parse-urlencoded-string value)) 33 | (stream (parse-urlencoded-stream value content-length)))) 34 | ((starts-with-subseq "multipart/" (string-downcase content-type)) 35 | (etypecase value 36 | (string (parse-multipart-string value content-type)) 37 | (stream (parse-multipart-stream value content-type content-length)))) 38 | ((starts-with-subseq "application/octet-stream" (string-downcase content-type)) 39 | value) 40 | ((starts-with-subseq "text/" (string-downcase content-type)) 41 | (etypecase value 42 | (string value) 43 | (stream (babel:octets-to-string (slurp-stream value content-length) 44 | :encoding (detect-charset content-type))))) 45 | (t value)))) 46 | -------------------------------------------------------------------------------- /src/body/parser/json.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/body/parser/json 2 | (:use #:cl) 3 | (:import-from #:apispec/utils 4 | #:detect-charset 5 | #:slurp-stream) 6 | (:import-from #:jonathan) 7 | (:import-from #:babel) 8 | (:export #:parse-json-stream 9 | #:parse-json-string)) 10 | (in-package #:apispec/body/parser/json) 11 | 12 | (defun parse-json-stream (stream content-type content-length) 13 | (jojo:parse 14 | (babel:octets-to-string (slurp-stream stream content-length) 15 | :encoding (detect-charset content-type :utf-8)) 16 | :as :alist)) 17 | 18 | (defun parse-json-string (string content-type) 19 | (declare (ignore content-type)) 20 | (jojo:parse string :as :alist)) 21 | -------------------------------------------------------------------------------- /src/body/parser/multipart.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/body/parser/multipart 2 | (:use #:cl) 3 | (:import-from #:apispec/body/parser/json 4 | #:parse-json-stream) 5 | (:import-from #:apispec/body/parser/urlencoded 6 | #:parse-urlencoded-stream) 7 | (:import-from #:apispec/utils 8 | #:slurp-stream 9 | #:detect-charset) 10 | (:import-from #:fast-http 11 | #:make-multipart-parser) 12 | (:import-from #:flexi-streams) 13 | (:import-from #:babel) 14 | (:import-from #:alexandria 15 | #:starts-with-subseq) 16 | (:import-from #:cl-utilities 17 | #:with-collectors) 18 | (:export #:parse-multipart-stream 19 | #:parse-multipart-string 20 | #:*multipart-force-stream*)) 21 | (in-package #:apispec/body/parser/multipart) 22 | 23 | (defvar *multipart-force-stream* t) 24 | 25 | (defun parse-multipart-stream (stream content-type content-length) 26 | (check-type stream stream) 27 | (check-type content-type string) 28 | (check-type content-length (or integer null)) 29 | (let ((results (with-collectors (collect-body collect-headers) 30 | (let ((parser (make-multipart-parser 31 | content-type 32 | (lambda (name headers field-meta body) 33 | (declare (ignore field-meta)) 34 | (collect-body (cons name 35 | (if *multipart-force-stream* 36 | body 37 | (let ((content-type (gethash "content-type" headers))) 38 | (cond 39 | ((starts-with-subseq "application/json" (string-downcase content-type)) 40 | (parse-json-stream body content-type nil)) 41 | ((starts-with-subseq "application/x-www-form-urlencoded" (string-downcase content-type)) 42 | (parse-urlencoded-stream body nil)) 43 | ((starts-with-subseq "multipart/" (string-downcase content-type)) 44 | (parse-multipart-stream body content-type nil)) 45 | ((starts-with-subseq "application/octet-stream" (string-downcase content-type)) 46 | body) 47 | (t 48 | (babel:octets-to-string (slurp-stream body nil) 49 | :encoding (detect-charset content-type)))))))) 50 | (collect-headers (cons name headers)))))) 51 | (if content-length 52 | (let ((buffer (make-array content-length :element-type '(unsigned-byte 8)))) 53 | (read-sequence buffer stream) 54 | (funcall parser buffer)) 55 | (loop with buffer = (make-array 1024 :element-type '(unsigned-byte 8)) 56 | for read-bytes = (read-sequence buffer stream) 57 | do (funcall parser (subseq buffer 0 read-bytes)) 58 | while (= read-bytes 1024))))))) 59 | (if (every (lambda (pair) (null (car pair))) results) 60 | (if (null (rest results)) 61 | ;; Single multipart chunk 62 | (cdr (first results)) 63 | (mapcar #'cdr results)) 64 | results))) 65 | 66 | (defun parse-multipart-string (string content-type) 67 | (parse-multipart-stream 68 | (flex:make-in-memory-input-stream (babel:string-to-octets string)) 69 | content-type 70 | (length string))) 71 | -------------------------------------------------------------------------------- /src/body/parser/urlencoded.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/body/parser/urlencoded 2 | (:use #:cl) 3 | (:import-from #:apispec/utils 4 | #:slurp-stream) 5 | (:import-from #:quri 6 | #:url-decode-params) 7 | (:export #:parse-urlencoded-stream 8 | #:parse-urlencoded-string)) 9 | (in-package #:apispec/body/parser/urlencoded) 10 | 11 | (defun parse-urlencoded-stream (stream content-length) 12 | (url-decode-params (slurp-stream stream content-length) :lenient t)) 13 | 14 | (defun parse-urlencoded-string (string) 15 | (url-decode-params string :lenient t)) 16 | -------------------------------------------------------------------------------- /src/classes/encoding.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:apispec/classes/encoding 2 | (:use #:cl) 3 | (:use-reexport #:apispec/classes/encoding/class 4 | #:apispec/classes/encoding/parse)) 5 | (in-package #:apispec/classes/encoding) 6 | -------------------------------------------------------------------------------- /src/classes/encoding/class.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/encoding/class 2 | (:use #:cl 3 | #:apispec/utils) 4 | (:import-from #:apispec/classes/schema 5 | #:schema) 6 | (:import-from #:apispec/classes/header 7 | #:header) 8 | (:import-from #:apispec/complex 9 | #:complex-style) 10 | (:export #:encoding 11 | #:encoding-content-type 12 | #:encoding-headers 13 | #:encoding-style 14 | #:encoding-explode-p 15 | #:encoding-allow-reserved-p)) 16 | (in-package #:apispec/classes/encoding/class) 17 | 18 | (declaim-safety) 19 | 20 | (defclass encoding () 21 | ((content-type :type (or string null) 22 | :initarg :content-type 23 | :initform nil 24 | :reader encoding-content-type) 25 | (headers :type (association-list string header) 26 | :initarg :headers 27 | :initform nil 28 | :reader encoding-headers) 29 | (style :type complex-style 30 | :initarg :style 31 | :initform "form" 32 | :reader encoding-style) 33 | (explode :type boolean 34 | :initarg :explode) 35 | (allow-reserved :type boolean 36 | :initarg :allow-reserved 37 | :initform nil 38 | :reader encoding-allow-reserved-p))) 39 | 40 | (defun encoding-explode-p (encoding) 41 | (check-type encoding encoding) 42 | (if (slot-boundp encoding 'explode) 43 | (slot-value encoding 'explode) 44 | (let ((style (encoding-style encoding))) 45 | (if (equal style "form") 46 | t 47 | nil)))) 48 | 49 | (undeclaim-safety) 50 | -------------------------------------------------------------------------------- /src/classes/encoding/errors.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/encoding/errors 2 | (:use #:cl 3 | #:apispec/errors) 4 | (:export #:encoding-error 5 | #:encoding-content-type-mismatch 6 | #:encoding-header-missing)) 7 | (in-package #:apispec/classes/encoding/errors) 8 | 9 | (define-condition encoding-error (apispec-error) ()) 10 | 11 | (define-condition encoding-content-type-mismatch (encoding-error) 12 | ((given :initarg :given) 13 | (expected :initarg :expected))) 14 | 15 | (define-condition encoding-header-missing (encoding-error) 16 | ((header :initarg :header)) 17 | (:report (lambda (condition stream) 18 | (format stream "Header '~A' is missing" (slot-value condition 'header))))) 19 | -------------------------------------------------------------------------------- /src/classes/encoding/parse.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/encoding/parse 2 | (:use #:cl 3 | #:apispec/utils) 4 | (:import-from #:apispec/classes/encoding/class 5 | #:encoding 6 | #:encoding-content-type 7 | #:encoding-headers 8 | #:encoding-style 9 | #:encoding-explode-p) 10 | (:import-from #:apispec/classes/schema 11 | #:schema 12 | #:binary 13 | #:object 14 | #:array-items 15 | #:coerce-data 16 | #:*coerce-string-to-boolean*) 17 | (:shadowing-import-from #:apispec/classes/schema 18 | #:byte 19 | #:number 20 | #:string 21 | #:boolean 22 | #:array) 23 | (:import-from #:apispec/classes/header 24 | #:header-missing 25 | #:coerce-with-header) 26 | (:import-from #:apispec/complex 27 | #:parse-complex-parameters) 28 | (:import-from #:apispec/body 29 | #:parse-body) 30 | (:import-from #:apispec/body/parser/multipart 31 | #:*multipart-force-stream*) 32 | (:import-from #:alexandria 33 | #:starts-with-subseq) 34 | (:export #:parse-with-encoding 35 | #:encoding-content-type-mismatch)) 36 | (in-package #:apispec/classes/encoding/parse) 37 | 38 | (defun default-content-type (schema) 39 | (etypecase schema 40 | ((or byte binary) "application/octet-stream") 41 | ((or number string boolean) "text/plain") 42 | (object "application/json") 43 | (array 44 | (default-content-type (array-items schema))) 45 | ((eql t) "text/plain"))) 46 | 47 | (defun parse-with-encoding (value encoding schema headers) 48 | (check-type encoding encoding) 49 | (check-type schema (or schema (eql t))) 50 | (check-type headers (or hash-table null)) 51 | (let ((content-type (and headers 52 | (gethash "content-type" headers)))) 53 | (when (and content-type 54 | (encoding-content-type encoding)) 55 | (or (handler-case 56 | (match-content-type (encoding-content-type encoding) 57 | content-type 58 | :comma-separated t) 59 | (error () 60 | nil)) 61 | (error 'encoding-content-type-mismatch 62 | :given content-type 63 | :expected (encoding-content-type encoding)))) 64 | (let ((content-type (or content-type 65 | (encoding-content-type encoding) 66 | (default-content-type schema)))) 67 | (when (and (encoding-headers encoding) 68 | headers 69 | content-type 70 | (starts-with-subseq "multipart/" (string-downcase content-type))) 71 | (loop for (header-name . header-object) in (encoding-headers encoding) 72 | for header-name-downcased = (string-downcase header-name) 73 | for given-header-value = (gethash header-name-downcased headers) 74 | ;; Content-Type is ignored 75 | if (not (string= header-name-downcased "content-type")) 76 | do (handler-case 77 | (coerce-with-header given-header-value header-object) 78 | (header-missing () 79 | (error 'encoding-header-missing 80 | :header header-name-downcased))))) 81 | ;; TODO: Respect encoding-allow-reserved-p if it's urlencoded. 82 | (multiple-value-bind (parsed-values parsed-headers) 83 | (let ((*multipart-force-stream* nil)) 84 | (parse-body value content-type)) 85 | (declare (ignore parsed-headers)) 86 | (let ((*coerce-string-to-boolean* 87 | (starts-with-subseq "application/x-www-form-urlencoded" (string-downcase content-type)))) 88 | (if (and (starts-with-subseq "application/x-www-form-urlencoded" (string-downcase content-type)) 89 | (encoding-style encoding)) 90 | (parse-complex-parameters parsed-values 91 | (encoding-style encoding) 92 | (encoding-explode-p encoding) 93 | schema) 94 | (coerce-data parsed-values schema))))))) 95 | -------------------------------------------------------------------------------- /src/classes/header.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/header 2 | (:use #:cl 3 | #:apispec/utils 4 | #:apispec/errors) 5 | (:import-from #:apispec/classes/schema 6 | #:schema 7 | #:coerce-data) 8 | (:import-from #:apispec/complex 9 | #:parse-simple-value) 10 | (:export #:header 11 | #:header-required-p 12 | #:header-schema 13 | #:header-explode-p 14 | #:header-error 15 | #:header-missing 16 | #:coerce-with-header)) 17 | (in-package #:apispec/classes/header) 18 | 19 | (declaim-safety) 20 | 21 | (define-condition header-error (apispec-error) ()) 22 | 23 | (define-condition header-missing (header-error) 24 | () 25 | (:report (lambda (condition stream) 26 | (declare (ignore condition)) 27 | (princ "Header is missing" stream)))) 28 | 29 | (defclass header () 30 | ((required :type boolean 31 | :initarg :required 32 | :initform nil 33 | :reader header-required-p) 34 | (schema :type (or schema (eql t)) 35 | :initarg :schema 36 | :initform t 37 | :reader header-schema) 38 | (explode :type boolean 39 | :initarg :explode 40 | :initform nil 41 | :reader header-explode-p))) 42 | 43 | (defun coerce-with-header (value header) 44 | (check-type value (or string null)) 45 | (check-type header header) 46 | (when (and (null value) 47 | (header-required-p header)) 48 | (error 'header-missing)) 49 | (coerce-data 50 | (parse-simple-value value 51 | :as (header-schema header) 52 | :explode (header-explode-p header)) 53 | (header-schema header))) 54 | 55 | (undeclaim-safety) 56 | -------------------------------------------------------------------------------- /src/classes/media-type.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:apispec/classes/media-type 2 | (:use #:cl) 3 | (:use-reexport #:apispec/classes/media-type/class 4 | #:apispec/classes/media-type/parse)) 5 | (in-package #:apispec/classes/media-type) 6 | -------------------------------------------------------------------------------- /src/classes/media-type/class.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/media-type/class 2 | (:use #:cl 3 | #:apispec/utils) 4 | (:import-from #:apispec/classes/encoding 5 | #:encoding) 6 | (:import-from #:apispec/classes/schema 7 | #:schema) 8 | (:export #:media-type 9 | #:media-type-schema 10 | #:media-type-encoding)) 11 | (in-package #:apispec/classes/media-type/class) 12 | 13 | (defclass media-type () 14 | ((schema :type (or schema (eql t)) 15 | :initarg :schema 16 | :initform t 17 | :reader media-type-schema) 18 | (encoding :type (association-list string encoding) 19 | :initarg :encoding 20 | :initform nil 21 | :reader media-type-encoding))) 22 | 23 | -------------------------------------------------------------------------------- /src/classes/media-type/parse.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/media-type/parse 2 | (:use #:cl) 3 | (:import-from #:apispec/classes/media-type/class 4 | #:media-type 5 | #:media-type-encoding 6 | #:media-type-schema) 7 | (:import-from #:apispec/classes/encoding 8 | #:encoding 9 | #:parse-with-encoding) 10 | (:import-from #:apispec/classes/schema 11 | #:coerce-data 12 | #:find-object-property 13 | #:property-type) 14 | (:import-from #:apispec/body 15 | #:parse-body) 16 | (:import-from #:apispec/utils 17 | #:association-list-p) 18 | (:import-from #:alexandria 19 | #:starts-with-subseq) 20 | (:import-from #:assoc-utils 21 | #:aget) 22 | (:export #:parse-with-media-type)) 23 | (in-package #:apispec/classes/media-type/parse) 24 | 25 | (defun parse-with-media-type (stream media-type content-type content-length) 26 | (check-type stream stream) 27 | (check-type media-type media-type) 28 | (check-type content-type cl:string) 29 | (check-type content-length (or integer null)) 30 | (multiple-value-bind (parsed-values parsed-headers) 31 | (parse-body stream content-type content-length) 32 | (coerce-data 33 | (if ;; The encoding object SHALL only apply to requestBody objects 34 | ;; when the media type is multipart or application/x-www-form-urlencoded. 35 | (or (starts-with-subseq "application/x-www-form-urlencoded" (string-downcase content-type)) 36 | (starts-with-subseq "multipart/" (string-downcase content-type))) 37 | (progn 38 | (assert (association-list-p parsed-values 'string t)) 39 | (mapc (lambda (pair) 40 | (let ((encoding (aget (media-type-encoding media-type) (car pair) 41 | (make-instance 'encoding))) 42 | (property (and (media-type-schema media-type) 43 | (find-object-property (media-type-schema media-type) 44 | (car pair))))) 45 | (setf (cdr pair) 46 | (parse-with-encoding (cdr pair) 47 | encoding 48 | (if property 49 | (property-type property) 50 | t) 51 | (aget parsed-headers (car pair)))))) 52 | parsed-values)) 53 | parsed-values) 54 | (media-type-schema media-type)))) 55 | -------------------------------------------------------------------------------- /src/classes/operation.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/operation 2 | (:use #:cl 3 | #:apispec/utils) 4 | (:import-from #:apispec/classes/parameter 5 | #:parameter 6 | #:parameter-in 7 | #:parse-query-string 8 | #:parse-path-parameters 9 | #:parse-headers 10 | #:parse-cookie-string) 11 | (:import-from #:apispec/classes/request-body 12 | #:parse-request-body 13 | #:request-body) 14 | (:import-from #:apispec/classes/response 15 | #:responses 16 | #:encode-response) 17 | (:import-from #:lack.request 18 | #:request) 19 | (:import-from #:lack.response 20 | #:response 21 | #:response-status 22 | #:response-headers 23 | #:response-body 24 | #:finalize-cookies) 25 | (:export #:operation 26 | #:operation-tags 27 | #:operation-summary 28 | #:operation-description 29 | #:operation-id 30 | #:operation-parameters 31 | #:operation-request-body 32 | #:operation-responses 33 | #:operation-deprecated-p 34 | #:validate-request 35 | #:validate-response 36 | 37 | #:request 38 | #:request-path-parameters 39 | #:request-header-parameters)) 40 | (in-package #:apispec/classes/operation) 41 | 42 | (declaim-safety) 43 | 44 | ;; TODO: 'externalDocs', 'callbacks', 'security' and 'servers'. 45 | (defclass operation () 46 | ((tags :type (proper-list string) 47 | :initarg :tags 48 | :initform nil 49 | :reader operation-tags) 50 | (summary :type (or string null) 51 | :initarg :summary 52 | :initform nil 53 | :reader operation-summary) 54 | (description :type (or string null) 55 | :initarg :description 56 | :initform nil 57 | :reader operation-description) 58 | (id :type (or string null) 59 | :initarg :id 60 | :initform nil 61 | :reader operation-id) 62 | (parameters :type (proper-list parameter) 63 | :initarg :parameters 64 | :initform nil 65 | :reader operation-parameters) 66 | (request-body :type (or request-body null) 67 | :initarg :request-body 68 | :initform nil 69 | :reader operation-request-body) 70 | (responses :type responses 71 | :initarg :responses 72 | :initform (error ":responses is required for OPERATION") 73 | :reader operation-responses) 74 | (deprecated :type boolean 75 | :initarg :deprecated 76 | :initform nil 77 | :reader operation-deprecated-p) 78 | (%schema :initarg :%schema 79 | :reader operation-schema))) 80 | 81 | (defstruct (apispec-request (:include request) 82 | (:conc-name request-)) 83 | path-parameters 84 | header-parameters) 85 | 86 | (defun validate-request (operation env &key path-parameters additional-parameters) 87 | (let ((parameters (append additional-parameters 88 | (operation-parameters operation)))) 89 | (loop for parameter in parameters 90 | for in = (parameter-in parameter) 91 | if (string= in "path") 92 | collect parameter into operation-path-parameters 93 | else if (string= in "query") 94 | collect parameter into operation-query-parameters 95 | else if (string= in "header") 96 | collect parameter into operation-header-parameters 97 | else if (string= in "cookie") 98 | collect parameter into operation-cookie-parameters 99 | finally 100 | (let ((body (and (operation-request-body operation) 101 | (parse-request-body (getf env :raw-body) 102 | (getf env :content-type) 103 | (getf env :content-length) 104 | (operation-request-body operation))))) 105 | (return (apply #'make-apispec-request 106 | :env env 107 | :method (getf env :request-method) 108 | :uri (getf env :request-uri) 109 | :uri-scheme (getf env :url-scheme) 110 | :path-parameters (parse-path-parameters 111 | path-parameters 112 | operation-path-parameters) 113 | :query-parameters (parse-query-string 114 | (getf env :query-string) 115 | operation-query-parameters) 116 | :header-parameters (parse-headers 117 | (getf env :headers) 118 | operation-header-parameters) 119 | :cookies (let ((headers (getf env :headers))) 120 | (and headers 121 | (parse-cookie-string 122 | (gethash "cookie" headers) 123 | operation-cookie-parameters))) 124 | :body-parameters (and (association-list-p body 'string t) 125 | body) 126 | :allow-other-keys t 127 | env)))))) 128 | 129 | (defun validate-response (operation response) 130 | (check-type operation operation) 131 | (check-type response response) 132 | (finalize-cookies response) 133 | (encode-response (response-status response) 134 | (response-headers response) 135 | (response-body response) 136 | (operation-responses operation))) 137 | 138 | (undeclaim-safety) 139 | -------------------------------------------------------------------------------- /src/classes/parameter.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:apispec/classes/parameter 2 | (:use-reexport #:apispec/classes/parameter/class 3 | #:apispec/classes/parameter/parse 4 | #:apispec/classes/parameter/errors)) 5 | -------------------------------------------------------------------------------- /src/classes/parameter/class.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/parameter/class 2 | (:use #:cl 3 | #:apispec/utils) 4 | (:import-from #:apispec/classes/schema 5 | #:schema) 6 | (:import-from #:apispec/complex 7 | #:complex-style) 8 | (:export #:parameter 9 | #:parameter-name 10 | #:parameter-in 11 | #:parameter-required-p 12 | #:parameter-schema 13 | #:parameter-style 14 | #:parameter-explode-p 15 | #:parameter-allow-reserved-p 16 | #:path-parameter-p 17 | #:path-parameter 18 | #:query-parameter-p 19 | #:query-parameter 20 | #:header-parameter-p 21 | #:header-parameter 22 | #:cookie-parameter-p 23 | #:cookie-parameter)) 24 | (in-package #:apispec/classes/parameter/class) 25 | 26 | (declaim-safety) 27 | 28 | (defun parameter-in-string-p (in) 29 | (and (member in '("path" "query" "header" "cookie") 30 | :test #'equal) 31 | t)) 32 | 33 | (deftype parameter-in () 34 | '(satisfies parameter-in-string-p)) 35 | 36 | (defclass parameter () 37 | ((name :type string 38 | :initarg :name 39 | :initform (error ":name is required for PARAMETER") 40 | :reader parameter-name) 41 | (in :type parameter-in 42 | :initarg :in 43 | :initform (error ":in is required for PARAMETER") 44 | :reader parameter-in) 45 | (required :type boolean 46 | :initarg :required 47 | :initform nil 48 | :reader parameter-required-p) 49 | (schema :type (or schema null) 50 | :initarg :schema 51 | :initform nil 52 | :reader parameter-schema) 53 | (style :type complex-style 54 | :initarg :style) 55 | (explode :type boolean 56 | :initarg :explode) 57 | (allow-reserved :type boolean 58 | :initarg :allow-reserved 59 | :initform nil 60 | :reader parameter-allow-reserved-p))) 61 | 62 | (defmethod initialize-instance ((object parameter) &rest initargs 63 | &key in (required nil required-supplied-p) default style 64 | &allow-other-keys) 65 | (when (equal in "path") 66 | (when (and required-supplied-p 67 | (not required)) 68 | (error ":required must be 'true' for 'path' parameters.")) 69 | (setf (getf initargs :required) t 70 | required t)) 71 | 72 | (when style 73 | (cond 74 | ((equal style "matrix") 75 | (assert (equal in "path"))) 76 | ((equal style "label") 77 | (assert (equal in "path"))) 78 | ((equal style "form") 79 | (assert (or (equal in "query") 80 | (equal in "cookie")))) 81 | ((equal style "simple") 82 | (assert (or (equal in "path") 83 | (equal in "header")))) 84 | ((or (equal style "spaceDelimited") 85 | (equal style "pipeDelimited") 86 | (equal style "deepObject")) 87 | (assert (equal in "query"))))) 88 | 89 | (when (and default required) 90 | (error ":default cannot be specified for required parameters")) 91 | 92 | (apply #'call-next-method object initargs)) 93 | 94 | (defun parameter-style (parameter) 95 | (check-type parameter parameter) 96 | (if (slot-boundp parameter 'style) 97 | (slot-value parameter 'style) 98 | (with-slots (in) parameter 99 | (cond 100 | ((or (equal in "query") 101 | (equal in "cookie")) "form") 102 | ((or (equal in "path") 103 | (equal in "header")) "simple"))))) 104 | 105 | (defun parameter-explode-p (parameter) 106 | (check-type parameter parameter) 107 | (if (slot-boundp parameter 'explode) 108 | (slot-value parameter 'explode) 109 | (let ((style (parameter-style parameter))) 110 | (if (equal style "form") 111 | t 112 | nil)))) 113 | 114 | (defun query-parameter-p (parameter) 115 | (and (typep parameter 'parameter) 116 | (string= (parameter-in parameter) "query"))) 117 | 118 | (deftype query-parameter () 119 | '(satisfies query-parameter-p)) 120 | 121 | (defun path-parameter-p (parameter) 122 | (and (typep parameter 'parameter) 123 | (string= (parameter-in parameter) "path"))) 124 | 125 | (deftype path-parameter () 126 | '(satisfies path-parameter-p)) 127 | 128 | (defun header-parameter-p (parameter) 129 | (and (typep parameter 'parameter) 130 | (string= (parameter-in parameter) "header"))) 131 | 132 | (deftype header-parameter () 133 | '(satisfies header-parameter-p)) 134 | 135 | (defun cookie-parameter-p (parameter) 136 | (and (typep parameter 'parameter) 137 | (string= (parameter-in parameter) "cookie"))) 138 | 139 | (deftype cookie-parameter () 140 | '(satisfies cookie-parameter-p)) 141 | 142 | (undeclaim-safety) 143 | -------------------------------------------------------------------------------- /src/classes/parameter/errors.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/parameter/errors 2 | (:use #:cl 3 | #:apispec/utils 4 | #:apispec/errors) 5 | (:import-from #:apispec/classes/schema 6 | #:schema-error) 7 | (:export #:parameter-error 8 | #:parameter-parse-failed 9 | #:parameter-validation-failed 10 | #:missing-parameters 11 | #:unpermitted-parameters 12 | #:invalid-parameters)) 13 | (in-package #:apispec/classes/parameter/errors) 14 | 15 | (define-condition parameter-error (apispec-error) ()) 16 | 17 | (define-condition parameter-parse-failed (parameter-error) 18 | ((value :initarg :value)) 19 | (:report (lambda (condition stream) 20 | (format stream "Failed to parse: '~A'" (slot-value condition 'value))))) 21 | 22 | (define-condition parameter-validation-failed (parameter-error) 23 | ((in :type string 24 | :initarg :in) 25 | (missing :type (proper-list string) 26 | :initarg :missing 27 | :initform nil 28 | :reader missing-parameters) 29 | (unpermitted :type (proper-list string) 30 | :initarg :unpermitted 31 | :initform nil 32 | :reader unpermitted-parameters) 33 | (invalid :type (association-list string schema-error) 34 | :initarg :invalid 35 | :initform nil 36 | :reader invalid-parameters)) 37 | (:report (lambda (condition stream) 38 | (with-slots (in missing unpermitted invalid) 39 | condition 40 | (format stream "Invalid ~A parameters:" in) 41 | (when missing 42 | (format stream "~% missing: ~{~A~^, ~}" missing)) 43 | (when unpermitted 44 | (format stream "~% unpermitted: ~{~A~^, ~}" unpermitted)) 45 | (when invalid 46 | (format stream "~% invalid:") 47 | (dolist (pair invalid) 48 | (format stream "~% ~A: ~A" (car pair) (cdr pair)))))))) 49 | -------------------------------------------------------------------------------- /src/classes/parameter/parse.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/parameter/parse 2 | (:use #:cl 3 | #:apispec/utils 4 | #:apispec/classes/parameter/class 5 | #:apispec/classes/parameter/errors) 6 | (:import-from #:apispec/classes/schema 7 | #:coerce-data 8 | #:*coerce-string-to-boolean*) 9 | (:import-from #:apispec/complex 10 | #:parse-complex-string 11 | #:parse-complex-parameter) 12 | (:import-from #:apispec/errors 13 | #:apispec-error) 14 | (:import-from #:quri 15 | #:url-decode-params) 16 | (:import-from #:assoc-utils 17 | #:aget 18 | #:delete-from-alist) 19 | (:export #:parse-query-string 20 | #:parse-path-parameters 21 | #:parse-headers 22 | #:parse-cookie-string)) 23 | (in-package #:apispec/classes/parameter/parse) 24 | 25 | (defvar *empty* '#:empty) 26 | 27 | (defun parse-query-string (query-string parameters) 28 | (check-type query-string (or null string)) 29 | (assert (proper-list-p parameters 'query-parameter)) 30 | 31 | (let ((query-parameters (and query-string 32 | (handler-case 33 | (quri:url-decode-params query-string :lenient t) 34 | ((or quri:uri-malformed-urlencoded-string 35 | quri:url-decoding-error) () 36 | (error 'parameter-parse-failed 37 | :value query-string))))) 38 | results missing invalid) 39 | (dolist (parameter parameters) 40 | (let* ((name (parameter-name parameter)) 41 | (value (aget query-parameters name *empty*))) 42 | (cond 43 | ((eq value *empty*) 44 | (when (parameter-required-p parameter) 45 | (push name missing)) 46 | #+(or) 47 | (push (cons name nil) results)) 48 | (t 49 | (let ((parsed-value 50 | (handler-case 51 | (parse-complex-parameter query-parameters 52 | name 53 | (parameter-style parameter) 54 | (parameter-explode-p parameter) 55 | (parameter-schema parameter)) 56 | (apispec-error (e) 57 | (push (cons name e) invalid) 58 | nil)))) 59 | (push (cons name parsed-value) results) 60 | (setf query-parameters (delete-from-alist query-parameters name))))))) 61 | (when (or missing invalid query-parameters) 62 | (error 'parameter-validation-failed 63 | :in "query" 64 | :missing (nreverse missing) 65 | :unpermitted (mapcar #'car query-parameters) 66 | :invalid (nreverse invalid))) 67 | (nreverse results))) 68 | 69 | (defun parse-path-parameters (path-parameters parameters) 70 | (assert (association-list-p path-parameters 'string 'string)) 71 | (assert (proper-list-p parameters 'path-parameter)) 72 | 73 | (let (results missing invalid) 74 | (dolist (parameter parameters) 75 | (let* ((name (parameter-name parameter)) 76 | (value (aget path-parameters name *empty*))) 77 | (cond 78 | ((eq value *empty*) 79 | (push name missing)) 80 | (t 81 | (push (cons (parameter-name parameter) 82 | (handler-case 83 | (coerce-data 84 | (parse-complex-string value 85 | (parameter-style parameter) 86 | (parameter-explode-p parameter) 87 | (parameter-schema parameter)) 88 | (parameter-schema parameter)) 89 | (apispec-error (e) 90 | (push (cons name e) invalid) 91 | nil))) 92 | results) 93 | (setf path-parameters (delete-from-alist path-parameters name)))))) 94 | (when (or missing invalid path-parameters) 95 | (error 'parameter-validation-failed 96 | :in "path" 97 | :missing (nreverse missing) 98 | :unpermitted (mapcar #'car path-parameters) 99 | :invalid (nreverse invalid))) 100 | (nreverse results))) 101 | 102 | (defun parse-headers (headers parameters) 103 | (check-type headers (or hash-table null)) 104 | (assert (proper-list-p parameters 'header-parameter)) 105 | 106 | (let ((headers (or headers (make-hash-table))) 107 | results missing invalid) 108 | (dolist (parameter parameters) 109 | (let* ((name (parameter-name parameter)) 110 | (value (gethash (string-downcase name) headers *empty*))) 111 | (cond 112 | ((eq value *empty*) 113 | (when (parameter-required-p parameter) 114 | (push name missing)) 115 | (push (cons name nil) results)) 116 | (t 117 | (push (cons (parameter-name parameter) 118 | (handler-case 119 | (coerce-data 120 | (parse-complex-string value 121 | (parameter-style parameter) 122 | (parameter-explode-p parameter) 123 | (parameter-schema parameter)) 124 | (parameter-schema parameter)) 125 | (apispec-error (e) 126 | (push (cons name e) invalid) 127 | nil))) 128 | results))))) 129 | (when (or missing invalid) 130 | (error 'parameter-validation-failed 131 | :in "header" 132 | :missing (nreverse missing) 133 | :invalid (nreverse invalid))) 134 | (nreverse results))) 135 | 136 | (defun decode-cookie-params (cookie-string) 137 | (loop for part in (ppcre:split "\\s*;\\s*" cookie-string) 138 | for (key value) = (ppcre:split "=" part :limit 2) 139 | collect (cons key value))) 140 | 141 | (defun parse-cookie-string (cookie-string parameters) 142 | (check-type cookie-string (or string null)) 143 | (assert (proper-list-p parameters 'cookie-parameter)) 144 | 145 | (let ((cookies (and cookie-string 146 | (decode-cookie-params cookie-string))) 147 | results missing invalid) 148 | (dolist (parameter parameters) 149 | (let* ((name (parameter-name parameter)) 150 | (value (aget cookies name *empty*))) 151 | (cond 152 | ((eq value *empty*) 153 | (when (parameter-required-p parameter) 154 | (push name missing)) 155 | (push (cons name nil) results)) 156 | (t 157 | (push (cons (parameter-name parameter) 158 | (let ((*coerce-string-to-boolean* t)) 159 | (handler-case 160 | (coerce-data 161 | (parse-complex-parameter cookies 162 | (parameter-name parameter) 163 | (parameter-style parameter) 164 | (parameter-explode-p parameter) 165 | (parameter-schema parameter)) 166 | (parameter-schema parameter)) 167 | (apispec-error (e) 168 | (push (cons name e) invalid) 169 | nil)))) 170 | results))))) 171 | (when (or missing invalid) 172 | (error 'parameter-validation-failed 173 | :missing (nreverse missing) 174 | :invalid (nreverse invalid))) 175 | (nreverse results))) 176 | -------------------------------------------------------------------------------- /src/classes/path.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/path 2 | (:use #:cl 3 | #:apispec/utils) 4 | (:import-from #:apispec/classes/parameter 5 | #:parameter) 6 | (:import-from #:apispec/classes/operation 7 | #:operation) 8 | (:import-from #:apispec/utils/path-template 9 | #:compile-path-template) 10 | (:export #:path-item 11 | #:path-item-summary 12 | #:path-item-description 13 | #:path-item-parameters 14 | #:path-item-get 15 | #:path-item-put 16 | #:path-item-post 17 | #:path-item-delete 18 | #:path-item-options 19 | #:path-item-head 20 | #:path-item-patch 21 | #:path-item-trace 22 | #:paths 23 | #:find-operation 24 | #:compile-paths)) 25 | (in-package #:apispec/classes/path) 26 | 27 | (declaim-safety) 28 | 29 | (defclass path-item () 30 | ((summary :type (or string null) 31 | :initarg :summary 32 | :initform nil 33 | :reader path-item-summary) 34 | (description :type (or string null) 35 | :initarg :description 36 | :initform nil 37 | :reader path-item-description) 38 | (parameters :type (proper-list parameter) 39 | :initarg :parameters 40 | :initform nil 41 | :reader path-item-parameters) 42 | (get :type (or operation null) 43 | :initarg :get 44 | :initform nil 45 | :accessor path-item-get) 46 | (put :type (or operation null) 47 | :initarg :put 48 | :initform nil 49 | :accessor path-item-put) 50 | (post :type (or operation null) 51 | :initarg :post 52 | :initform nil 53 | :accessor path-item-post) 54 | (delete :type (or operation null) 55 | :initarg :delete 56 | :initform nil 57 | :accessor path-item-delete) 58 | (options :type (or operation null) 59 | :initarg :options 60 | :initform nil 61 | :accessor path-item-options) 62 | (head :type (or operation null) 63 | :initarg :head 64 | :initform nil 65 | :accessor path-item-head) 66 | (patch :type (or operation null) 67 | :initarg :patch 68 | :initform nil 69 | :accessor path-item-patch) 70 | (trace :type (or operation null) 71 | :initarg :trace 72 | :initform nil 73 | :accessor path-item-trace))) 74 | 75 | (defun find-operation (path method) 76 | (check-type path path-item) 77 | (funcall 78 | (ecase method 79 | (:get #'path-item-get) 80 | (:put #'path-item-put) 81 | (:post #'path-item-post) 82 | (:delete #'path-item-delete) 83 | (:options #'path-item-options) 84 | (:head #'path-item-head) 85 | (:patch #'path-item-patch) 86 | (:trace #'path-item-trace)) 87 | path)) 88 | 89 | (defun paths-p (object) 90 | (association-list-p object 'string 'path-item)) 91 | 92 | (deftype paths () 93 | '(satisfies paths-p)) 94 | 95 | (defun compile-paths (paths) 96 | (assert (typep paths 'paths)) 97 | (loop for (template . path) in paths 98 | collect (multiple-value-bind (matcher score template-regexp) 99 | (compile-path-template template path) 100 | (list score (length template-regexp) matcher)) 101 | into matchers 102 | finally 103 | (return 104 | (let ((matchers (mapcar #'third (sort matchers 105 | (lambda (a b) 106 | (or (< (first a) (first b)) 107 | (and (= (first a) (first b)) 108 | (>= (second a) (second b))))))))) 109 | (lambda (path-info) 110 | (loop for matcher in matchers 111 | do (multiple-value-bind (matched-path parameters) 112 | (funcall matcher path-info) 113 | (when matched-path 114 | (return (values matched-path parameters)))))))))) 115 | 116 | (undeclaim-safety) 117 | -------------------------------------------------------------------------------- /src/classes/request-body.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:apispec/classes/request-body 2 | (:use-reexport #:apispec/classes/request-body/class 3 | #:apispec/classes/request-body/parse 4 | #:apispec/classes/request-body/errors)) 5 | -------------------------------------------------------------------------------- /src/classes/request-body/class.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/request-body/class 2 | (:use #:cl 3 | #:apispec/utils) 4 | (:import-from #:apispec/classes/media-type 5 | #:media-type) 6 | (:import-from #:cl-ppcre 7 | #:scan-to-strings) 8 | (:import-from #:alexandria 9 | #:starts-with-subseq) 10 | (:export #:request-body 11 | #:request-body-description 12 | #:request-body-content 13 | #:request-body-required-p 14 | #:request-body-media-type 15 | #:find-request-body-media-type)) 16 | (in-package #:apispec/classes/request-body/class) 17 | 18 | (declaim-safety) 19 | 20 | (defclass request-body () 21 | ((description :type (or string null) 22 | :initarg :description 23 | :initform nil 24 | :reader request-body-description) 25 | (content :type (and (association-list string media-type) 26 | (not null)) 27 | :initarg :content 28 | :initform (error ":content is required for REQUEST-BODY") 29 | :reader request-body-content) 30 | (required :type boolean 31 | :initarg :required 32 | :initform nil 33 | :reader request-body-required-p))) 34 | 35 | (defun find-request-body-media-type (request-body content-type) 36 | (let ((content (request-body-content request-body))) 37 | (cdr (or (find-if (lambda (type) 38 | (starts-with-subseq type content-type)) 39 | content 40 | :key #'car) 41 | (find-if (lambda (type) 42 | (let ((matched (ppcre:scan-to-strings "[^/]+/(?=\\*)" type))) 43 | (and matched 44 | (starts-with-subseq matched content-type)))) 45 | content 46 | :key #'car))))) 47 | 48 | (undeclaim-safety) 49 | -------------------------------------------------------------------------------- /src/classes/request-body/errors.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/request-body/errors 2 | (:use #:cl 3 | #:apispec/errors) 4 | (:export #:request-body-error 5 | #:request-body-content-type-mismatch 6 | #:request-body-parse-error 7 | #:request-body-validation-failed)) 8 | (in-package #:apispec/classes/request-body/errors) 9 | 10 | (define-condition request-body-error (apispec-error) ()) 11 | 12 | (define-condition request-body-content-type-mismatch (request-body-error) 13 | ((given :initarg :given) 14 | (expected :initarg :expected)) 15 | (:report (lambda (condition stream) 16 | (with-slots (given expected) condition 17 | (format stream "The Content-Type must be one of ~{'~A'~^, ~}, but it's '~A'" 18 | expected given))))) 19 | 20 | (define-condition request-body-parse-error (request-body-error) 21 | ((content-type :initarg :content-type)) 22 | (:report (lambda (condition stream) 23 | (format stream "The request body is invalid for '~A'" 24 | (slot-value condition 'content-type))))) 25 | 26 | (define-condition request-body-validation-failed (request-body-error) 27 | ((value :initarg :value) 28 | (schema :initarg :schema)) 29 | (:report (lambda (condition stream) 30 | (with-slots (value schema) condition 31 | (format stream "~S is invalid for ~A" 32 | value schema))))) 33 | -------------------------------------------------------------------------------- /src/classes/request-body/parse.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/request-body/parse 2 | (:use #:cl 3 | #:apispec/classes/request-body/class 4 | #:apispec/classes/request-body/errors) 5 | (:import-from #:apispec/classes/media-type 6 | #:parse-with-media-type) 7 | (:import-from #:apispec/classes/schema 8 | #:schema-error) 9 | (:import-from #:apispec/errors 10 | #:apispec-error) 11 | (:export #:parse-request-body)) 12 | (in-package #:apispec/classes/request-body/parse) 13 | 14 | (defun parse-request-body (body-stream content-type content-length request-body) 15 | (check-type body-stream (or stream null)) 16 | (check-type content-type (or string null)) 17 | (check-type content-length (or integer null)) 18 | (check-type request-body request-body) 19 | 20 | (when body-stream 21 | (unless content-type 22 | (return-from parse-request-body body-stream)) 23 | 24 | (let ((media-type (find-request-body-media-type request-body content-type))) 25 | (unless media-type 26 | (error 'request-body-content-type-mismatch 27 | :given content-type 28 | :expected (mapcar #'car (request-body-content request-body)))) 29 | (handler-case 30 | (parse-with-media-type body-stream media-type content-type content-length) 31 | (schema-error (e) 32 | (error e)) 33 | (apispec-error () 34 | (error 'request-body-parse-error 35 | :content-type content-type)))))) 36 | -------------------------------------------------------------------------------- /src/classes/response.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:apispec/classes/response 2 | (:use-reexport #:apispec/classes/response/class 3 | #:apispec/classes/response/encode)) 4 | -------------------------------------------------------------------------------- /src/classes/response/class.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/response/class 2 | (:use #:cl 3 | #:apispec/utils) 4 | (:import-from #:apispec/classes/header 5 | #:header) 6 | (:import-from #:apispec/classes/media-type 7 | #:media-type) 8 | (:import-from #:cl-ppcre) 9 | (:export #:response 10 | #:response-description 11 | #:response-headers 12 | #:response-content 13 | #:responses)) 14 | (in-package #:apispec/classes/response/class) 15 | 16 | (declaim-safety) 17 | 18 | (defclass response () 19 | ((description :type string 20 | :initarg :description 21 | :initform (error ":description is required for RESPONSE") 22 | :reader response-description) 23 | (headers :type (association-list string header) 24 | :initarg :headers 25 | :initform nil 26 | :reader response-headers) 27 | (content :type (association-list string (or media-type null)) 28 | :initarg :content 29 | :initform (error ":content is required for RESPONSE") 30 | :reader response-content))) 31 | 32 | (defun http-status-code-p (value) 33 | (and (ppcre:scan "[1-5](?:\\d\\d|XX)" value) 34 | t)) 35 | 36 | (deftype http-status-code () 37 | '(satisfies http-status-code-p)) 38 | 39 | (defun default-response-p (value) 40 | (equal value "default")) 41 | 42 | (deftype responses-keys () 43 | '(and string 44 | (or http-status-code 45 | (satisfies default-response-p)))) 46 | 47 | (defun responsesp (responses) 48 | (and (not (null responses)) 49 | (association-list-p responses 'responses-keys 'response))) 50 | 51 | (deftype responses () 52 | '(satisfies responsesp)) 53 | 54 | (undeclaim-safety) 55 | -------------------------------------------------------------------------------- /src/classes/response/encode.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/response/encode 2 | (:use #:cl 3 | #:apispec/utils 4 | #:apispec/classes/response/errors) 5 | (:import-from #:apispec/classes/response/class 6 | #:response 7 | #:responses 8 | #:response-content 9 | #:response-headers) 10 | (:import-from #:apispec/classes/media-type 11 | #:media-type-schema) 12 | (:import-from #:apispec/classes/schema 13 | #:validate-data 14 | #:schema-error) 15 | (:import-from #:apispec/classes/header 16 | #:header-schema) 17 | (:import-from #:apispec/body 18 | #:encode-data 19 | #:body-encode-error) 20 | (:import-from #:cl-ppcre) 21 | (:import-from #:alexandria 22 | #:starts-with-subseq) 23 | (:import-from #:assoc-utils 24 | #:aget) 25 | (:export #:response-not-defined 26 | #:find-response 27 | #:find-media-type 28 | #:encode-response)) 29 | (in-package #:apispec/classes/response/encode) 30 | 31 | (defun find-response (responses status) 32 | (check-type responses responses) 33 | (or (aget responses (princ-to-string status)) 34 | (aget responses (format nil "~DXX" (floor (/ status 100)))) 35 | (aget responses "default") 36 | (error 'response-not-defined 37 | :code status))) 38 | 39 | (defun find-media-type (response content-type) 40 | (check-type response response) 41 | (check-type content-type string) 42 | (cdr (or (find-if (lambda (media-type-string) 43 | (starts-with-subseq media-type-string content-type)) 44 | (response-content response) 45 | :key #'car) 46 | (find-if (lambda (media-type-string) 47 | (and (not (string= media-type-string "*/*")) 48 | (match-content-type media-type-string content-type))) 49 | (response-content response) 50 | :key #'car) 51 | (find "*/*" (response-content response) 52 | :key #'car 53 | :test #'string=) 54 | (error 'response-not-defined 55 | :content-type content-type)))) 56 | 57 | (defun default-content-type (data) 58 | (cond 59 | ((null data) nil) 60 | ((typep data '(vector (unsigned-byte 8))) 61 | "application/octet-stream") 62 | ((or (typep data '(or standard-object 63 | structure-object)) 64 | (association-list-p data 'string t)) 65 | "application/json") 66 | (t "text/plain"))) 67 | 68 | (defun encode-response (status headers data responses) 69 | (check-type status (integer 100 599)) 70 | (check-type responses responses) 71 | (let ((content-type (or (getf headers :content-type) 72 | (default-content-type data))) 73 | (response (find-response responses status))) 74 | (when (and (response-content response) 75 | content-type) 76 | (setf (getf headers :content-type) content-type)) 77 | (let ((content-type (and (stringp content-type) 78 | (or (ppcre:scan-to-strings "[^;\\s]+" content-type) 79 | (error "Invalid Content-Type: ~S" content-type))))) 80 | (list status 81 | (loop for (header-name header-value) on headers by #'cddr 82 | for response-header = (cdr (assoc header-name 83 | (response-headers response) 84 | :key #'car 85 | :test #'string-equal)) 86 | if header-value 87 | append (list header-name 88 | (if response-header 89 | (progn 90 | (handler-case 91 | (validate-data header-value (header-schema response-header)) 92 | (schema-error () 93 | (error 'response-header-validation-failed 94 | :name header-name 95 | :value header-value 96 | :header response-header))) 97 | (if (or (listp header-value) 98 | (vectorp header-value)) 99 | (format nil "~{~A~^, ~}" (coerce header-value 'list)) 100 | header-value)) 101 | header-value))) 102 | (if (null (response-content response)) 103 | (if data 104 | (error 'response-body-not-allowed 105 | :code status) 106 | nil) 107 | (let ((media-type (find-media-type response content-type))) 108 | (list (let ((schema (or (and media-type 109 | (media-type-schema media-type)) 110 | t))) 111 | (handler-case 112 | (progn 113 | (validate-data data schema) 114 | (encode-data data schema content-type)) 115 | (body-encode-error (e) 116 | (error 'response-validation-failed 117 | :value data 118 | :schema schema 119 | :content-type content-type 120 | :reason (princ-to-string e)))))))))))) 121 | -------------------------------------------------------------------------------- /src/classes/response/errors.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/response/errors 2 | (:use #:cl 3 | #:apispec/errors) 4 | (:export #:response-error 5 | #:response-not-defined 6 | #:response-body-not-allowed 7 | #:response-header-validation-failed 8 | #:response-validation-failed)) 9 | (in-package #:apispec/classes/response/errors) 10 | 11 | (define-condition response-error (apispec-error) ()) 12 | 13 | (define-condition response-not-defined (response-error) 14 | ((code :type (or string integer null) 15 | :initarg :code 16 | :initform nil) 17 | (content-type :type (or string null) 18 | :initarg :content-type 19 | :initform nil)) 20 | (:report (lambda (condition stream) 21 | (with-slots (code content-type) condition 22 | (format stream "Response is not defined for~@[ code=~S~]~@[ content-type=~S~]" 23 | code content-type))))) 24 | 25 | (define-condition response-body-not-allowed (response-error) 26 | ((code :type (or string integer null) 27 | :initarg :code 28 | :initform nil)) 29 | (:report (lambda (condition stream) 30 | (format stream "Response body is not allowed for HTTP status ~A" 31 | (slot-value condition 'code))))) 32 | 33 | (define-condition response-header-validation-failed (response-error) 34 | ((name :initarg :name) 35 | (value :initarg :value) 36 | (header :initarg :header)) 37 | (:report (lambda (condition stream) 38 | (with-slots (name value header) condition 39 | (format stream "Header ~A=~S is invalid for ~A" 40 | name value header))))) 41 | 42 | (define-condition response-validation-failed (response-error) 43 | ((value :initarg :value) 44 | (schema :initarg :schema) 45 | (content-type :initarg :content-type) 46 | (reason :initarg :reason)) 47 | (:report (lambda (condition stream) 48 | (with-slots (value schema content-type reason) condition 49 | (format stream "~S is invalid for ~A to encode to '~A':~% ~A" 50 | value schema content-type reason))))) 51 | -------------------------------------------------------------------------------- /src/classes/schema.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:apispec/classes/schema 2 | (:mix-reexport #:apispec/classes/schema/core 3 | #:apispec/classes/schema/composition 4 | #:apispec/classes/schema/coerce 5 | #:apispec/classes/schema/validate 6 | #:apispec/classes/schema/errors 7 | #:cl)) 8 | -------------------------------------------------------------------------------- /src/classes/schema/coerce.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:apispec/classes/schema/coerce 2 | (:mix #:apispec/classes/schema/core 3 | #:cl) 4 | (:use #:apispec/classes/schema/errors 5 | #:apispec/utils 6 | #:parse-number) 7 | (:import-from #:apispec/classes/schema/core 8 | #:parse-schema-definition 9 | #:almost-integer) 10 | (:import-from #:apispec/classes/schema/validate 11 | #:validate-data) 12 | (:import-from #:apispec/classes/schema/errors 13 | #:message) 14 | (:import-from #:apispec/errors 15 | #:read-new-value) 16 | (:import-from #:cl-ppcre) 17 | (:import-from #:local-time) 18 | (:export #:coerce-data 19 | #:*coerce-string-to-boolean*)) 20 | (in-package #:apispec/classes/schema/coerce) 21 | 22 | (defgeneric coerce-data (value schema) 23 | (:method (value (schema symbol)) 24 | (if (eq schema t) 25 | value 26 | (coerce-data value (make-schema schema)))) 27 | (:method (value (schema cons)) 28 | (coerce-data value 29 | (multiple-value-bind (type args) 30 | (parse-schema-definition schema) 31 | (apply #'make-schema type args)))) 32 | (:method (value schema) 33 | ;; Don't raise COERCE-FAILED when the value is NIL. 34 | ;; If the schema is not nullable, it'll be catched in VALIDATE-DATA. 35 | (when value 36 | (error 'schema-coercion-failed 37 | :value value 38 | :schema schema))) 39 | (:method :around (value (schema schema)) 40 | (if (and (null value) 41 | (schema-has-default-p schema) 42 | (schema-default schema)) 43 | (schema-default schema) 44 | (restart-case 45 | (call-next-method) 46 | (use-value (&optional (new-value nil new-value-supplied)) 47 | (unless new-value-supplied 48 | (setf new-value (read-new-value))) 49 | new-value))))) 50 | 51 | (defmacro with-validation (schema &body body) 52 | (let ((results (gensym "RESULTS"))) 53 | `(let ((,results (progn ,@body))) 54 | (validate-data ,results ,schema) 55 | ,results))) 56 | 57 | ;; 58 | ;; Number Types 59 | 60 | (defmethod coerce-data :around (value (schema number)) 61 | (with-validation schema 62 | (call-next-method))) 63 | 64 | (defmethod coerce-data ((value cl:number) (schema number)) 65 | (handler-case (typecase schema 66 | (integer (coerce-to-integer value)) 67 | (float (coerce value 'cl:float)) 68 | (double (coerce value 'cl:double-float)) 69 | (otherwise value)) 70 | (error () (error 'schema-coercion-failed 71 | :value value 72 | :schema schema)))) 73 | 74 | (defmethod coerce-data ((value cl:string) (schema number)) 75 | (coerce-data 76 | (handler-case (parse-number value) 77 | (error () (error 'schema-coercion-failed 78 | :value value 79 | :schema schema))) 80 | schema)) 81 | 82 | (defmethod coerce-data ((value cl:string) (schema float)) 83 | (coerce-data 84 | (handler-case (parse-number value :float-format 'cl:single-float) 85 | (error () (error 'schema-coercion-failed 86 | :value value 87 | :schema schema))) 88 | schema)) 89 | 90 | (defmethod coerce-data ((value cl:string) (schema double)) 91 | (coerce-data 92 | (handler-case (parse-number value :float-format 'cl:double-float) 93 | (error () (error 'schema-coercion-failed 94 | :value value 95 | :schema schema))) 96 | schema)) 97 | 98 | 99 | ;; 100 | ;; String Types 101 | 102 | (defmethod coerce-data :around (value (schema string)) 103 | (with-validation schema 104 | (call-next-method))) 105 | 106 | (defmethod coerce-data ((value cl:string) (schema string)) 107 | (princ-to-string value)) 108 | 109 | (defmethod coerce-data ((value vector) (schema binary)) 110 | value) 111 | 112 | (defmethod coerce-data ((value stream) (schema binary)) 113 | value) 114 | 115 | (defmethod coerce-data ((value cl:string) (schema date)) 116 | (check-type value cl:string) 117 | (ppcre:register-groups-bind ((#'parse-integer year month date)) 118 | ("(\\d{4})-(\\d{2})-(\\d{2})" value) 119 | (local-time:universal-to-timestamp (encode-universal-time 0 0 0 date month year)))) 120 | 121 | (defmethod coerce-data ((value cl:string) (schema date-time)) 122 | (check-type value cl:string) 123 | (handler-case 124 | (local-time:parse-rfc3339-timestring value) 125 | (local-time::invalid-timestring () 126 | (error 'schema-coercion-failed :value value :schema schema)))) 127 | 128 | (defvar *coerce-string-to-boolean* nil) 129 | 130 | (defmethod coerce-data (value (schema boolean)) 131 | (typecase value 132 | (cl:string 133 | (cond 134 | ((and *coerce-string-to-boolean* (equal value "1")) t) 135 | ((and *coerce-string-to-boolean* (equal value "0")) nil) 136 | ((and *coerce-string-to-boolean* (equal value "true")) t) 137 | ((and *coerce-string-to-boolean* (equal value "false")) nil) 138 | ((and *coerce-string-to-boolean* (equal value "") 139 | (schema-has-default-p schema)) 140 | (schema-default schema)) 141 | (t (error 'schema-coercion-failed :value value :schema schema)))) 142 | (cl:boolean value) 143 | (otherwise 144 | (error 'schema-coercion-failed :value value :schema schema)))) 145 | 146 | 147 | ;; 148 | ;; Array Type 149 | 150 | (defmethod coerce-data :around (value (schema array)) 151 | (with-validation schema 152 | (call-next-method))) 153 | 154 | (defmethod coerce-data (value (schema array)) 155 | (let ((value 156 | (handler-case 157 | (typecase value 158 | (cl:string (error 'schema-coercion-failed :value value :schema schema)) 159 | (t (coerce value 'vector))) 160 | (type-error () 161 | (error 'schema-coercion-failed :value value :schema schema))))) 162 | (cond ((array-items schema) 163 | (map 'vector 164 | (lambda (item) 165 | (coerce-data item (array-items schema))) 166 | value)) 167 | (t 168 | value)))) 169 | 170 | 171 | ;; 172 | ;; Object Type 173 | 174 | (defmethod coerce-data :around (value (schema object)) 175 | (with-validation schema 176 | (call-next-method))) 177 | 178 | (defparameter *ignore-additional-properties* nil) 179 | 180 | (defmethod coerce-data (value (schema object)) 181 | (unless (typep value 'association-list) 182 | (error 'schema-coercion-failed 183 | :value value 184 | :schema schema)) 185 | (let ((invalid '()) 186 | (unpermitted '()) 187 | (properties (object-properties schema))) 188 | (prog1 189 | (nconc 190 | (loop with additional-properties = (object-additional-properties schema) 191 | for (key . field-value) in value 192 | for prop = (find key properties 193 | :key #'property-name 194 | :test #'equal) 195 | if prop 196 | collect (cons key 197 | (handler-case (coerce-data field-value (property-type prop)) 198 | (schema-coercion-failed (e) 199 | (push (cons key e) invalid)) 200 | (schema-validation-failed (e) 201 | (push (cons key e) invalid)))) 202 | else if (and (not *ignore-additional-properties*) 203 | additional-properties) 204 | collect (cons key 205 | (and field-value 206 | (coerce-data field-value additional-properties))) 207 | else if (not *ignore-additional-properties*) 208 | do (push key unpermitted)) 209 | (loop for prop in properties 210 | for type = (property-type prop) 211 | when (and (schema-has-default-p type) 212 | (not (find (property-name prop) 213 | value 214 | :key #'car 215 | :test #'equal))) 216 | collect 217 | (cons (property-name prop) 218 | (schema-default type)))) 219 | (let ((missing 220 | (loop for key in (object-required schema) 221 | unless (find key value :key #'car :test #'equal) 222 | collect key))) 223 | (when (or invalid 224 | missing 225 | unpermitted) 226 | (error 'schema-object-error 227 | :invalid (nreverse invalid) 228 | :missing missing 229 | :unpermitted (nreverse unpermitted) 230 | :value value 231 | :schema schema)))))) 232 | -------------------------------------------------------------------------------- /src/classes/schema/composition.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/schema/composition 2 | (:use #:cl 3 | #:apispec/utils) 4 | (:import-from #:apispec/classes/schema/core 5 | #:type 6 | #:schema 7 | #:object) 8 | (:import-from #:apispec/classes/schema/coerce 9 | #:*ignore-additional-properties* 10 | #:coerce-data) 11 | (:import-from #:apispec/classes/schema/validate 12 | #:validate-data) 13 | (:import-from #:apispec/classes/schema/errors 14 | #:schema-error 15 | #:schema-coercion-failed 16 | #:schema-validation-failed 17 | #:schema-oneof-error 18 | #:schema-anyof-error) 19 | (:export #:composition-schema 20 | #:schema-one-of 21 | #:schema-any-of 22 | #:schema-all-of 23 | 24 | #:negative-schema 25 | #:schema-not)) 26 | (in-package #:apispec/classes/schema/composition) 27 | 28 | (defclass composition-schema (object) 29 | ((one-of :type (proper-list object) 30 | :initarg :one-of 31 | :initform nil 32 | :reader schema-one-of) 33 | (any-of :type (proper-list object) 34 | :initarg :any-of 35 | :initform nil 36 | :reader schema-any-of) 37 | (all-of :type (proper-list object) 38 | :initarg :all-of 39 | :initform nil 40 | :reader schema-all-of))) 41 | 42 | (defclass negative-schema (schema) 43 | ((not :type schema 44 | :initarg :not 45 | :reader schema-not))) 46 | 47 | (defgeneric process-one-of (process-type value schema)) 48 | (defgeneric process-any-of (process-type value schema)) 49 | (defgeneric process-all-of (process-type value schema)) 50 | 51 | (defun process-composition-schema (process-type value schema) 52 | (cond 53 | ((schema-one-of schema) 54 | (process-one-of process-type value schema)) 55 | ((schema-any-of schema) 56 | (process-any-of process-type value schema)) 57 | ((schema-all-of schema) 58 | (process-all-of process-type value schema)))) 59 | 60 | (defun map-schemas (fn value schemas) 61 | (let ((*ignore-additional-properties* t)) 62 | (mapcar (lambda (subschema) 63 | (handler-case 64 | (cons (funcall fn value subschema) 65 | t) 66 | (schema-error () 67 | (cons nil nil)))) 68 | schemas))) 69 | 70 | (defmethod process-one-of ((process-type (eql 'coerce-data)) value schema) 71 | (let ((results (map-schemas #'coerce-data value (schema-one-of schema)))) 72 | (unless (= 1 (count t results :key #'cdr)) 73 | (error 'schema-oneof-error 74 | :value value 75 | :schema schema 76 | :subschemas (schema-one-of schema))) 77 | (car (find-if #'cdr results)))) 78 | 79 | (defmethod process-any-of ((process-type (eql 'coerce-data)) value schema) 80 | (let ((results (map-schemas #'coerce-data value (schema-any-of schema)))) 81 | (when (= 0 (count t results :key #'cdr)) 82 | (error 'schema-anyof-error 83 | :value value 84 | :schema schema 85 | :subschemas (schema-any-of schema))) 86 | (apply #'append (mapcar #'car results)))) 87 | 88 | (defmethod process-all-of ((process-type (eql 'coerce-data)) value schema) 89 | (mapcan (lambda (subschema) 90 | (coerce-data value subschema)) 91 | (schema-all-of schema))) 92 | 93 | (defmethod coerce-data (value (schema composition-schema)) 94 | (process-composition-schema 'coerce-data value schema)) 95 | 96 | (defmethod coerce-data (value (schema negative-schema)) 97 | (handler-case 98 | (coerce-data value (schema-not schema)) 99 | (schema-error () 100 | (return-from coerce-data value))) 101 | (error 'schema-coercion-failed 102 | :value value 103 | :schema schema 104 | :message "Possible for negative schema")) 105 | 106 | (defmethod process-one-of ((process-type (eql 'validate-data)) value schema) 107 | (let ((results (map-schemas #'validate-data value (schema-one-of schema)))) 108 | (unless (= 1 (count t results :key #'cdr)) 109 | (error 'schema-oneof-error 110 | :value value 111 | :schema schema 112 | :subschemas (schema-one-of schema))) 113 | t)) 114 | 115 | (defmethod process-any-of ((process-type (eql 'validate-data)) value schema) 116 | (let ((results (map-schemas #'validate-data value (schema-any-of schema)))) 117 | (when (= 0 (count t results :key #'cdr)) 118 | (error 'schema-anyof-error 119 | :value value 120 | :schema schema 121 | :subschemas (schema-any-of schema))) 122 | t)) 123 | 124 | (defmethod process-all-of ((process-type (eql 'validate-data)) value schema) 125 | (every (lambda (subschema) 126 | (handler-case (validate-data value subschema) 127 | (schema-error () 128 | nil))) 129 | (schema-all-of schema))) 130 | 131 | (defmethod validate-data (value (schema composition-schema)) 132 | (process-composition-schema 'validate-data value schema)) 133 | -------------------------------------------------------------------------------- /src/classes/schema/errors.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/classes/schema/errors 2 | (:use #:cl 3 | #:apispec/errors) 4 | (:export #:schema-error 5 | #:schema-coercion-failed 6 | #:schema-coercion-failed-value 7 | #:schema-coercion-failed-schema 8 | #:schema-object-error 9 | #:schema-object-error-missing-keys 10 | #:schema-object-error-invalid-keys 11 | #:schema-object-error-unpermitted-keys 12 | #:schema-object-error-value 13 | #:schema-object-error-schema 14 | #:schema-validation-failed 15 | #:schema-multiple-error 16 | #:schema-oneof-error 17 | #:schema-anyof-error)) 18 | (in-package #:apispec/classes/schema/errors) 19 | 20 | (define-condition schema-error (apispec-error) ()) 21 | 22 | (define-condition schema-coercion-failed (schema-error coercion-failed) 23 | ((value :initarg :value :reader schema-coercion-failed-value) 24 | (schema :initarg :schema :reader schema-coercion-failed-schema)) 25 | (:report (lambda (condition stream) 26 | (with-slots (value schema) condition 27 | (format stream "~S cannot be coerced to ~A" 28 | value 29 | schema))))) 30 | 31 | (define-condition schema-validation-failed (schema-error validation-failed) 32 | ((value :initarg :value 33 | :reader schema-validation-failed-value) 34 | (schema :initarg :schema 35 | :reader schema-validation-failed-schema) 36 | (message :initarg :message 37 | :initform nil)) 38 | (:report (lambda (condition stream) 39 | (with-slots (value schema message) condition 40 | (format stream "~S is invalid for ~A~@[:~% ~A~]" 41 | value 42 | schema 43 | message))))) 44 | 45 | (define-condition schema-object-error (schema-error) 46 | ((missing :initarg :missing 47 | :reader schema-object-error-missing-keys) 48 | (invalid :initarg :invalid 49 | :reader schema-object-error-invalid-key-error-pairs) 50 | (unpermitted :initarg :unpermitted 51 | :reader schema-object-error-unpermitted-keys) 52 | (value :initarg :value 53 | :reader schema-object-value) 54 | (schema :initarg :schema 55 | :reader schema-object-schema)) 56 | (:report (lambda (condition stream) 57 | (write-string "Invalid object:" stream) 58 | (with-accessors ((missing schema-object-error-missing-keys) 59 | (invalid schema-object-error-invalid-key-error-pairs) 60 | (unpermitted schema-object-error-unpermitted-keys)) 61 | condition 62 | (when missing 63 | (format stream "~% Missing: ~{~A~^, ~}" missing)) 64 | (when unpermitted 65 | (format stream "~% Unpermitted: ~{~A~^, ~}" unpermitted)) 66 | (when invalid 67 | (format stream "~% Invalid:") 68 | (loop :for (key . schema-error) :in invalid 69 | :do (format stream "~% ~A: ~A" key schema-error))))))) 70 | 71 | (defun schema-object-error-invalid-keys (schema-object-error) 72 | (mapcar #'car (schema-object-error-invalid-key-error-pairs schema-object-error))) 73 | 74 | (define-condition schema-multiple-error (schema-error) 75 | ((subschemas 76 | :initarg :subschemas 77 | :reader schema-multiple-error-subschemas))) 78 | 79 | (define-condition schema-oneof-error (schema-multiple-error) 80 | () 81 | (:report (lambda (condition stream) 82 | (format stream 83 | "Multiple schemas are possible for oneOf composition schema: ~{~A~^ ~}" 84 | (schema-multiple-error-subschemas condition))))) 85 | 86 | (define-condition schema-anyof-error (schema-multiple-error) 87 | () 88 | (:report (lambda (condition stream) 89 | (format stream 90 | "Every schemas aren't possible for anyOf composition schema: ~{~A~^ ~}" 91 | (schema-multiple-error-subschemas condition))))) 92 | -------------------------------------------------------------------------------- /src/classes/schema/validate.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:apispec/classes/schema/validate 2 | (:mix #:apispec/classes/schema/core 3 | #:cl) 4 | (:use #:apispec/classes/schema/errors) 5 | (:import-from #:apispec/classes/schema/core 6 | #:parse-schema-definition) 7 | (:import-from #:apispec/utils 8 | #:association-list 9 | #:email-format-p 10 | #:uuid-format-p 11 | #:json-string-p) 12 | (:import-from #:cl-ppcre) 13 | (:import-from #:local-time) 14 | (:export #:schema-validation-failed 15 | #:validate-data)) 16 | (in-package #:apispec/classes/schema/validate) 17 | 18 | (defgeneric validate-data (value schema) 19 | (:method (value (schema symbol)) 20 | (validate-data value (make-schema schema))) 21 | (:method (value (schema cons)) 22 | (validate-data value 23 | (multiple-value-bind (type args) 24 | (parse-schema-definition schema) 25 | (apply #'make-schema type args)))) 26 | (:method :around ((value null) (schema schema)) 27 | (unless (or (typep schema 'boolean) ;; BOOLEAN can be NIL 28 | (schema-nullable-p schema) 29 | (typep schema 'object)) 30 | (error 'schema-validation-failed 31 | :value value 32 | :schema schema 33 | :message "Not nullable")) 34 | (if (typep schema 'object) 35 | (call-next-method) 36 | t)) 37 | (:method (value (schema schema)) 38 | t) 39 | (:method :around (value (schema schema)) 40 | (restart-case (call-next-method) 41 | (skip-validation () value)))) 42 | 43 | 44 | ;; 45 | ;; Number Types 46 | 47 | (defmethod validate-data (value (schema number)) 48 | (unless (numberp value) 49 | (error 'schema-validation-failed 50 | :value value 51 | :schema schema 52 | :message "Not a number")) 53 | 54 | (unless (and (or (not (number-minimum schema)) 55 | (funcall (if (number-exclusive-minimum-p schema) 56 | #'< 57 | #'<=) 58 | (number-minimum schema) 59 | value)) 60 | (or (not (number-maximum schema)) 61 | (funcall (if (number-exclusive-maximum-p schema) 62 | #'< 63 | #'<=) 64 | value 65 | (number-maximum schema)))) 66 | (error 'schema-validation-failed 67 | :value value 68 | :schema schema 69 | :message 70 | (with-output-to-string (*standard-output*) 71 | (princ "Not in range of ") 72 | (when (number-minimum schema) 73 | (princ (number-minimum schema)) 74 | (write-char #\Space) 75 | (if (number-exclusive-minimum-p schema) 76 | (princ "< ") 77 | (princ "<= "))) 78 | (princ "value ") 79 | (when (number-maximum schema) 80 | (if (number-exclusive-maximum-p schema) 81 | (princ "< ") 82 | (princ "<= ")) 83 | (princ (number-maximum schema)))))) 84 | (when (number-multiple-of schema) 85 | (unless (= (mod value (number-multiple-of schema)) 0) 86 | (error 'schema-validation-failed 87 | :value value 88 | :schema schema 89 | :message (format nil "Not multiple of ~A" (number-multiple-of schema))))) 90 | 91 | t) 92 | 93 | 94 | ;; 95 | ;; String Types 96 | 97 | (defmethod validate-data (value (schema string)) 98 | (unless (stringp value) 99 | (error 'schema-validation-failed 100 | :value value 101 | :schema schema 102 | :message "Not a string")) 103 | 104 | (unless (and (or (not (string-min-length schema)) 105 | (<= (string-min-length schema) (length value))) 106 | (or (not (string-max-length schema)) 107 | (<= (length value) (string-max-length schema)))) 108 | (error 'schema-validation-failed 109 | :value value 110 | :schema schema 111 | :message (format nil "The length not in the range~@[ from ~A~]~@[ to ~A~]" 112 | (string-min-length schema) 113 | (string-max-length schema)))) 114 | 115 | (unless (or (not (string-pattern schema)) 116 | (ppcre:scan (string-pattern schema) value)) 117 | (error 'schema-validation-failed 118 | :value value 119 | :schema schema 120 | :message (format nil "Not match to ~S" 121 | (string-pattern schema)))) 122 | 123 | (when (schema-enum schema) 124 | (unless (find value (schema-enum schema) :test #'string=) 125 | (error 'schema-validation-failed 126 | :value value 127 | :schema schema))) 128 | 129 | (unless (or (not (equal "email" (schema-format schema))) 130 | (email-format-p value)) 131 | (error 'schema-validation-failed 132 | :value value 133 | :schema schema)) 134 | 135 | (unless (or (not (equal "uuid" (schema-format schema))) 136 | (uuid-format-p value)) 137 | (error 'schema-validation-failed 138 | :value value 139 | :schema schema)) 140 | 141 | (when (and (equal "json" (schema-format schema)) 142 | (not (json-string-p value))) 143 | (error 'schema-validation-failed 144 | :value value 145 | :schema schema)) 146 | 147 | t) 148 | 149 | (defmethod validate-data (value (schema binary)) 150 | (unless (typep value '(or (vector (unsigned-byte 8)) 151 | stream)) 152 | (error 'schema-validation-failed 153 | :value value 154 | :schema schema 155 | :message "Not a byte vector")) 156 | 157 | t) 158 | 159 | (defun ensure-data-1 (value ensure-fn) 160 | (typecase value 161 | (cl:string 162 | (handler-case (funcall ensure-fn value) 163 | (error () 164 | nil))) 165 | (local-time:timestamp 166 | value) 167 | (otherwise 168 | nil))) 169 | 170 | (defun ensure-date (value) 171 | (ensure-data-1 value 172 | (lambda (value) 173 | ;; https://tools.ietf.org/html/rfc3339#section-5.6 full-date 174 | (and (ppcre:scan "^\\d{4}-\\d{2}-\\d{2}$" value) 175 | (local-time:parse-rfc3339-timestring value :allow-missing-time-part t))))) 176 | 177 | (defun ensure-date-time (value) 178 | (ensure-data-1 value 179 | (lambda (value) 180 | ;; https://tools.ietf.org/html/rfc3339#section-5.6 date-time 181 | (and (ppcre:scan "^\\d{4}-\\d{2}-\\d{2}T\\d{2}:\\d{2}:\\d{2}(?:\\.\\d+)?(?:Z|[+-]\\d{2}:\\d{2})" value) 182 | (local-time:parse-rfc3339-timestring value))))) 183 | 184 | (defmethod validate-data (value (schema date)) 185 | (unless (ensure-date value) 186 | (error 'schema-validation-failed 187 | :value value 188 | :schema schema 189 | :message "Not a LOCAL-TIME:TIMESTAMP")) 190 | t) 191 | 192 | (defmethod validate-data (value (schema date-time)) 193 | (unless (ensure-date-time value) 194 | (error 'schema-validation-failed 195 | :value value 196 | :schema schema 197 | :message "Not a LOCAL-TIME:TIMESTAMP")) 198 | t) 199 | 200 | 201 | ;; 202 | ;; Array Type 203 | 204 | (defmethod validate-data (value (schema array)) 205 | (unless (and (not (stringp value)) 206 | (arrayp value)) 207 | (error 'schema-validation-failed 208 | :value value 209 | :schema schema 210 | :message "Not an array")) 211 | 212 | (unless (and (or (not (array-min-items schema)) 213 | (<= (array-min-items schema) (length value))) 214 | (or (not (array-max-items schema)) 215 | (<= (length value) (array-max-items schema)))) 216 | (error 'schema-validation-failed 217 | :value value 218 | :schema schema 219 | :message (format nil "The length not in the range~@[ from ~A~]~@[ to ~A~]" 220 | (array-min-items schema) 221 | (array-max-items schema)))) 222 | 223 | (when (array-unique-items-p schema) 224 | (unless (= (length (remove-duplicates value :test #'equal)) 225 | (length value)) 226 | (error 'schema-validation-failed 227 | :value value 228 | :schema schema 229 | :message "The items are not unique"))) 230 | 231 | (when (array-items schema) 232 | (map nil 233 | (lambda (item) 234 | (validate-data item (array-items schema))) 235 | value)) 236 | 237 | t) 238 | 239 | 240 | ;; 241 | ;; Object Type 242 | 243 | (defmethod validate-data (value (schema object)) 244 | (unless (typep value 'association-list) 245 | (error 'schema-validation-failed 246 | :value value 247 | :schema schema 248 | :message "Not an association list")) 249 | 250 | (unless (object-properties schema) 251 | (return-from validate-data value)) 252 | 253 | (let ((invalid '()) 254 | (unpermitted '())) 255 | (loop for (key . field-value) in value 256 | for prop = (find key (object-properties schema) 257 | :key #'property-name 258 | :test #'equal) 259 | do (if prop 260 | (handler-case (validate-data field-value (property-type prop)) 261 | (schema-validation-failed (e) 262 | (push (cons key e) invalid))) 263 | (let ((additional-properties (object-additional-properties schema))) 264 | (etypecase additional-properties 265 | (null (push key unpermitted)) 266 | ((eql t)) 267 | (schema (validate-data field-value additional-properties)))))) 268 | (let ((missing 269 | (loop for key in (object-required schema) 270 | unless (find key value :key #'car :test #'equal) 271 | collect key))) 272 | (when (or invalid 273 | missing 274 | unpermitted) 275 | (error 'schema-object-error 276 | :invalid (nreverse invalid) 277 | :missing missing 278 | :unpermitted (nreverse unpermitted) 279 | :value value 280 | :schema schema)) 281 | (unless (and (or (not (object-min-properties schema)) 282 | (nthcdr (object-min-properties schema) value)) 283 | (or (not (object-max-properties schema)) 284 | (nthcdr (object-max-properties schema) value))) 285 | (error 'schema-validation-failed 286 | :value value 287 | :schema schema 288 | :message 289 | (format nil "The number of properties has to be in the range of~@[ ~A <=~] (length properties)~@[ <= ~A~]" 290 | (object-min-properties schema) 291 | (object-max-properties schema)))) 292 | t))) 293 | -------------------------------------------------------------------------------- /src/complex.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/complex 2 | (:use #:cl 3 | #:apispec/utils) 4 | (:import-from #:apispec/classes/schema 5 | #:object 6 | #:find-object-property 7 | #:property-type 8 | #:schema 9 | #:coerce-data 10 | #:*coerce-string-to-boolean*) 11 | (:shadowing-import-from #:apispec/classes/schema 12 | #:array) 13 | (:import-from #:cl-ppcre) 14 | (:import-from #:cl-utilities 15 | #:collecting 16 | #:collect) 17 | (:import-from #:alexandria 18 | #:when-let) 19 | (:import-from #:assoc-utils 20 | #:aget 21 | #:alist-keys) 22 | (:export #:complex-style-string-p 23 | #:complex-style 24 | #:parse-matrix-value 25 | #:parse-label-value 26 | #:parse-form-value 27 | #:parse-simple-value 28 | #:parse-space-delimited-value 29 | #:parse-pipe-delimited-value 30 | #:parse-deep-object-value 31 | #:parse-complex-string 32 | #:parse-complex-parameter 33 | #:parse-complex-parameters)) 34 | (in-package #:apispec/complex) 35 | 36 | (defun complex-style-string-p (style) 37 | (and (member style '("matrix" "label" "form" "simple" "spaceDelimited" "pipeDelimited" "deepObject") 38 | :test #'equal) 39 | t)) 40 | 41 | (deftype complex-style () 42 | '(satisfies complex-style-string-p)) 43 | 44 | (defun parse-matrix-value (value &key as explode) 45 | (typecase as 46 | (array 47 | (if explode 48 | (let ((results '())) 49 | (ppcre:do-register-groups (k v) 50 | (";([^=;]+)(?:=([^;]+))?" value) 51 | (push v (aget results k))) 52 | (loop for (k . v) in results 53 | collect (cons k (coerce (nreverse v) 'vector)))) 54 | (collecting 55 | (ppcre:do-register-groups (k v) 56 | (";([^=;]+)(?:=([^;]+))?" value) 57 | (collect (cons k 58 | (coerce (ppcre:split "," v) 'vector))))))) 59 | (object 60 | (collecting 61 | (ppcre:do-register-groups (k v) 62 | (";([^=;]+)(?:=([^;]+))?" value) 63 | (collect 64 | (cons k 65 | (if explode 66 | v 67 | (loop for (k v) on (ppcre:split "," v) by #'cddr 68 | collect (cons k v)))))))) 69 | (otherwise 70 | (collecting 71 | (ppcre:do-register-groups (k v) 72 | (";([^=;]+)(?:=([^;]+))?" value) 73 | (collect (cons k v))))))) 74 | 75 | (defun parse-label-value (value &key as explode) 76 | (typecase as 77 | (array 78 | (coerce (collecting 79 | (ppcre:do-matches-as-strings (matches "(?<=\\.)([^\\.]+)" value) 80 | (collect matches))) 81 | 'vector)) 82 | (object 83 | (if explode 84 | (collecting 85 | (ppcre:do-register-groups (kv) ("\\.([^\\.]+)" value) 86 | (let ((kv (ppcre:split "=" kv))) 87 | (collect (cons (first kv) (second kv)))))) 88 | (loop for (k v) on (collecting 89 | (ppcre:do-register-groups (kv) ("\\.([^\\.]+)" value) 90 | (collect kv))) by #'cddr 91 | collect (cons k v)))) 92 | (otherwise 93 | (values (ppcre:scan-to-strings "(?<=\\.)([^\\.]+)" value))))) 94 | 95 | (defun parse-form-value (parameters name &key as explode) 96 | (let ((*coerce-string-to-boolean* t)) 97 | (coerce-data 98 | (typecase as 99 | (array 100 | (if explode 101 | (map 'vector #'cdr 102 | (remove-if-not (lambda (param-name) 103 | (equal param-name name)) 104 | parameters 105 | :key #'car)) 106 | (when-let (val (aget parameters name)) 107 | (coerce (ppcre:split "," val) 'vector)))) 108 | (object 109 | (if explode 110 | parameters 111 | (when-let (val (aget parameters name)) 112 | (loop for (k v) on (ppcre:split "," val) by #'cddr 113 | collect (cons k v))))) 114 | (otherwise 115 | (aget parameters name))) 116 | (or as t)))) 117 | 118 | (defun parse-simple-value (value &key as explode) 119 | (let ((key-values (ppcre:split "," value))) 120 | (typecase as 121 | (array 122 | (coerce (ppcre:split "," value) 'vector)) 123 | (object 124 | (if explode 125 | (loop for kv in key-values 126 | collect (apply #'cons (ppcre:split "=" kv :limit 2))) 127 | (loop for (k v) on key-values by #'cddr 128 | collect (cons k v)))) 129 | (otherwise 130 | value)))) 131 | 132 | (defun %parse-delimited-value (delimiter value &key as) 133 | (let ((values (ppcre:split (ppcre:quote-meta-chars delimiter) value))) 134 | (coerce-data 135 | (typecase as 136 | (array (coerce values 'vector)) 137 | (object 138 | (loop for (k v) on values by #'cddr 139 | collect (cons k v))) 140 | (otherwise 141 | (if (rest values) 142 | values 143 | (first values)))) 144 | (or as t)))) 145 | 146 | (defun parse-comma-separated-value (value &key as) 147 | (%parse-delimited-value "," value :as as)) 148 | 149 | (defun parse-space-delimited-value (value &key as) 150 | (%parse-delimited-value " " value :as as)) 151 | 152 | (defun parse-pipe-delimited-value (value &key as) 153 | (%parse-delimited-value "|" value :as as)) 154 | 155 | (defun parse-deep-object-value (parameters &optional name) 156 | (let ((results '())) 157 | (loop for (key . val) in parameters 158 | do (destructuring-bind (key prop) 159 | (coerce 160 | (nth-value 1 (ppcre:scan-to-strings "([^\\[]*)(?:\\[([^\\]+])\\])?" key)) 161 | 'list) 162 | (when (or (null name) (string= name key)) 163 | (if prop 164 | (setf (aget results key) 165 | (append (aget results key) 166 | (list (cons prop val)))) 167 | (setf (aget results key) val))))) 168 | (if name 169 | (aget results name) 170 | results))) 171 | 172 | (defun parse-complex-string (value style explode schema) 173 | (check-type value string) 174 | (check-type style string) 175 | (cond 176 | ((equal style "matrix") 177 | (parse-matrix-value value 178 | :as schema 179 | :explode explode)) 180 | ((equal style "label") 181 | (parse-label-value value 182 | :as schema 183 | :explode explode)) 184 | ((equal style "simple") 185 | (parse-simple-value value 186 | :as schema 187 | :explode explode)) 188 | (t 189 | (error "Unexpected style: ~S" style)))) 190 | 191 | (defun parse-complex-parameter (alist name style explode schema) 192 | (assert (association-list-p alist 'string '(or null string))) 193 | (check-type schema schema) 194 | (let ((*coerce-string-to-boolean* (string= style "form"))) 195 | (coerce-data 196 | (cond 197 | ((equal style "form") 198 | (if explode 199 | (loop for (key . value) in alist 200 | if (string= key name) 201 | collect value into values 202 | finally 203 | (return 204 | (if (or (typep values '(or array object)) 205 | (rest values)) 206 | values 207 | (first values)))) 208 | (parse-comma-separated-value (aget alist name) 209 | :as schema))) 210 | ((equal style "spaceDelimited") 211 | (parse-space-delimited-value (aget alist name) 212 | :as schema)) 213 | ((equal style "pipeDelimited") 214 | (parse-pipe-delimited-value (aget alist name) 215 | :as schema)) 216 | ((equal style "deepObject") 217 | (parse-deep-object-value alist name)) 218 | (t (error "Unexpected style: ~S" style))) 219 | schema))) 220 | 221 | (defun parse-complex-parameters (alist style explode schema) 222 | (check-type schema object) 223 | (if explode 224 | (let ((keys (remove-duplicates (alist-keys alist) :test 'equal :from-end t))) 225 | (loop for key in keys 226 | for values = (mapcar #'cdr 227 | (remove-if-not 228 | (lambda (pair) 229 | (string= (car pair) key)) 230 | alist)) 231 | for key-property = (find-object-property schema key) 232 | for key-schema = (or (and key-property 233 | (property-type key-property)) 234 | t) 235 | collect (cons key 236 | (typecase key-schema 237 | ((or array object) (coerce-data values key-schema)) 238 | (otherwise 239 | (coerce-data (if (rest values) 240 | values 241 | (first values)) 242 | key-schema)))))) 243 | (if (equal style "deepObject") 244 | (coerce-data (parse-deep-object-value alist) schema) 245 | (loop for (key . val) in alist 246 | for key-property = (find-object-property schema key) 247 | for key-schema = (or (and key-property 248 | (property-type key-property)) 249 | t) 250 | collect (cons key 251 | (coerce-data 252 | (let ((values (cond 253 | ((equal style "form") 254 | (parse-comma-separated-value val 255 | :as key-schema)) 256 | ((equal style "spaceDelimited") 257 | (parse-space-delimited-value val 258 | :as key-schema)) 259 | ((equal style "pipeDelimited") 260 | (parse-pipe-delimited-value val 261 | :as key-schema)) 262 | (t (error "Unexpected style: ~S" style))))) 263 | values) 264 | key-schema)))))) 265 | -------------------------------------------------------------------------------- /src/errors.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/errors 2 | (:use #:cl) 3 | (:export #:apispec-error 4 | #:input-error 5 | #:coercion-failed 6 | #:validation-failed 7 | #:complex-parse-failed 8 | #:read-new-value)) 9 | (in-package #:apispec/errors) 10 | 11 | ;; 12 | ;; Base Error Class 13 | 14 | (define-condition apispec-error (error) ()) 15 | 16 | ;; 17 | ;; Input Error 18 | 19 | (define-condition input-error (apispec-error) ()) 20 | 21 | (define-condition coercion-failed (input-error) ()) 22 | 23 | (define-condition validation-failed (input-error) ()) 24 | 25 | (define-condition complex-parse-failed (input-error) ()) 26 | 27 | ;; 28 | ;; For restarting 29 | 30 | (defun read-new-value () 31 | (format t "Enter a new value: ") 32 | (eval (read))) 33 | -------------------------------------------------------------------------------- /src/file-loader.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/file-loader 2 | (:use #:cl 3 | #:openapi-parser/schema/3/interface) 4 | (:import-from #:apispec/classes/schema 5 | #:schema 6 | #:composition-schema) 7 | (:import-from #:apispec/classes/parameter 8 | #:parameter) 9 | (:import-from #:apispec/classes/path 10 | #:path-item) 11 | (:import-from #:apispec/classes/operation 12 | #:operation) 13 | (:import-from #:apispec/classes/response 14 | #:response) 15 | (:import-from #:apispec/classes/request-body 16 | #:request-body) 17 | (:import-from #:apispec/classes/media-type 18 | #:media-type) 19 | (:import-from #:apispec/classes/encoding 20 | #:encoding) 21 | (:import-from #:apispec/classes/header 22 | #:header) 23 | (:shadowing-import-from #:apispec/classes/schema 24 | #:number 25 | #:double 26 | #:binary 27 | #:date 28 | #:date-time 29 | #:email 30 | #:uuid 31 | #:json 32 | #:object 33 | #:property 34 | #:float 35 | #:integer 36 | #:string 37 | #:byte 38 | #:boolean 39 | #:array) 40 | (:import-from #:apispec/router 41 | #:make-router) 42 | (:import-from #:alexandria 43 | #:when-let*) 44 | (:import-from #:cl-yaml 45 | #:parse) 46 | (:export #:spec 47 | #:spec-version 48 | #:spec-router 49 | #:spec-schemas 50 | #:load-from-file)) 51 | (in-package #:apispec/file-loader) 52 | 53 | (defvar *path-item-parameters*) 54 | 55 | (defgeneric make-from (schema)) 56 | 57 | (defmethod make-from ((schema )) 58 | (apply #'make-instance 59 | 'parameter 60 | :name (->name schema) 61 | :in (->in schema) 62 | :required (->required schema) 63 | :schema (when (->schema schema) 64 | (make-from (->schema schema))) 65 | :allow-reserved (->allow-reserved schema) 66 | (append (and (->style schema) 67 | `(:style ,(->style schema))) 68 | (and (->explode schema) 69 | `(:explode ,(->explode schema)))))) 70 | 71 | ;; 72 | ;; These accessors are deleted in 3.1.x 73 | 74 | (defun get-nullable (schema) 75 | (typecase schema 76 | (openapi-parser/schema/3.0.1: (->nullable schema)) 77 | (otherwise nil))) 78 | 79 | (defun get-deprecated (schema) 80 | (typecase schema 81 | (openapi-parser/schema/3.0.1: (->deprecated schema)) 82 | (otherwise nil))) 83 | 84 | (defmethod make-from ((schema )) 85 | (let ((type (->type schema)) 86 | (format (->format schema)) 87 | (common-args 88 | (append (unless (eq (->default schema #1='#:default) #1#) 89 | (list :default (->default schema))) 90 | (list :enum (->enum schema) 91 | :nullable (get-nullable schema) 92 | :deprecated (get-deprecated schema))))) 93 | (cond 94 | ((or (string= type "object") 95 | (and (null type) ; dead code? 96 | (->properties schema))) 97 | (apply #'make-instance 'object 98 | :required (->required schema) 99 | :properties (and (->properties schema) 100 | (loop for key being each hash-key of (->properties schema) 101 | using (hash-value value) 102 | collect (make-instance 'property 103 | :name key 104 | :type (make-from value)))) 105 | :max-properties (->max-properties schema) 106 | :min-properties (->min-properties schema) 107 | :additional-properties (if (typep (->additional-properties schema) 'cl:boolean) 108 | (->additional-properties schema) 109 | (make-from (->additional-properties schema))) 110 | common-args)) 111 | ((or (string= type "number") 112 | (string= type "integer")) 113 | (apply #'make-instance (cond 114 | ((string= format "float") 'float) 115 | ((string= format "double") 'double) 116 | ((string= type "integer") 'integer) 117 | (t 'number)) 118 | :multiple-of (->multiple-of schema) 119 | :maximum (->maximum schema) 120 | :exclusive-maximum (->exclusive-maximum schema) 121 | :minimum (->minimum schema) 122 | :exclusive-minimum (->exclusive-minimum schema) 123 | common-args)) 124 | ((string= type "string") 125 | (apply #'make-instance (cond 126 | ((string= format "byte") 'byte) 127 | ((string= format "binary") 'binary) 128 | ((string= format "date") 'date) 129 | ((string= format "date-time") 'date-time) 130 | ((string= format "email") 'email) 131 | ((string= format "uuid") 'uuid) 132 | ((string= format "json") 'json) 133 | (t 'string)) 134 | :max-length (->max-length schema) 135 | :min-length (->min-length schema) 136 | :pattern (->pattern schema) 137 | common-args)) 138 | ((string= type "boolean") 139 | (apply #'make-instance 'boolean common-args)) 140 | ((string= type "array") 141 | (apply #'make-instance 'array 142 | :items (and (->items schema) 143 | (make-from (->items schema))) 144 | :max-items (->max-items schema) 145 | :min-items (->min-items schema) 146 | :unique-items (->unique-items schema) 147 | common-args)) 148 | ((or (->one-of schema) 149 | (->any-of schema) 150 | (->all-of schema)) 151 | (apply #'make-instance 'composition-schema 152 | :one-of (mapcar (lambda (subschema) 153 | (make-from subschema)) 154 | (->one-of schema)) 155 | :any-of (mapcar (lambda (subschema) 156 | (make-from subschema)) 157 | (->any-of schema)) 158 | :all-of (mapcar (lambda (subschema) 159 | (make-from subschema)) 160 | (->all-of schema)) 161 | common-args)) 162 | ((->not schema) 163 | (apply #'make-instance 'negative-schema ; ERROR 164 | :not (make-from (->not schema)) 165 | common-args)) 166 | (t 167 | (apply #'make-instance 'schema common-args))))) 168 | 169 | (defmethod make-from ((schema )) 170 | (let ((*path-item-parameters* (->parameters schema))) 171 | (make-instance 'path-item 172 | :summary (->summary schema) 173 | :description (->description schema) 174 | :parameters (mapcar #'make-from *path-item-parameters*) 175 | :get (when (->get schema) (make-from (->get schema))) 176 | :put (when (->put schema) (make-from (->put schema))) 177 | :post (when (->post schema) (make-from (->post schema))) 178 | :delete (when (->delete schema) (make-from (->delete schema))) 179 | :options (when (->options schema) (make-from (->options schema))) 180 | :head (when (->head schema) (make-from (->head schema))) 181 | :patch (when (->patch schema) (make-from (->patch schema))) 182 | :trace (when (->trace schema) (make-from (->trace schema)))))) 183 | 184 | (defun parameter= (parameter1 parameter2) 185 | (check-type parameter1 ) 186 | (check-type parameter2 ) 187 | (and (equal (->name parameter1) (->name parameter2)) 188 | (equal (->in parameter1) (->in parameter2)))) 189 | 190 | (defun merge-parameters (parameters1 parameters2) 191 | (append (remove-if (lambda (parameter) 192 | (member parameter parameters2 193 | :test #'parameter=)) 194 | parameters1) 195 | parameters2)) 196 | 197 | (defmethod make-from ((schema )) 198 | (make-instance 'operation 199 | :%schema schema 200 | :tags (->tags schema) 201 | :summary (->summary schema) 202 | :description (->description schema) 203 | :parameters (mapcar #'make-from 204 | (merge-parameters *path-item-parameters* 205 | (->parameters schema))) 206 | :request-body (and (->request-body schema) 207 | (make-from (->request-body schema))) 208 | :responses (loop :for (status-code . response) :in (->field* (->responses schema)) 209 | :collect (cons status-code (make-from response))) 210 | :deprecated (->deprecated schema))) 211 | 212 | (defmethod make-from ((schema )) 213 | (make-instance 'response 214 | :description (->description schema) 215 | :headers (and (->headers schema) 216 | (loop for key being each hash-key of (->headers schema) 217 | using (hash-value value) 218 | collect (cons key 219 | (make-from value)))) 220 | :content (and (->content schema) 221 | (loop for key being each hash-key of (->content schema) 222 | using (hash-value value) 223 | collect (cons key 224 | (and value 225 | (make-from value))))))) 226 | 227 | (defmethod make-from ((schema )) 228 | (make-instance 'request-body 229 | :description (->description schema) 230 | :content (loop for key being each hash-key of (->content schema) 231 | using (hash-value value) 232 | collect (cons key 233 | (make-from value))) 234 | :required (->required schema))) 235 | 236 | (defmethod make-from ((schema )) 237 | (make-instance 'media-type 238 | :schema (and (->schema schema) 239 | (make-from (->schema schema))) 240 | :encoding (and (->encoding schema) 241 | (loop for key being each hash-key of (->encoding schema) 242 | using (hash-value value) 243 | collect (cons key 244 | (make-from value)))))) 245 | 246 | (defmethod make-from ((schema )) 247 | (apply #'make-instance 'encoding 248 | :content-type (->content-type schema) 249 | :headers (and (->headers schema) 250 | (loop for key being each hash-key of (->headers schema) 251 | using (hash-value value) 252 | collect (cons key 253 | (make-from value)))) 254 | :allow-reserved (->allow-reserved schema) 255 | (append (and (->style schema) 256 | `(:style ,(->style schema))) 257 | (and (->explode schema) 258 | `(:expldoe ,(->explode schema)))))) 259 | 260 | (defmethod make-from ((schema
)) 261 | (make-instance 'header 262 | :required (->required schema) 263 | :schema (and (->schema schema) 264 | (make-from (->schema schema))) 265 | :explode (->explode schema))) 266 | 267 | (defun get-paths-object (openapi) 268 | (loop :for (path . path-item) :in (->field* (->paths openapi)) 269 | :collect (cons path 270 | (make-from path-item)))) 271 | 272 | (defun get-schemas-object (openapi) 273 | (when-let* ((components (->components openapi)) 274 | (schemas (->schemas components))) 275 | (loop for schema-name being each hash-key of schemas 276 | using (hash-value schema-value) 277 | collect (cons schema-name (make-from schema-value))))) 278 | 279 | (defstruct spec 280 | openapi 281 | router 282 | schemas) 283 | 284 | (defun spec-version (spec) 285 | (->openapi (spec-openapi spec))) 286 | 287 | (defun load-from-file (file) 288 | (let ((openapi (openapi-parser:parse-file file)) 289 | (*path-item-parameters* '())) 290 | (make-spec :openapi openapi 291 | :router (make-router (get-paths-object openapi)) 292 | :schemas (get-schemas-object openapi)))) 293 | -------------------------------------------------------------------------------- /src/main.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:apispec 2 | (:nicknames #:apispec/main) 3 | (:mix #:cl 4 | #:apispec/classes/schema) 5 | (:export #:schema 6 | #:schemap 7 | #:schema-type 8 | #:schema-format 9 | #:schema-enum 10 | #:schema-default 11 | #:schema-has-default-p 12 | #:schema-nullable-p 13 | #:schema-deprecated-p 14 | #:make-schema 15 | #:defschema 16 | 17 | #:number-multiple-of 18 | #:number-maximum 19 | #:number-exclusive-maximum-p 20 | #:number-minimum 21 | #:number-exclusive-minimum-p 22 | 23 | #:string-max-length 24 | #:string-min-length 25 | #:string-pattern 26 | 27 | #:binary 28 | #:date 29 | #:date-time 30 | #:email 31 | #:uuid 32 | 33 | #:array-items 34 | #:array-max-items 35 | #:array-min-items 36 | 37 | #:object 38 | #:object-required 39 | #:object-properties 40 | #:object-max-properties 41 | #:object-min-properties 42 | #:object-additional-properties 43 | 44 | #:property 45 | #:property-name 46 | #:property-type 47 | 48 | #:coerce-data 49 | #:validate-data 50 | 51 | #:schema-error 52 | #:schema-coercion-failed 53 | #:schema-validation-failed 54 | #:schema-object-error 55 | #:schema-object-error-missing-keys 56 | #:schema-object-error-invalid-keys 57 | #:schema-object-error-unpermitted-keys) 58 | (:mix-reexport #:apispec/classes/header 59 | #:apispec/classes/encoding 60 | #:apispec/classes/media-type 61 | #:apispec/classes/operation 62 | #:apispec/classes/parameter 63 | #:apispec/classes/request-body 64 | #:apispec/classes/response 65 | #:apispec/classes/path 66 | #:apispec/body 67 | #:apispec/router 68 | #:apispec/file-loader 69 | #:apispec/errors)) 70 | -------------------------------------------------------------------------------- /src/router.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/router 2 | (:use #:cl) 3 | (:import-from #:apispec/classes/path 4 | #:paths 5 | #:compile-paths 6 | #:find-operation) 7 | (:export #:router 8 | #:make-router 9 | #:find-route)) 10 | (in-package #:apispec/router) 11 | 12 | (defstruct (router (:constructor %make-router)) 13 | paths 14 | %dispatch-fn) 15 | 16 | (defun make-router (paths) 17 | (%make-router :paths paths 18 | :%dispatch-fn (compile-paths paths))) 19 | 20 | (defun find-path-item (router path-info) 21 | (funcall (router-%dispatch-fn router) 22 | path-info)) 23 | 24 | (defun find-route (router method path-info) 25 | (multiple-value-bind (matched-path path-parameters) 26 | (find-path-item router path-info) 27 | (when matched-path 28 | (values (find-operation matched-path method) 29 | path-parameters)))) 30 | -------------------------------------------------------------------------------- /src/utils.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:apispec/utils 2 | (:use #:cl) 3 | (:use-reexport #:apispec/utils/media-type) 4 | (:import-from #:trivial-cltl2 5 | #:declaration-information) 6 | (:import-from #:flexi-streams) 7 | (:import-from #:babel) 8 | (:import-from #:cl-ppcre) 9 | (:import-from #:jonathan) 10 | (:export #:proper-list-p 11 | #:proper-list 12 | #:association-list-p 13 | #:association-list 14 | #:declaim-safety 15 | #:undeclaim-safety 16 | #:slurp-stream 17 | #:detect-charset 18 | #:email-format-p 19 | #:uuid-format-p 20 | #:json-string-p)) 21 | (in-package #:apispec/utils) 22 | 23 | (defpackage #:apispec/utils/lambda-predicate) 24 | 25 | (defun proper-list-p (object &optional (element-type t)) 26 | (and (listp object) 27 | (null (cdr (last object))) 28 | (or (eq element-type t) 29 | (every (lambda (x) (typep x element-type)) 30 | object)))) 31 | 32 | (defvar *proper-list-type-checker* 33 | (make-hash-table :test 'equal)) 34 | 35 | (deftype proper-list (&optional (element-type t)) 36 | (let ((fn (if (eq element-type t) 37 | 'proper-list-p 38 | (or (gethash element-type *proper-list-type-checker*) 39 | (let ((fn (intern (format nil "~A-PROPER-LIST" element-type) 40 | '#:apispec/utils/lambda-predicate))) 41 | (setf (fdefinition fn) 42 | (lambda (object) 43 | (proper-list-p object element-type))) 44 | (setf (gethash element-type *proper-list-type-checker*) 45 | fn)))))) 46 | `(satisfies ,fn))) 47 | 48 | (defun association-list-p (value key-type value-type) 49 | (and (listp value) 50 | (every (lambda (pair) 51 | (and (consp pair) 52 | (typep (car pair) key-type) 53 | (typep (cdr pair) value-type))) 54 | value))) 55 | 56 | (defun simple-association-list-p (value) 57 | (association-list-p value '(or symbol string) t)) 58 | 59 | (defvar *association-list-type-checker* 60 | (make-hash-table :test 'equal)) 61 | 62 | (deftype association-list (&optional (key-type '(or symbol string)) (value-type t) ) 63 | (let ((fn (if (and (equal key-type '(or symbol string)) 64 | (eq value-type t)) 65 | 'simple-association-list-p 66 | (or (gethash (cons key-type value-type) *association-list-type-checker*) 67 | (let ((fn (intern (format nil "~S-ASSOCIATION-LIST" (cons key-type value-type)) 68 | '#:apispec/utils/lambda-predicate))) 69 | (setf (fdefinition fn) 70 | (lambda (object) 71 | (association-list-p object key-type value-type))) 72 | (setf (gethash (cons key-type value-type) *association-list-type-checker*) 73 | fn)))))) 74 | `(satisfies ,fn))) 75 | 76 | (defmacro declaim-safety () 77 | `(eval-when (:compile-toplevel :load-toplevel :execute) 78 | (defparameter ,(intern (string :*previous-safety*) *package*) 79 | (or (assoc 'safety (declaration-information 'optimize)) 80 | '(safety 1))) 81 | (proclaim '(optimize safety)))) 82 | 83 | (defmacro undeclaim-safety () 84 | `(eval-when (:compile-toplevel :load-toplevel :execute) 85 | (proclaim `(optimize ,,(intern (string :*previous-safety*) *package*))))) 86 | 87 | (defun slurp-stream (stream &optional length) 88 | (if (typep stream 'flex:vector-stream) 89 | (coerce (flex::vector-stream-vector stream) '(simple-array (unsigned-byte 8) (*))) 90 | (if length 91 | (let ((buffer (make-array length :element-type '(unsigned-byte 8)))) 92 | (read-sequence buffer stream) 93 | buffer) 94 | (apply #'concatenate 95 | '(simple-array (unsigned-byte 8) (*)) 96 | (loop with buffer = (make-array 1024 :element-type '(unsigned-byte 8)) 97 | for read-bytes = (read-sequence buffer stream) 98 | collect (subseq buffer 0 read-bytes) 99 | while (= read-bytes 1024)))))) 100 | 101 | (defun detect-charset (content-type &optional (default babel:*default-character-encoding*)) 102 | (multiple-value-bind (type subtype charset) 103 | (parse-media-type content-type) 104 | (declare (ignore type subtype)) 105 | (cond 106 | ((null charset) 107 | default) 108 | ((string-equal charset "utf-8") 109 | :utf-8) 110 | ((string-equal charset "euc-jp") 111 | :eucjp) 112 | ((or (string-equal charset "shift_jis") 113 | (string-equal charset "shift-jis") 114 | (string-equal charset "windows-31j")) 115 | :cp932) 116 | (t (or (find charset (babel:list-character-encodings) 117 | :test #'string-equal) 118 | babel:*default-character-encoding*))))) 119 | 120 | (defun email-format-p (string) 121 | (when (and (<= (length string) 256) 122 | (ppcre:scan "\\A[a-zA-Z0-9.!#$%&’*+/=?^_`{|}~-]+@[a-zA-Z0-9-]+(?:\\.[a-zA-Z0-9-]+)*\\z" string)) 123 | t)) 124 | 125 | (defun uuid-format-p (string) 126 | (when (ppcre:scan "\\A[a-f0-9]{8}-?[a-f0-9]{4}-?[a-f0-9]{4}-?[a-f0-9]{4}-?[a-f0-9]{12}\\z" 127 | string) 128 | t)) 129 | 130 | (defun json-string-p (string) 131 | (handler-case (progn 132 | (jojo:parse string) 133 | t) 134 | (error () nil))) 135 | -------------------------------------------------------------------------------- /src/utils/media-type.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/utils/media-type 2 | (:use #:cl) 3 | (:import-from #:cl-ppcre) 4 | (:export #:parse-media-type 5 | #:match-content-type)) 6 | (in-package #:apispec/utils/media-type) 7 | 8 | (defun parse-media-type (value) 9 | (let ((matches 10 | (nth-value 1 11 | (ppcre:scan-to-strings "^([0-9a-zA-Z!#$%&'+-.^_`|~]+|\\*)/([0-9a-zA-Z!#$%&'+-.^_`|~]+|\\*)" value)))) 12 | (when matches 13 | (values (aref matches 0) (aref matches 1))))) 14 | 15 | (defun match-content-type (pattern content-type &key comma-separated) 16 | (every (lambda (pattern) 17 | (multiple-value-bind (type subtype) 18 | (parse-media-type pattern) 19 | (unless type 20 | (error "Invalid media type: ~S" pattern)) 21 | (multiple-value-bind (type2 subtype2) 22 | (parse-media-type content-type) 23 | (unless type2 24 | (error "Invalid content type: ~S" content-type)) 25 | (and (or (string= type "*") 26 | (string-equal type type2)) 27 | (or (string= subtype "*") 28 | (string-equal subtype subtype2)))))) 29 | (if comma-separated 30 | (ppcre:split "\\s*,\\s*" pattern) 31 | (list pattern)))) 32 | -------------------------------------------------------------------------------- /src/utils/path-template.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/utils/path-template 2 | (:use #:cl) 3 | (:import-from #:cl-ppcre) 4 | (:import-from #:alexandria 5 | #:when-let) 6 | (:export #:compile-path-template)) 7 | (in-package #:apispec/utils/path-template) 8 | 9 | (defun compile-path-template (template &optional (result-value t)) 10 | (check-type template string) 11 | (let* ((match-vars (ppcre:all-matches-as-strings "(?<={)[^}]+(?=})" template)) 12 | (template-regexp (format nil "^~A$" (ppcre:regex-replace-all "{[^}]+}" template "([^/]+)"))) 13 | (scanner (ppcre:create-scanner template-regexp))) 14 | (values 15 | (lambda (path-info) 16 | (declare (string path-info)) 17 | (when-let (matches (nth-value 1 (ppcre:scan-to-strings scanner path-info))) 18 | (values result-value 19 | (if match-vars 20 | (loop for var in match-vars 21 | for match across matches 22 | collect (cons var match)) 23 | nil)))) 24 | (length match-vars) 25 | template-regexp))) 26 | -------------------------------------------------------------------------------- /tests/body/encode.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/tests/body/encode 2 | (:use #:cl 3 | #:rove 4 | #:apispec/body/encoder) 5 | (:import-from #:apispec/classes/schema 6 | #:schema 7 | #:object)) 8 | (in-package #:apispec/tests/body/encode) 9 | 10 | (deftest encode-data-json-tests 11 | (ok (equal (encode-data 1 (schema integer) 12 | "application/json") 13 | "1")) 14 | (ok (equal (encode-data "a" (schema string) 15 | "application/json") 16 | "\"a\"")) 17 | (ok (equal (encode-data t (schema boolean) 18 | "application/json") 19 | "true")) 20 | (ok (equal (encode-data nil (schema boolean) 21 | "application/json") 22 | "false")) 23 | (ok (equal (encode-data nil (schema (integer :nullable t)) 24 | "application/json") 25 | "null")) 26 | (ok (equal (encode-data '(1 2 3) (schema (array :items 'integer)) 27 | "application/json") 28 | "[1,2,3]")) 29 | (ok (equal 30 | (encode-data '(("name" . "fukamachi") 31 | ("age" . nil) 32 | ("is_merchant" . nil) 33 | ("terminal" . (("id" . "xxx") ("keys" . ())))) 34 | (schema (object 35 | (("name" string) 36 | ("age" (integer :nullable t)) 37 | ("is_merchant" boolean) 38 | ("terminal" 39 | (object (("id" string) ("name" (string :nullable t)) ("keys" array))))))) 40 | "application/json") 41 | "{\"name\":\"fukamachi\",\"age\":null,\"is_merchant\":false,\"terminal\":{\"id\":\"xxx\",\"name\":null,\"keys\":[]}}"))) 42 | -------------------------------------------------------------------------------- /tests/classes/encoding.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/tests/classes/encoding 2 | (:use #:cl 3 | #:rove 4 | #:apispec/classes/encoding) 5 | (:import-from #:apispec/classes/encoding/parse 6 | #:default-content-type) 7 | (:import-from #:apispec/classes/schema 8 | #:schema 9 | #:object 10 | #:binary) 11 | (:import-from #:cl-ppcre) 12 | (:import-from #:assoc-utils 13 | #:aget)) 14 | (in-package #:apispec/tests/classes/encoding) 15 | 16 | (deftest encoding-explode-p-tests 17 | (flet ((make-encoding (style) 18 | (make-instance 'encoding :style style))) 19 | (ng (encoding-explode-p (make-encoding "matrix"))) 20 | (ng (encoding-explode-p (make-encoding "label"))) 21 | (ok (encoding-explode-p (make-encoding "form"))) 22 | (ng (encoding-explode-p (make-encoding "simple"))) 23 | (ng (encoding-explode-p (make-encoding "spaceDelimited"))) 24 | (ng (encoding-explode-p (make-encoding "pipeDelimited"))) 25 | (ng (encoding-explode-p (make-encoding "deepObject"))) 26 | 27 | (ok (encoding-explode-p (make-instance 'encoding :style "matrix" :explode t))))) 28 | 29 | (deftest default-content-type-tests 30 | (testing "binary" 31 | (ok (equal (default-content-type (schema binary)) 32 | "application/octet-stream"))) 33 | (testing "primitive types" 34 | (ok (equal (default-content-type (schema number)) 35 | "text/plain")) 36 | (ok (equal (default-content-type (schema string)) 37 | "text/plain")) 38 | (ok (equal (default-content-type (schema boolean)) 39 | "text/plain"))) 40 | (testing "object" 41 | (ok (equal (default-content-type (schema object)) 42 | "application/json"))) 43 | (testing "array" 44 | (ok (equal (default-content-type (schema (array :items 'string))) 45 | "text/plain")) 46 | (ok (equal (default-content-type (schema (array :items 'object))) 47 | "application/json")))) 48 | 49 | (deftest parse-with-encoding-tests 50 | (ok (equal (parse-with-encoding "hello=%E3%81%93%E3%82%93%E3%81%AB%E3%81%A1%E3%81%AF" 51 | (make-instance 'encoding 52 | :content-type "application/x-www-form-urlencoded") 53 | (schema object) 54 | nil) 55 | '(("hello" . "こんにちは")))) 56 | (ok (equalp (parse-with-encoding "language=Lisp%20Scheme%20Clojure" 57 | (make-instance 'encoding 58 | :content-type "application/x-www-form-urlencoded" 59 | :style "spaceDelimited") 60 | (schema (object (("language" (array :items 'string))))) 61 | nil) 62 | '(("language" . #("Lisp" "Scheme" "Clojure"))))) 63 | (ok (equal (parse-with-encoding "{\"hello\":\"こんにちは\"}" 64 | (make-instance 'encoding 65 | :content-type "application/json") 66 | (schema object) 67 | nil) 68 | '(("hello" . "こんにちは")))) 69 | (let ((data (ppcre:regex-replace-all "\\n" 70 | "------------0xKhTmLbOuNdArY 71 | Content-Disposition: form-data; name=\"text1\" 72 | 73 | Ratione accusamus aspernatur aliquam 74 | ------------0xKhTmLbOuNdArY 75 | Content-Disposition: form-data; name=\"text2\" 76 | 77 | 78 | ------------0xKhTmLbOuNdArY 79 | Content-Disposition: form-data; name=\"upload\"; filename=\"hello.lisp\" 80 | Content-Type: application/octet-stream 81 | 82 | #!/usr/bin/env sbcl --script 83 | 84 | (defun fact (n) 85 | (if (zerop n) 86 | 1 87 | (* n (fact (1- n))))) 88 | 89 | 90 | ------------0xKhTmLbOuNdArY--" (format nil "~C~C" #\Return #\Newline)))) 91 | (let ((results (parse-with-encoding 92 | data 93 | (make-instance 'encoding 94 | :content-type "multipart/form-data; boundary=----------0xKhTmLbOuNdArY") 95 | (schema 96 | (object 97 | (("text1" string) 98 | ("text2" string) 99 | ("upload" binary)))) 100 | nil))) 101 | (ok (equal (aget results "text1") 102 | "Ratione accusamus aspernatur aliquam")) 103 | (ok (equal (aget results "text2") 104 | "")) 105 | (ok (typep (aget results "upload") 'stream))))) 106 | -------------------------------------------------------------------------------- /tests/classes/header.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/tests/classes/header 2 | (:use #:cl 3 | #:rove 4 | #:apispec/classes/header)) 5 | (in-package #:apispec/tests/classes/header) 6 | 7 | (deftest header-tests 8 | (ng (header-required-p (make-instance 'header))) 9 | (ok (eq (header-schema (make-instance 'header)) t)) 10 | (ng (header-explode-p (make-instance 'header)))) 11 | 12 | (deftest coerce-with-header-tests 13 | (testing "required" 14 | (let ((header (make-instance 'header 15 | :required t))) 16 | (ok (signals (coerce-with-header nil header) 17 | 'header-missing))))) 18 | -------------------------------------------------------------------------------- /tests/classes/media-type.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/tests/classes/media-type 2 | (:use #:cl 3 | #:rove 4 | #:apispec/classes/media-type) 5 | (:import-from #:apispec/classes/schema 6 | #:schema 7 | #:binary 8 | #:object) 9 | (:import-from #:apispec/classes/header 10 | #:header) 11 | (:import-from #:apispec/classes/encoding 12 | #:encoding) 13 | (:import-from #:babel 14 | #:string-to-octets) 15 | (:import-from #:flexi-streams 16 | #:make-in-memory-input-stream) 17 | (:import-from #:cl-interpol)) 18 | (in-package #:apispec/tests/classes/media-type) 19 | 20 | (named-readtables:in-readtable :interpol-syntax) 21 | 22 | (deftest parse-tests 23 | (testing "application/octet-stream" 24 | (let* ((media-type (make-instance 'media-type 25 | :schema (schema binary))) 26 | (data (babel:string-to-octets "Hello, API")) 27 | (stream (flex:make-in-memory-input-stream data))) 28 | (ok (eq (parse-with-media-type stream media-type "application/octet-stream" nil) 29 | stream)))) 30 | (testing "application/x-www-form-urlencoded" 31 | (let* ((media-type (make-instance 'media-type 32 | :schema (schema (object 33 | (("id" integer) 34 | ("address" string)))))) 35 | (data (babel:string-to-octets "id=1&address=Tokyo,%20Japan")) 36 | (stream (flex:make-in-memory-input-stream data))) 37 | (ok (equal (parse-with-media-type stream media-type "application/x-www-form-urlencoded" nil) 38 | '(("id" . 1) ("address" . "Tokyo, Japan")))))) 39 | (testing "multipart" 40 | (let* ((media-type (make-instance 'media-type 41 | :schema (schema (object 42 | (("id" integer) 43 | ("address" string) 44 | ("historyMetadata" object)))) 45 | :encoding `(("historyMetadata" 46 | . ,(make-instance 'encoding 47 | :content-type "application/json"))))) 48 | (content-type "multipart/form-data; boundary=\"---------------------------186454651713519341951581030105\"") 49 | (data (babel:string-to-octets 50 | (concatenate 'string 51 | #?"-----------------------------186454651713519341951581030105\r\n" 52 | #?"Content-Disposition: form-data; name=\"id\"\r\n" 53 | #?"Content-Type: text/plain\r\n" 54 | #?"\r\n" 55 | #?"1\r\n" 56 | #?"-----------------------------186454651713519341951581030105\r\n" 57 | #?"Content-Disposition: form-data; name=\"address\"\r\n" 58 | #?"Content-Type: text/plain\r\n" 59 | #?"\r\n" 60 | #?"東京都台東区上野２丁目７−１２\r\n" 61 | #?"-----------------------------186454651713519341951581030105\r\n" 62 | #?"Content-Disposition: form-data; name=\"historyMetadata\"\r\n" 63 | #?"Content-Type: application/json\r\n" 64 | #?"\r\n" 65 | #?"{\"type\":\"culture\"}\r\n" 66 | #?"-----------------------------186454651713519341951581030105--\r\n"))) 67 | (stream (flex:make-in-memory-input-stream data))) 68 | (ok (equal (parse-with-media-type stream media-type content-type nil) 69 | '(("id" . 1) 70 | ("address" . "東京都台東区上野２丁目７−１２") 71 | ("historyMetadata" . (("type" . "culture"))))))))) 72 | -------------------------------------------------------------------------------- /tests/classes/operation.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/tests/classes/operation 2 | (:use #:cl 3 | #:rove 4 | #:apispec/classes/operation) 5 | (:import-from #:apispec/classes/schema 6 | #:schema 7 | #:object) 8 | (:import-from #:apispec/classes/parameter 9 | #:parameter) 10 | (:import-from #:apispec/classes/response 11 | #:response) 12 | (:import-from #:apispec/classes/media-type 13 | #:media-type) 14 | (:import-from #:lack.request 15 | #:request-query-parameters 16 | #:request-cookies) 17 | (:import-from #:lack.response 18 | #:make-response) 19 | (:import-from #:assoc-utils 20 | #:alist-hash)) 21 | (in-package #:apispec/tests/classes/operation) 22 | 23 | (defun make-operation (parameters) 24 | (make-instance 'operation 25 | :parameters parameters 26 | :responses 27 | `(("204" . ,(make-instance 'response 28 | :description "Success" 29 | :content nil))))) 30 | 31 | (deftest validate-request-tests 32 | (testing "path" 33 | (let* ((operation (make-operation 34 | (list 35 | (make-instance 'parameter 36 | :name "car_id" 37 | :in "path" 38 | :schema (schema integer)) 39 | (make-instance 'parameter 40 | :name "driver_id" 41 | :in "path" 42 | :schema (schema string))))) 43 | (request (validate-request operation 44 | () 45 | :path-parameters '(("car_id" . "1") 46 | ("driver_id" . "xyz"))))) 47 | (ok (typep request 'request)) 48 | (ok (equalp (request-path-parameters request) 49 | '(("car_id" . 1) 50 | ("driver_id" . "xyz")))))) 51 | (testing "query" 52 | (let* ((operation (make-operation 53 | (list 54 | (make-instance 'parameter 55 | :name "role" 56 | :in "query" 57 | :schema (schema string)) 58 | (make-instance 'parameter 59 | :name "debug" 60 | :in "query" 61 | :schema (schema boolean))))) 62 | (request (validate-request operation 63 | '(:query-string "role=admin&debug=0")))) 64 | (ok (typep request 'request)) 65 | (ok (equalp (request-query-parameters request) 66 | '(("role" . "admin") 67 | ("debug" . nil)))))) 68 | (testing "header" 69 | (let* ((operation (make-operation 70 | (list 71 | (make-instance 'parameter 72 | :name "X-App-Version" 73 | :in "header" 74 | :schema (schema integer))))) 75 | (request (validate-request operation 76 | (list 77 | :headers (alist-hash 78 | `(("x-app-version" . "3"))))))) 79 | (ok (typep request 'request)) 80 | (ok (equalp (request-header-parameters request) 81 | '(("X-App-Version" . 3)))))) 82 | (testing "cookie" 83 | (let* ((operation (make-operation 84 | (list 85 | (make-instance 'parameter 86 | :name "debug" 87 | :in "cookie" 88 | :schema (schema boolean)) 89 | (make-instance 'parameter 90 | :name "csrftoken" 91 | :in "cookie" 92 | :schema (schema string))))) 93 | (request (validate-request operation 94 | (list 95 | :headers (alist-hash 96 | `(("cookie" . "debug=0; csrftoken=BUSe35dohU3O1MZvDCU"))))))) 97 | (ok (typep request 'request)) 98 | (ok (equalp (request-cookies request) 99 | '(("debug" . nil) 100 | ("csrftoken" . "BUSe35dohU3O1MZvDCU"))))))) 101 | 102 | (deftest validate-response-tests 103 | (let* ((media-type (make-instance 'media-type 104 | :schema (schema (object (("hello" string)))))) 105 | (200-response (make-instance 'response 106 | :description "Success" 107 | :content `(("application/json" . ,media-type))))) 108 | (testing "200 OK (application/json)" 109 | (let ((operation (make-instance 'operation 110 | :parameters nil 111 | :responses 112 | `(("200" . ,200-response))))) 113 | (ok (equal (validate-response operation 114 | (make-response 200 115 | '(:content-type "application/json; charset=utf-8") 116 | '(("hello" . "こんにちは")))) 117 | '(200 (:content-type "application/json; charset=utf-8") ("{\"hello\":\"こんにちは\"}")))))) 118 | (testing "204 No Content" 119 | (let* ((response (make-instance 'response 120 | :description "No Content" 121 | :content nil)) 122 | (operation (make-instance 'operation 123 | :parameters nil 124 | :responses `(("204" . ,response) 125 | ("2XX" . ,200-response))))) 126 | (ok (equal (validate-response operation 127 | (make-response 204)) 128 | '(204 () ()))))))) 129 | -------------------------------------------------------------------------------- /tests/classes/parameter.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/tests/classes/parameter 2 | (:use #:cl 3 | #:rove 4 | #:apispec/classes/parameter) 5 | (:import-from #:apispec/classes/schema 6 | #:object 7 | #:schema) 8 | (:import-from #:assoc-utils 9 | #:alist-hash)) 10 | (in-package #:apispec/tests/classes/parameter) 11 | 12 | (deftest parse-query-string-tests 13 | (ok (equalp (parse-query-string "id=abc&id=opq&id=xyz" 14 | (list 15 | (make-instance 'parameter 16 | :name "id" 17 | :in "query" 18 | :description "ID of the object to fetch" 19 | :required nil 20 | :schema (schema (array :items 'string)) 21 | :style "form" 22 | :explode t))) 23 | '(("id" . #("abc" "opq" "xyz"))))) 24 | (ok (equalp (parse-query-string "id=abc,opq,xyz" 25 | (list 26 | (make-instance 'parameter 27 | :name "id" 28 | :in "query" 29 | :description "ID of the object to fetch" 30 | :required nil 31 | :schema (schema (array :items 'string)) 32 | :style "form" 33 | :explode nil))) 34 | '(("id" . #("abc" "opq" "xyz"))))) 35 | (ok (equalp (parse-query-string nil 36 | (list 37 | (make-instance 'parameter 38 | :name "name" 39 | :in "query" 40 | :description "ID of the object to fetch" 41 | :required nil 42 | :schema (schema (array :items 'string)) 43 | :style "form" 44 | :explode nil))) 45 | '())) 46 | (ok (signals (parse-query-string "id=abc,opq,xyz" (list)) 47 | 'parameter-validation-failed)) 48 | 49 | (ok (signals (parse-query-string nil 50 | (list 51 | (make-instance 'parameter 52 | :name "name" 53 | :in "query" 54 | :description "ID of the object to fetch" 55 | :required t 56 | :schema (schema (array :items 'string)) 57 | :style "form" 58 | :expldoe nil))) 59 | 'parameter-validation-failed)) 60 | 61 | (testing "nullable parameter" 62 | (ok (equal '(("foo" . nil)) 63 | (parse-query-string "foo" 64 | (list (make-instance 'parameter 65 | :name "foo" 66 | :in "query" 67 | :schema (schema (string :nullable t))))))))) 68 | 69 | (deftest parse-headers-tests 70 | (ok (equalp (parse-headers 71 | (alist-hash 72 | '(("token" . "123,456"))) 73 | (list (make-instance 'parameter 74 | :name "token" 75 | :in "header" 76 | :description "token to be passed to a header" 77 | :required t 78 | :schema (schema (array :items 'integer)) 79 | :style "simple"))) 80 | '(("token" . #(123 456))))) 81 | (ok (signals (parse-headers 82 | (make-hash-table) 83 | (list (make-instance 'parameter 84 | :name "token" 85 | :in "header" 86 | :description "token to be passed to a header" 87 | :required t 88 | :schema (schema (array :items 'integer)) 89 | :style "simple"))) 90 | 'parameter-validation-failed))) 91 | 92 | (deftest parse-cookie-parameter 93 | (ok (equalp (parse-cookie-string 94 | "id=5" 95 | (list (make-instance 'parameter 96 | :name "id" 97 | :in "cookie" 98 | :required t 99 | :schema (schema integer) 100 | :style "form"))) 101 | '(("id" . 5)))) 102 | (ok (equalp (parse-cookie-string 103 | "id=3,4,5" 104 | (list (make-instance 'parameter 105 | :name "id" 106 | :in "cookie" 107 | :required t 108 | :schema (schema (array :items 'integer)) 109 | :style "form" 110 | :explode nil))) 111 | '(("id" . #(3 4 5))))) 112 | (ok (equalp (parse-cookie-string 113 | "id=role,admin,firstName,Alex" 114 | (list (make-instance 'parameter 115 | :name "id" 116 | :in "cookie" 117 | :required t 118 | :schema (schema (object (("role" string) ("firstName" string)))) 119 | :style "form" 120 | :explode nil))) 121 | '(("id" . (("role" . "admin") 122 | ("firstName" . "Alex"))))))) 123 | -------------------------------------------------------------------------------- /tests/classes/path.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/tests/classes/path 2 | (:use #:cl 3 | #:rove 4 | #:apispec/classes/path) 5 | (:import-from #:apispec/classes/operation 6 | #:operation) 7 | (:import-from #:apispec/classes/response 8 | #:response)) 9 | (in-package #:apispec/tests/classes/path) 10 | 11 | (deftest find-operation-tests 12 | (let* ((get-operation (make-instance 'operation 13 | :responses `((200 . ,(make-instance 'response 14 | :description "Success" 15 | :content nil))))) 16 | (path (make-instance 'path-item 17 | :get get-operation))) 18 | (ok (eq (find-operation path :get) get-operation)) 19 | (ng (find-operation path :post)) 20 | (ok (signals (find-operation :path :connect))))) 21 | 22 | (deftest compile-paths-tests 23 | (let ((pets (make-instance 'path-item)) 24 | (pet (make-instance 'path-item)) 25 | (pet-xml (make-instance 'path-item)) 26 | (pet-json (make-instance 'path-item)) 27 | (my-pet (make-instance 'path-item))) 28 | (let ((compiled (compile-paths 29 | `(("/pets" . ,pets) 30 | ("/pets/{petId}.xml" . ,pet-xml) 31 | ("/pets/{petId}" . ,pet) 32 | ("/pets/{petId}.json" . ,pet-json) 33 | ("/pets/mine" . ,my-pet))))) 34 | (ok (typep compiled 'function)) 35 | (ok (equalp (multiple-value-list (funcall compiled "/pets")) 36 | (list pets '()))) 37 | (ok (equalp (multiple-value-list (funcall compiled "/pets/1")) 38 | (list pet '(("petId" . "1"))))) 39 | (ok (equalp (multiple-value-list (funcall compiled "/pets/1.xml")) 40 | (list pet-xml '(("petId" . "1"))))) 41 | (ok (equalp (multiple-value-list (funcall compiled "/pets/1.json")) 42 | (list pet-json '(("petId" . "1"))))) 43 | (ok (equalp (multiple-value-list (funcall compiled "/pets/mine")) 44 | (list my-pet '()))) 45 | (ng (funcall compiled "/report"))))) 46 | -------------------------------------------------------------------------------- /tests/classes/request-body.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/tests/classes/request-body 2 | (:use #:cl 3 | #:rove 4 | #:apispec/classes/request-body) 5 | (:import-from #:apispec/classes/media-type 6 | #:media-type) 7 | (:import-from #:apispec/classes/encoding 8 | #:encoding) 9 | (:import-from #:apispec/classes/schema 10 | #:schema 11 | #:object) 12 | (:import-from #:cl-interpol) 13 | (:import-from #:flexi-streams) 14 | (:import-from #:babel) 15 | (:import-from #:assoc-utils 16 | #:alist=)) 17 | (in-package #:apispec/tests/classes/request-body) 18 | 19 | (named-readtables:in-readtable :interpol-syntax) 20 | 21 | (defun make-stream (data) 22 | (flex:make-in-memory-input-stream (babel:string-to-octets data))) 23 | 24 | (defvar *multipart-data* 25 | (concatenate 'string 26 | #?"-----------------------------186454651713519341951581030105\r\n" 27 | #?"Content-Disposition: form-data; name=\"id\"\r\n" 28 | #?"Content-Type: text/plain\r\n" 29 | #?"\r\n" 30 | #?"1\r\n" 31 | #?"-----------------------------186454651713519341951581030105\r\n" 32 | #?"Content-Disposition: form-data; name=\"address\"\r\n" 33 | #?"Contest-Type: text/plain\r\n" 34 | #?"\r\n" 35 | #?"東京都台東区上野２丁目７−１２\r\n" 36 | #?"-----------------------------186454651713519341951581030105\r\n" 37 | #?"Content-Disposition: form-data; name=\"historyMetadata\"\r\n" 38 | #?"Content-Type: application/json\r\n" 39 | #?"\r\n" 40 | #?"{\"type\":\"culture\"}\r\n" 41 | #?"-----------------------------186454651713519341951581030105--\r\n")) 42 | 43 | (deftest parse-request-body-tests 44 | (let* ((schema (schema 45 | (object 46 | (("id" integer) 47 | ("address" string) 48 | ("historyMetadata" 49 | (object 50 | (("type" string)))))))) 51 | (request-body 52 | (make-instance 'request-body 53 | :content `(("multipart/form-data" 54 | . ,(make-instance 'media-type :schema schema)) 55 | ("application/json" 56 | . ,(make-instance 'media-type :schema schema)) 57 | ("application/x-www-form-urlencoded" 58 | . ,(make-instance 'media-type 59 | :schema schema 60 | :encoding 61 | `(("historyMetadata" 62 | . ,(make-instance 'encoding 63 | :content-type "application/json"))))))))) 64 | (ok (alist= 65 | (parse-request-body 66 | (make-stream *multipart-data*) 67 | "multipart/form-data; boundary=\"---------------------------186454651713519341951581030105\"" 68 | nil 69 | request-body) 70 | '(("id" . 1) 71 | ("address" . "東京都台東区上野２丁目７−１２") 72 | ("historyMetadata" . (("type" . "culture")))))) 73 | (ok (alist= 74 | (parse-request-body 75 | (make-stream "{\"id\":1,\"address\":\"東京都台東区上野２丁目７−１２\",\"historyMetadata\":{\"type\":\"culture\"}}") 76 | "application/json" 77 | nil 78 | request-body) 79 | '(("id" . 1) 80 | ("address" . "東京都台東区上野２丁目７−１２") 81 | ("historyMetadata" . (("type" . "culture")))))) 82 | (ok (alist= 83 | (parse-request-body 84 | (make-stream 85 | (format nil "id=1&address=~A&historyMetadata=~A" 86 | (quri:url-encode "東京都台東区上野２丁目７−１２") 87 | (quri:url-encode "{\"type\":\"culture\"}"))) 88 | "application/x-www-form-urlencoded" 89 | nil 90 | request-body) 91 | '(("id" . 1) 92 | ("address" . "東京都台東区上野２丁目７−１２") 93 | ("historyMetadata" . (("type" . "culture")))))))) 94 | 95 | (deftest invalid-format-tests 96 | (ok (signals (parse-request-body 97 | (make-stream "blah") 98 | "multipart/form-data" 99 | nil 100 | (make-instance 'request-body 101 | :content 102 | `(("multipart/form-data" . ,(make-instance 'media-type :schema (schema object)))))) 103 | 'request-body-parse-error)) 104 | (ok (signals (parse-request-body 105 | (make-stream *multipart-data*) 106 | "multipart/form-data; boundary=\"---------------------------186454651713519341951581030105\"" 107 | nil 108 | (make-instance 'request-body 109 | :content 110 | `(("application/json" . ,(make-instance 'media-type :schema (schema object)))))) 111 | 'request-body-content-type-mismatch))) 112 | -------------------------------------------------------------------------------- /tests/classes/response.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/tests/classes/response 2 | (:use #:cl 3 | #:rove 4 | #:apispec/classes/response) 5 | (:import-from #:apispec/classes/media-type 6 | #:media-type 7 | #:media-type-schema) 8 | (:import-from #:apispec/classes/schema 9 | #:schema 10 | #:binary 11 | #:object)) 12 | (in-package #:apispec/tests/classes/response) 13 | 14 | (deftest find-response-tests 15 | (let ((responses `(("200" . ,(make-instance 'response 16 | :description "Success" 17 | :content 18 | `(("application/json" 19 | . ,(make-instance 'media-type 20 | :schema (schema object))))))))) 21 | (ok (find-response responses 200)) 22 | (ok (signals (find-response responses 404) 23 | 'response-not-defined)) 24 | (ok (find-response 25 | (append responses 26 | `(("default" . ,(make-instance 'response 27 | :description "All responses" 28 | :content 29 | '(("application/json" . nil)))))) 30 | 404)))) 31 | 32 | (deftest find-media-type-tests 33 | (let ((response (make-instance 'response 34 | :description "Success" 35 | :content 36 | `(("application/json" 37 | . ,(make-instance 'media-type 38 | :schema (schema object))) 39 | ("application/x-www-form-urlencoded" 40 | . ,(make-instance 'media-type 41 | :schema (schema object))))))) 42 | (ok (find-media-type response "application/json")) 43 | (ok (find-media-type response "application/json; charset=utf-8")) 44 | (ok (signals (find-media-type response "application/xml") 45 | 'response-not-defined))) 46 | 47 | (let ((response (make-instance 'response 48 | :description "All responses" 49 | :content `(("application/octet-stream" 50 | . ,(make-instance 'media-type 51 | :schema (schema binary))) 52 | ("*/*" 53 | . ,(make-instance 'media-type 54 | :schema (schema object))))))) 55 | (let ((media-type (find-media-type response "application/octet-stream"))) 56 | (ok (typep media-type 'media-type)) 57 | (ok (typep (media-type-schema media-type) 'binary))) 58 | (let ((media-type (find-media-type response "image/png"))) 59 | (ok (typep media-type 'media-type)) 60 | (ok (typep (media-type-schema media-type) 'object))))) 61 | 62 | (deftest encode-response-tests 63 | (ok (equalp (encode-response 200 64 | '(:content-type "application/json") 65 | '(("id" . 1) 66 | ("is_registered" . nil)) 67 | `(("200" . ,(make-instance 'response 68 | :description "Success" 69 | :content 70 | `(("application/json" 71 | . ,(make-instance 'media-type 72 | :schema (schema 73 | (object 74 | (("id" integer) 75 | ("is_registered" boolean))))))))))) 76 | '(200 77 | (:content-type "application/json") 78 | ("{\"id\":1,\"is_registered\":false}"))))) 79 | -------------------------------------------------------------------------------- /tests/classes/schema/coerce.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:apispec/tests/classes/schema/coerce 2 | (:mix #:apispec/classes/schema/core 3 | #:cl) 4 | (:use #:apispec/classes/schema/coerce 5 | #:apispec/classes/schema/composition 6 | #:apispec/classes/schema/errors 7 | #:rove) 8 | (:import-from #:apispec/classes/schema/validate 9 | #:validation-failed) 10 | (:import-from #:local-time 11 | #:timestamp= 12 | #:universal-to-timestamp) 13 | (:import-from #:assoc-utils 14 | #:aget 15 | #:alist=)) 16 | (in-package #:apispec/tests/classes/schema/coerce) 17 | 18 | (deftest coerce-number-tests 19 | (ok (eql (coerce-data 1 'number) 1)) 20 | (ok (eql (coerce-data 1 'integer) 1)) 21 | (ok (eql (coerce-data 1 'float) 1.0)) 22 | (ok (eql (coerce-data "1" 'integer) 1)) 23 | (ok (eql (coerce-data "1.2" 'float) 1.2)) 24 | (ok (eql (coerce-data "1.2" 'double) '1.2d0))) 25 | 26 | (deftest coerce-string-tests 27 | (ok (equal (coerce-data "a" 'string) "a")) 28 | (ok (signals (coerce-data #\a 'string) 29 | 'schema-coercion-failed)) 30 | (ok (equal (handler-bind ((schema-coercion-failed 31 | (lambda (condition) 32 | (invoke-restart (find-restart 'use-value condition) "a")))) 33 | (coerce-data #\a 'string)) 34 | "a")) 35 | (ok (signals (coerce-data 1 'string) 36 | 'schema-coercion-failed)) 37 | (let ((date (coerce-data "2019-04-15" 'date))) 38 | (ok (typep date 'local-time:timestamp)) 39 | (ok (= (local-time:timestamp-year date) 2019)) 40 | (ok (= (local-time:timestamp-month date) 4)) 41 | (ok (= (local-time:timestamp-day date) 15)) 42 | (ok (= (local-time:timestamp-hour date) 0)) 43 | (ok (= (local-time:timestamp-minute date) 0)) 44 | (ok (= (local-time:timestamp-second date) 0))) 45 | (let ((date (coerce-data "2019-04-15T01:02:03+09:00" 'date-time)) 46 | (local-time:*default-timezone* local-time:+gmt-zone+)) 47 | (ok (typep date 'local-time:timestamp)) 48 | (ok (= (local-time:timestamp-year date) 2019)) 49 | (ok (= (local-time:timestamp-month date) 4)) 50 | (ok (= (local-time:timestamp-day date) 14)) 51 | (ok (= (local-time:timestamp-hour date) 16)) 52 | (ok (= (local-time:timestamp-minute date) 2)) 53 | (ok (= (local-time:timestamp-second date) 3))) 54 | (ok (signals (coerce-data "1" 'boolean))) 55 | (ok (signals (coerce-data "0" 'boolean))) 56 | (let ((*coerce-string-to-boolean* t)) 57 | (ok (eq (coerce-data "1" 'boolean) t)) 58 | (ok (eq (coerce-data "0" 'boolean) nil)) 59 | (ok (eq (coerce-data "true" 'boolean) t)) 60 | (ok (eq (coerce-data "false" 'boolean) nil)) 61 | (ok (eq (coerce-data "" (schema (boolean :default nil))) 62 | nil)) 63 | (ok (eq (coerce-data "" (schema (boolean :default t))) 64 | t))) 65 | (ok (eq (coerce-data t 'boolean) t)) 66 | (ok (eq (coerce-data nil 'boolean) nil)) 67 | (ok (signals (coerce-data 1 'boolean) 'schema-coercion-failed)) 68 | (ok (signals (coerce-data #(1) 'boolean) 'schema-coercion-failed)) 69 | (let ((enum '("foo" "bar"))) 70 | (dolist (string enum) 71 | (ok (coerce-data string (schema (string :enum enum))))) 72 | (ok (signals (coerce-data "hoge" (schema (string :enum enum))) 73 | 'schema-validation-failed)))) 74 | 75 | (deftest coerce-date-time-tests 76 | (signals (coerce-data "foo" 'date-time) 77 | 'schema-coercion-failed)) 78 | 79 | (deftest coerce-array-tests 80 | (ok (equalp (coerce-data '(1 2 3) 'array) 81 | #(1 2 3))) 82 | (ok (equalp (coerce-data '() 'array) 83 | #())) 84 | (ok (signals (coerce-data '(1 2 3) '(array 10)) 85 | 'schema-validation-failed)) 86 | (ok (equalp (coerce-data '("1" "-2" "3") '(array :items integer)) 87 | #(1 -2 3))) 88 | (ok (signals (coerce-data 10 (schema (array :enum '("foo" "bar")))) 89 | 'schema-coercion-failed)) 90 | (ok (signals (coerce-data "" '(array :items integer)) 91 | 'schema-coercion-failed))) 92 | 93 | (defmacro signals* (form condition &rest reader-value-pairs) 94 | (let ((c (gensym)) 95 | (condition-type (gensym))) 96 | `(let ((,condition-type ,condition)) 97 | (typep (block nil 98 | (handler-bind ((condition 99 | (lambda (,c) 100 | (when (and (typep ,c ,condition-type) 101 | ,@(loop :for (reader value) :on reader-value-pairs :by #'cddr 102 | :collect `(equal (funcall ,reader ,c) ,value))) 103 | (return ,c))))) 104 | ,form 105 | nil)) 106 | ,condition-type)))) 107 | 108 | (deftest coerce-object-tests 109 | (ok (equalp (coerce-data '(("name" . "fukamachi")) 'object) 110 | '(("name" . "fukamachi")))) 111 | (ok (equalp (coerce-data '(("name" . "fukamachi")) '(object 112 | (("name" string)))) 113 | '(("name" . "fukamachi")))) 114 | (ok (signals* (coerce-data '(("name" . 1)) 115 | '(object 116 | (("name" string)))) 117 | 'schema-object-error 118 | #'apispec/classes/schema/errors:schema-object-error-invalid-keys '("name"))) 119 | (ok (signals* (coerce-data '(("foo" . 1) 120 | ("bar" . "a")) 121 | '(object 122 | (("foo" string) 123 | ("bar" number) 124 | ("baz" number)))) 125 | 'schema-object-error 126 | #'apispec/classes/schema/errors:schema-object-error-invalid-keys '("foo" "bar"))) 127 | (ok (equalp (coerce-data '(("hi" . "all")) 128 | '(object 129 | (("name" string)))) 130 | '(("hi" . "all")))) 131 | (ok (signals* (coerce-data '(("hi" . "all")) 132 | '(object 133 | (("name" string)) 134 | :required ("name"))) 135 | 'schema-object-error 136 | #'apispec/classes/schema/errors:schema-object-error-missing-keys '("name"))) 137 | 138 | (testing "additionalProperties" 139 | (ok (equal (coerce-data '(("name" . "fukamachi") 140 | ("created-at" . "2019-04-30")) 141 | '(object 142 | (("name" string)) 143 | :additional-properties t)) 144 | '(("name" . "fukamachi") 145 | ("created-at" . "2019-04-30")))) 146 | (ok (signals* (coerce-data '(("name" . "fukamachi") 147 | ("created-at" . "2019-04-30") 148 | ("updated-at" . "2019-05-01")) 149 | '(object 150 | (("name" string)) 151 | :additional-properties nil)) 152 | 'schema-object-error 153 | #'apispec/classes/schema/errors:schema-object-error-unpermitted-keys '("created-at" "updated-at"))) 154 | (let ((data (coerce-data '(("name" . "fukamachi") 155 | ("created-at" . "2019-04-30")) 156 | '(object 157 | (("name" string)) 158 | :additional-properties date)))) 159 | (ok (equal (aget data "name") "fukamachi")) 160 | (ok (timestamp= (aget data "created-at") 161 | (universal-to-timestamp 162 | (encode-universal-time 0 0 0 30 4 2019)))) 163 | (ok (= (length data) 2))) 164 | (ok (equal (coerce-data '(("name" . "fukamachi") 165 | ("created-at" . nil)) 166 | '(object 167 | (("name" string)) 168 | :additional-properties (or date null))) 169 | '(("name" . "fukamachi") 170 | ("created-at" . nil)))) 171 | (ok (equalp '(("key1" . #())) 172 | (coerce-data '(("key1" . ())) 173 | (schema (object (("key1" (array :items (schema (string :enum '("foo" "bar"))))))))))))) 174 | 175 | (deftest coerce-default-tests 176 | (ok (equal (coerce-data nil '(string :default "none")) 177 | "none")) 178 | (ok (equal (coerce-data '() 179 | '(object 180 | (("name" (string :default "nobody"))))) 181 | '(("name" . "nobody"))))) 182 | 183 | (deftest composition-schema-tests 184 | (testing "oneOf" 185 | (let ((schema (make-instance 'composition-schema 186 | :one-of 187 | (list (schema (object (("bark" boolean) 188 | ("breed" (string :enum '("Dingo" "Husky" "Retriever" "Shepherd")))) 189 | :required '("bark" "breed"))) 190 | (schema (object (("hunts" boolean) 191 | ("age" integer)) 192 | :required '("hunts" "age"))))))) 193 | (ok (equal (coerce-data '(("bark" . t) 194 | ("breed" . "Dingo")) 195 | schema) 196 | '(("bark" . t) 197 | ("breed" . "Dingo")))) 198 | (ok (signals (coerce-data '(("bark" . t) 199 | ("hunts" . t)) 200 | schema) 201 | 'schema-oneof-error)) 202 | (ok (signals (coerce-data '(("bark" . t) 203 | ("hunts" . t) 204 | ("breed" . "Husky") 205 | ("age" . 3)) 206 | schema) 207 | 'schema-oneof-error)))) 208 | (testing "anyOf" 209 | (let ((schema (make-instance 'composition-schema 210 | :any-of 211 | (list (schema (object (("age" integer) ("nickname" string)) 212 | :required '("age"))) 213 | (schema (object (("pet_type" (string :enum '("Cat" "Dog"))) 214 | ("hunts" boolean)) 215 | :required '("pet_type"))))))) 216 | (ok (equal (coerce-data '(("age" . "11")) schema) 217 | '(("age" . 11)))) 218 | (ok (equal (coerce-data '(("pet_type" . "Cat") ("hunts" . t)) schema) 219 | '(("pet_type" . "Cat") ("hunts" . t)))) 220 | (ok (alist= (coerce-data '(("nickname" . "Fido") 221 | ("pet_type" . "Dog") 222 | ("age" . 4)) 223 | schema) 224 | '(("nickname" . "Fido") 225 | ("pet_type" . "Dog") 226 | ("age" . 4))))))) 227 | 228 | (deftest negative-schema-tests 229 | (ok (equal (coerce-data "Cat" (make-instance 'negative-schema :not (schema integer))) 230 | "Cat")) 231 | (ok (signals (coerce-data 11 (make-instance 'negative-schema :not (schema integer))) 232 | 'schema-coercion-failed))) 233 | -------------------------------------------------------------------------------- /tests/classes/schema/core.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:apispec/tests/classes/schema/core 2 | (:mix #:apispec/classes/schema/core 3 | #:cl) 4 | (:use #:rove)) 5 | (in-package #:apispec/tests/classes/schema/core) 6 | 7 | (deftest number-tests 8 | (ok (typep (schema number) 'number)) 9 | (ok (typep (schema cl:number) 'number)) 10 | (ok (typep (schema (cl:number :multiple-of 2)) 'number)) 11 | (ok (typep (schema (cl:number 0)) 'number)) 12 | (ok (typep (schema (cl:number 0 :exclusive-minimum t)) 'number)) 13 | (ok (typep (schema (cl:number 0 100)) 'number)) 14 | (ok (typep (schema (cl:number 0 100 :exclusive-maximum t)) 'number)) 15 | (ok (signals (schema (cl:number :exclusive-minimum t))) 16 | "Cannot specify :exclusive-minimum without :minimum") 17 | (testing "nullable" 18 | (let ((schema (schema (or cl:number null)))) 19 | (ok (typep schema 'number)) 20 | (ok (slot-value schema 'apispec/classes/schema/core::nullable))) 21 | (let ((schema (schema (or null cl:number)))) 22 | (ok (typep schema 'number)) 23 | (ok (slot-value schema 'apispec/classes/schema/core::nullable))) 24 | (let ((schema (schema (or (cl:number 0) null)))) 25 | (ok (typep schema 'number)) 26 | (ok (slot-value schema 'apispec/classes/schema/core::nullable))))) 27 | 28 | (deftest string-tests 29 | (ok (typep (schema string) 'string)) 30 | (ok (typep (schema cl:string) 'string)) 31 | (ok (typep (schema (cl:string :pattern "\\d+")) 'string)) 32 | (ok (typep (schema (cl:string 0)) 'string)) 33 | (ok (typep (schema (cl:string 0 :pattern "\\d+")) 'string)) 34 | (ok (typep (schema (cl:string 0 100)) 'string)) 35 | (ok (typep (schema (cl:string 0 100 :pattern "\\d+")) 'string)) 36 | (ok (signals (schema (cl:string -100)))) 37 | (ok (signals (schema (cl:string 1.2))))) 38 | 39 | (deftest array-tests 40 | (ok (typep (schema array) 'array)) 41 | (ok (typep (schema cl:array) 'array)) 42 | (ok (typep (schema (cl:array :unique-items t)) 'array)) 43 | (ok (typep (schema (cl:array 0)) 'array)) 44 | (ok (typep (schema (cl:array 0 :unique-items t)) 'array)) 45 | (ok (typep (schema (cl:array 0 100)) 'array)) 46 | (ok (typep (schema (cl:array 0 100 :unique-items t)) 'array)) 47 | (ok (signals (schema (cl:array -100)))) 48 | (ok (signals (schema (cl:array 1.2))))) 49 | 50 | (deftest object-tests 51 | (ok (typep (schema object) 'object)) 52 | (ok (typep (schema (object)) 'object)) 53 | (ok (typep (schema (object ())) 'object)) 54 | (ok (typep (schema (object (("name" string)))) 'object)) 55 | (ok (typep (schema (object (("name" string)) :required '("name"))) 'object)) 56 | (ok (typep (schema (object 57 | (("name" string) 58 | ("terminal" (object 59 | (("id" integer) 60 | ("name" string))))))) 'object)) 61 | (testing "nullable" 62 | (let ((schema (schema (or object null)))) 63 | (ok (typep schema 'object)) 64 | (ok (slot-value schema 'apispec/classes/schema/core::nullable))) 65 | (let ((schema (schema (or (object) null)))) 66 | (ok (typep schema 'object)) 67 | (ok (slot-value schema 'apispec/classes/schema/core::nullable))) 68 | (let ((schema (schema (or (object (("name" string))) null)))) 69 | (ok (typep schema 'object)) 70 | (ok (slot-value schema 'apispec/classes/schema/core::nullable))))) 71 | -------------------------------------------------------------------------------- /tests/classes/schema/validate.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:apispec/tests/classes/schema/validate 2 | (:mix #:apispec/classes/schema/core 3 | #:cl) 4 | (:use #:rove 5 | #:apispec/classes/schema/validate 6 | #:apispec/classes/schema/errors 7 | #:apispec/classes/schema/composition)) 8 | (in-package #:apispec/tests/classes/schema/validate) 9 | 10 | (deftest validate-array-tests 11 | (ok (validate-data #(1 2 3) (schema (array :items 'integer)))) 12 | 13 | (testing "array size" 14 | (dolist (schema (list '(array 10) 15 | '(array :min-items 4) 16 | '(array :max-items 2))) 17 | (ok (signals (validate-data #(1 2 3) schema) 18 | 'schema-validation-failed) 19 | (format nil "array size ~S" schema)))) 20 | 21 | (testing "none array data" 22 | (dolist (value (list "" 23 | 0 24 | t 25 | nil 26 | '(("a" . "b")))) 27 | (ok (signals (validate-data value (schema (array :items 'integer))) 28 | 'schema-validation-failed) 29 | (format nil "none array data ~S" value)))) 30 | 31 | (testing "invalid element" 32 | (dolist (element (list #\a 33 | "a" 34 | t 35 | nil 36 | '(("a" . "b")))) 37 | (ok (signals (validate-data #(1 2 element) 38 | (schema (array :items 'integer))) 39 | 'schema-validation-failed) 40 | (format nil "invalid element ~S" element))))) 41 | 42 | (deftest validate-object-tests 43 | (ok (validate-data '() 44 | '(object 45 | (("name" string))))) 46 | (ok (signals (validate-data '(("hi" . "all")) 47 | '(object 48 | (("name" string)) 49 | :required ("name"))) 50 | 'schema-object-error))) 51 | 52 | (deftest validate-email-tests 53 | (ok (signals (validate-data "foo" 54 | (schema (string :format "email"))) 55 | 'schema-validation-failed)) 56 | (ok (validate-data "foo@gmail.com" 57 | (schema (string :format "email"))))) 58 | 59 | (deftest validate-uuid-tests 60 | (ok (validate-data "d9d29401-3feb-48b2-ac79-54cee011717d" 61 | (schema (string :format "uuid")))) 62 | (signals (validate-data "foo" 63 | (schema (string :format "uuid"))) 64 | 'schema-validation-failed)) 65 | 66 | (deftest validate-time-tests 67 | (ok (validate-data "2020-01-21T23:03:22.503288Z" 68 | (schema (date-time)))) 69 | (ok (signals (validate-data "2020-01-21T23:03:22.503a" 70 | (schema (date-time))) 71 | 'schema-validation-failed)) 72 | (ok (validate-data "2020-01-21T23:03:22Z" 73 | (schema (date-time)))) 74 | (ok (signals (validate-data "2020-01-21T23:03:22" 75 | (schema (date-time))) 76 | 'schema-validation-failed)) 77 | (ok (validate-data "2020-01-21" 78 | (schema (date)))) 79 | (ok (signals (validate-data "2020-01-21T23:03:22.503288Z" 80 | (schema (date))) 81 | 'schema-validation-failed))) 82 | 83 | (deftest validate-json-tests 84 | (ok (validate-data "{\"key1\": 100}" (schema (string :format "json")))) 85 | (ok (signals (validate-data "{xx: 100}" (schema (string :format "json"))) 86 | 'schema-validation-failed)) 87 | (ok (signals (validate-data "{xx: 100" (schema (string :format "json"))) 88 | 'schema-validation-failed))) 89 | 90 | (deftest composition-schema-tests 91 | (testing "oneOf" 92 | (let ((schema (make-instance 'composition-schema 93 | :one-of 94 | (list (schema (object (("bark" boolean) 95 | ("breed" (string :enum '("Dingo" "Husky" "Retriever" "Shepherd")))) 96 | :required '("bark" "breed"))) 97 | (schema (object (("hunts" boolean) 98 | ("age" integer)) 99 | :required '("hunts" "age"))))))) 100 | (ok (validate-data '(("bark" . t) 101 | ("breed" . "Dingo")) 102 | schema)) 103 | (ok (signals (validate-data '(("bark" . t) 104 | ("hunts" . t)) 105 | schema) 106 | 'schema-oneof-error)) 107 | (ok (signals (validate-data '(("bark" . t) 108 | ("hunts" . t) 109 | ("breed" . "Husky") 110 | ("age" . 3)) 111 | schema) 112 | 'schema-oneof-error)))) 113 | (testing "anyOf" 114 | (let ((schema (make-instance 'composition-schema 115 | :any-of 116 | (list (schema (object (("age" integer) ("nickname" string)) 117 | :required '("age"))) 118 | (schema (object (("pet_type" (string :enum '("Cat" "Dog"))) 119 | ("hunts" boolean)) 120 | :required '("pet_type"))))))) 121 | (ok (validate-data '(("age" . 11)) schema)) 122 | (ok (validate-data '(("pet_type" . "Cat") ("hunts" . t)) schema)) 123 | (ok (signals (validate-data '("foo" . 0) schema) 124 | 'schema-anyof-error))))) 125 | -------------------------------------------------------------------------------- /tests/complex.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/tests/complex 2 | (:use #:cl 3 | #:rove) 4 | (:import-from #:apispec/complex 5 | #:parse-matrix-value 6 | #:parse-label-value 7 | #:parse-form-value 8 | #:parse-simple-value 9 | #:parse-space-delimited-value 10 | #:parse-pipe-delimited-value 11 | #:parse-deep-object-value 12 | #:parse-complex-parameter 13 | #:parse-complex-parameters) 14 | (:import-from #:apispec/classes/schema 15 | #:schema 16 | #:object) 17 | (:import-from #:assoc-utils 18 | #:alist=)) 19 | (in-package #:apispec/tests/complex) 20 | 21 | (deftest parse-matrix-value-tests 22 | (testing ":explode nil" 23 | (ok (equal (parse-matrix-value ";color") 24 | '(("color")))) 25 | (ok (equal (parse-matrix-value ";color=blue" :as (schema string)) 26 | '(("color" . "blue")))) 27 | (ok (equalp (parse-matrix-value ";color=blue,black,brown" :as (schema array)) 28 | '(("color" . #("blue" "black" "brown"))))) 29 | (ok (equal (parse-matrix-value ";color=R,100,G,200,B,150" :as (schema object)) 30 | '(("color" . (("R" . "100") ("G" . "200") ("B" . "150"))))))) 31 | (testing ":explode t" 32 | (ok (equal (parse-matrix-value ";color" :explode t) 33 | '(("color")))) 34 | (ok (equal (parse-matrix-value ";color=blue" :as (schema string) :explode t) 35 | '(("color" . "blue")))) 36 | (ok (equalp (parse-matrix-value ";color=blue;color=black;color=brown" 37 | :as (schema array) 38 | :explode t) 39 | '(("color" . #("blue" "black" "brown"))))) 40 | (ok (equal (parse-matrix-value ";R=100;G=200;B=150" 41 | :as (schema object) 42 | :explode t) 43 | '(("R" . "100") ("G" . "200") ("B" . "150")))))) 44 | 45 | (deftest parse-label-value-tests 46 | (testing ":explode nil" 47 | (ok (equal (parse-label-value ".") 48 | nil)) 49 | (ok (equal (parse-label-value ".blue" :as (schema string)) 50 | "blue")) 51 | (ok (equalp (parse-label-value ".blue.black.brown" :as (schema array)) 52 | #("blue" "black" "brown"))) 53 | (ok (equal (parse-label-value ".R.100.G.200.B.150" :as (schema object)) 54 | '(("R" . "100") ("G" . "200") ("B" . "150"))))) 55 | (testing ":explode t" 56 | (ok (equal (parse-label-value "." :explode t) 57 | nil)) 58 | (ok (equal (parse-label-value ".blue" :as (schema string) :explode t) 59 | "blue")) 60 | (ok (equalp (parse-label-value ".blue.black.brown" :as (schema array) :explode t) 61 | #("blue" "black" "brown"))) 62 | (ok (equal (parse-label-value ".R=100.G=200.B=150" :as (schema object) :explode t) 63 | '(("R" . "100") ("G" . "200") ("B" . "150")))))) 64 | 65 | (deftest parse-form-value-tests 66 | (testing ":explode nil" 67 | (ok (equal (parse-form-value '(("color" . "")) "color") 68 | "")) 69 | (ok (equal (parse-form-value '(("color" . "blue")) "color" :as (schema string)) 70 | "blue")) 71 | (ok (equalp (parse-form-value '(("color" . "blue,black,brown")) "color" 72 | :as (schema array)) 73 | #("blue" "black" "brown"))) 74 | (ok (equal (parse-form-value '(("color" . "R,100,G,200,B,150")) "color" 75 | :as (schema object)) 76 | '(("R" . "100") ("G" . "200") ("B" . "150"))))) 77 | (testing ":explode t" 78 | (ok (equal (parse-form-value '(("color" . "")) "color" :explode t) 79 | "")) 80 | (ok (equal (parse-form-value '(("color" . "blue")) "color" :as (schema string) :explode t) 81 | "blue")) 82 | (ok (equalp (parse-form-value '(("color" . "blue") 83 | ("color" . "black") 84 | ("color" . "brown")) 85 | "color" 86 | :as (schema array) :explode t) 87 | #("blue" "black" "brown"))) 88 | (ok (equal (parse-form-value '(("R" . "100") 89 | ("G" . "200") 90 | ("B" . "150")) "color" :as (schema object) :explode t) 91 | '(("R" . "100") ("G" . "200") ("B" . "150")))))) 92 | 93 | (deftest parse-simple-value-tests 94 | (testing ":explode nil" 95 | (ok (equal (parse-simple-value "blue" :as (schema string)) 96 | "blue")) 97 | (ok (equalp (parse-simple-value "blue,black,brown" :as (schema array)) 98 | #("blue" "black" "brown"))) 99 | (ok (equal (parse-simple-value "R,100,G,200,B,150" :as (schema object)) 100 | '(("R" . "100") ("G" . "200") ("B" . "150"))))) 101 | (testing ":explode t" 102 | (ok (equal (parse-simple-value "blue" :as (schema string) :explode t) 103 | "blue")) 104 | (ok (equalp (parse-simple-value "blue,black,brown" :as (schema array) :explode t) 105 | #("blue" "black" "brown"))) 106 | (ok (equal (parse-simple-value "R=100,G=200,B=150" :as (schema object) :explode t) 107 | '(("R" . "100") ("G" . "200") ("B" . "150")))))) 108 | 109 | (deftest parse-space-delimited-value-tests 110 | (ok (equalp (parse-space-delimited-value "blue black brown" :as (schema array)) 111 | #("blue" "black" "brown"))) 112 | (ok (equal (parse-space-delimited-value "R 100 G 200 B 150" :as (schema object)) 113 | '(("R" . "100") ("G" . "200") ("B" . "150"))))) 114 | 115 | (deftest parse-pipe-delimited-value-tests 116 | (ok (equalp (parse-pipe-delimited-value "blue|black|brown" :as (schema array)) 117 | #("blue" "black" "brown"))) 118 | (ok (equal (parse-pipe-delimited-value "R|100|G|200" :as (schema object)) 119 | '(("R" . "100") ("G" . "200"))))) 120 | 121 | (deftest parse-deep-object-value-tests 122 | (ok (equal (parse-deep-object-value '(("color[R]" . "100") 123 | ("color[G]" . "200") 124 | ("color[B]" . "150")) 125 | "color") 126 | '(("R" . "100") 127 | ("G" . "200") 128 | ("B" . "150"))))) 129 | 130 | (deftest parse-complex-parameter-tests 131 | (testing "form" 132 | (ok (equalp (parse-complex-parameter 133 | '(("id" . "10") 134 | ("color" . "blue") 135 | ("color" . "black") 136 | ("color" . "brown")) 137 | "color" 138 | "form" 139 | t 140 | (schema 141 | (array :items 'string))) 142 | #("blue" "black" "brown"))) 143 | (ok (equal (parse-complex-parameter 144 | '(("id" . "10") 145 | ("color" . "blue")) 146 | "color" 147 | "form" 148 | t 149 | (schema string)) 150 | "blue")) 151 | (ok (equalp (parse-complex-parameter 152 | '(("id" . "10") 153 | ("color" . "blue,black,brown")) 154 | "color" 155 | "form" 156 | nil 157 | (schema 158 | (array :items 'string))) 159 | #("blue" "black" "brown")))) 160 | (testing "spaceDelimited" 161 | (ok (equalp (parse-complex-parameter 162 | '(("id" . "10") 163 | ("color" . "blue black brown")) 164 | "color" 165 | "spaceDelimited" 166 | nil 167 | (schema 168 | (array :items 'string))) 169 | #("blue" "black" "brown"))) 170 | (ok (equalp (parse-complex-parameter 171 | '(("id" . "10") 172 | ("color" . "blue")) 173 | "color" 174 | "spaceDelimited" 175 | nil 176 | (schema 177 | (array :items 'string))) 178 | #("blue"))) 179 | (ok (equal (parse-complex-parameter 180 | '(("id" . "10") 181 | ("color" . "blue")) 182 | "color" 183 | "spaceDelimited" 184 | nil 185 | (schema string)) 186 | "blue"))) 187 | (testing "pipeDelimited" 188 | (ok (equalp (parse-complex-parameter 189 | '(("id" . "10") 190 | ("color" . "blue|black|brown")) 191 | "color" 192 | "pipeDelimited" 193 | nil 194 | (schema 195 | (array :items 'string))) 196 | #("blue" "black" "brown"))) 197 | (ok (equalp (parse-complex-parameter 198 | '(("id" . "10") 199 | ("color" . "blue")) 200 | "color" 201 | "pipeDelimited" 202 | nil 203 | (schema 204 | (array :items 'string))) 205 | #("blue"))) 206 | (ok (equal (parse-complex-parameter 207 | '(("id" . "10") 208 | ("color" . "blue")) 209 | "color" 210 | "pipeDelimited" 211 | nil 212 | (schema string)) 213 | "blue"))) 214 | (testing "deepObject" 215 | (ok (equalp (parse-complex-parameter 216 | '(("id" . "10") 217 | ("color[R]" . "100") 218 | ("color[G]" . "200") 219 | ("color[B]" . "150")) 220 | "color" 221 | "deepObject" 222 | nil 223 | (schema 224 | (object 225 | () 226 | :additional-properties 'integer))) 227 | '(("R" . 100) 228 | ("G" . 200) 229 | ("B" . 150)))))) 230 | 231 | (deftest parse-complex-parameters-tests 232 | (ok (equalp (parse-complex-parameters 233 | '(("id" . "10") 234 | ("color" . "blue") 235 | ("color" . "black") 236 | ("color" . "brown")) 237 | "form" 238 | t 239 | (schema 240 | (object 241 | (("id" integer) 242 | ("color" (array :items 'string)))))) 243 | '(("id" . 10) 244 | ("color" . #("blue" "black" "brown"))))) 245 | (ok (equalp (parse-complex-parameters 246 | '(("id" . "10") 247 | ("color" . "blue,black,brown")) 248 | "form" 249 | nil 250 | (schema 251 | (object 252 | (("id" integer) 253 | ("color" (array :items 'string)))))) 254 | '(("id" . 10) 255 | ("color" . #("blue" "black" "brown"))))) 256 | (ok (equalp (parse-complex-parameters 257 | '(("id" . "10") 258 | ("color" . "blue black brown")) 259 | "spaceDelimited" 260 | nil 261 | (schema 262 | (object 263 | (("id" integer) 264 | ("color" (array :items 'string)))))) 265 | '(("id" . 10) 266 | ("color" . #("blue" "black" "brown"))))) 267 | (ok (equalp (parse-complex-parameters 268 | '(("id" . "10") 269 | ("color" . "blue|black|brown")) 270 | "pipeDelimited" 271 | nil 272 | (schema 273 | (object 274 | (("id" integer) 275 | ("color" (array :items 'string)))))) 276 | '(("id" . 10) 277 | ("color" . #("blue" "black" "brown"))))) 278 | (ok (alist= (parse-complex-parameters 279 | '(("id" . "10") 280 | ("color[R]" . "100") 281 | ("color[G]" . "150") 282 | ("color[B]" . "200")) 283 | "deepObject" 284 | nil 285 | (schema 286 | (object 287 | (("id" integer) 288 | ("color" (object 289 | () 290 | :additional-properties 'integer)))))) 291 | '(("id" . 10) 292 | ("color" . (("R" . 100) 293 | ("G" . 150) 294 | ("B" . 200))))))) 295 | -------------------------------------------------------------------------------- /tests/example.yaml: -------------------------------------------------------------------------------- 1 | openapi: '3.0.1' 2 | info: 3 | title: Simple API overview 4 | version: 2.0.0 5 | paths: 6 | /foo: 7 | post: 8 | requestBody: 9 | content: 10 | application/json: 11 | schema: 12 | properties: 13 | foo: 14 | type: string 15 | json_string: 16 | type: string 17 | format: json 18 | responses: 19 | '204': 20 | description: Successfully created a new user. 21 | /foo/{id}: 22 | parameters: 23 | - name: id 24 | in: path 25 | required: true 26 | get: 27 | parameters: 28 | - name: a 29 | in: query 30 | schema: 31 | type: string 32 | responses: 33 | '200': 34 | description: OK 35 | /bar: 36 | get: 37 | parameters: 38 | - name: q1 39 | in: query 40 | schema: 41 | type: boolean 42 | default: false 43 | - name: q2 44 | in: query 45 | schema: 46 | type: boolean 47 | default: true 48 | responses: 49 | '200': 50 | description: OK 51 | -------------------------------------------------------------------------------- /tests/file-loader.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/tests/file-loader 2 | (:use #:cl 3 | #:rove 4 | #:apispec/file-loader) 5 | (:import-from #:apispec/classes/schema 6 | #:json)) 7 | (in-package #:apispec/tests/file-loader) 8 | 9 | (defvar *spec*) 10 | 11 | (setup 12 | (setf *spec* (load-from-file (asdf:system-relative-pathname :apispec "./tests/example.yaml")))) 13 | 14 | (defun get-operation-properties (method path-info) 15 | (apispec:object-properties 16 | (apispec:media-type-schema 17 | (cdr 18 | (assoc "application/json" 19 | (apispec:request-body-content 20 | (apispec:operation-request-body 21 | (apispec:find-route (spec-router *spec*) 22 | method path-info))) 23 | :test #'equal))))) 24 | 25 | (deftest structural-test 26 | (let ((properties 27 | (get-operation-properties :post "/foo"))) 28 | (ok (= 2 (length properties))) 29 | (testing "first property" 30 | (let* ((property (first properties)) 31 | (name (apispec:property-name property)) 32 | (type (apispec:property-type property))) 33 | (ok (equal "foo" name)) 34 | (ok (equal (apispec:schema-type type) "string")) 35 | (ok (null (apispec:schema-format type))) 36 | (ok (null (apispec:schema-enum type))) 37 | (ok (not (apispec:schema-has-default-p type))) 38 | (ok (not (apispec:schema-nullable-p type))) 39 | (ok (not (apispec:schema-deprecated-p type))) 40 | (ok (null (apispec:string-max-length type))) 41 | (ok (null (apispec:string-min-length type))) 42 | (ok (null (apispec:string-pattern type))))) 43 | (testing "second property" 44 | (let* ((property (second properties)) 45 | (name (apispec:property-name property)) 46 | (type (apispec:property-type property))) 47 | (ok (equal "json_string" name)) 48 | (ok (equal (apispec:schema-type type) "string")) 49 | (ok (equal "json" (apispec:schema-format type))) 50 | (ok (null (apispec:schema-enum type))) 51 | (ok (not (apispec:schema-has-default-p type))) 52 | (ok (not (apispec:schema-nullable-p type))) 53 | (ok (not (apispec:schema-deprecated-p type))) 54 | (ok (null (apispec:string-max-length type))) 55 | (ok (null (apispec:string-min-length type))) 56 | (ok (null (apispec:string-pattern type))) 57 | (ok (typep type 'json)))))) 58 | 59 | (deftest parameters-test 60 | (let* ((spec *spec*) 61 | (parameters 62 | (apispec:operation-parameters 63 | (apispec:path-item-get 64 | (cdr (assoc "/foo/{id}" (apispec/router::router-paths (spec-router spec)) :test #'equal)))))) 65 | (ok (= 2 (length parameters))) 66 | (let ((parameter (first parameters))) 67 | (ok (null (apispec:parameter-allow-reserved-p parameter))) 68 | (ok (equal "path" (apispec:parameter-in parameter))) 69 | (ok (equal "id" (apispec:parameter-name parameter))) 70 | (ok (eq t (apispec:parameter-required-p parameter))) 71 | (ok (null (apispec:parameter-schema parameter)))) 72 | (let ((parameter (second parameters))) 73 | (ok (null (apispec:parameter-allow-reserved-p parameter))) 74 | (ok (equal "query" (apispec:parameter-in parameter))) 75 | (ok (equal "a" (apispec:parameter-name parameter))) 76 | (ok (eq nil (apispec:parameter-required-p parameter))) 77 | (ok (typep (apispec:parameter-schema parameter) 'apispec/classes/schema:string))))) 78 | 79 | (deftest query-test 80 | (let* ((spec *spec*) 81 | (parameters 82 | (apispec:operation-parameters 83 | (apispec:find-route 84 | (spec-router spec) :get "/bar")))) 85 | (ok (= 2 (length parameters))) 86 | (flet ((test (parameter expected-name expected-default) 87 | (ok (equal "query" (apispec:parameter-in parameter))) 88 | (ok (equal expected-name (apispec:parameter-name parameter))) 89 | (ok (not (apispec:parameter-required-p parameter))) 90 | (ok (eq t (apispec:parameter-explode-p parameter))) 91 | (let ((schema (apispec:parameter-schema parameter))) 92 | (ok (equal "boolean" (apispec:schema-type schema))) 93 | (ok (eq expected-default (apispec:schema-default schema)))))) 94 | (testing "q1" 95 | (test (first parameters) "q1" nil)) 96 | (testing "q2" 97 | (test (second parameters) "q2" t))))) 98 | -------------------------------------------------------------------------------- /tests/router.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/tests/router 2 | (:use #:cl 3 | #:rove 4 | #:apispec/router) 5 | (:import-from #:apispec/classes/operation 6 | #:operation) 7 | (:import-from #:apispec/classes/path 8 | #:path-item)) 9 | (in-package #:apispec/tests/router) 10 | 11 | (deftest find-route-tests 12 | (let* ((get-pet-operation (make-instance 'operation 13 | :responses '(("200" . nil)))) 14 | (get-my-pet-operation (make-instance 'operation 15 | :responses '(("200" . nil)))) 16 | (specified-pet (make-instance 'path-item 17 | :get get-pet-operation)) 18 | (my-pet (make-instance 'path-item 19 | :get get-my-pet-operation)) 20 | (paths `(("/pets/{petId}" . ,specified-pet) 21 | ("/pets/me" . ,my-pet))) 22 | (router (make-router paths))) 23 | (ok (eq (find-route router :get "/pets/me") 24 | get-my-pet-operation)) 25 | (ok (eq (find-route router :get "/pets/14") 26 | get-pet-operation)) 27 | (ok (null (find-route router :post "/pets/me"))) 28 | (ok (null (find-route router :get "/pets"))))) 29 | -------------------------------------------------------------------------------- /tests/utils.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:apispec/tests/utils 2 | (:use #:cl 3 | #:apispec/utils 4 | #:rove) 5 | (:import-from #:apispec/utils 6 | #:*proper-list-type-checker*)) 7 | (in-package #:apispec/tests/utils) 8 | 9 | (defstruct person name) 10 | 11 | (deftest proper-list-tests 12 | (ok (typep nil 'proper-list)) 13 | (ok (typep '(1) 'proper-list)) 14 | (ok (typep '(1 2) 'proper-list)) 15 | (ok (typep '(1 (2)) 'proper-list)) 16 | (ng (typep '(1 . 2) 'proper-list)) 17 | 18 | (ok (typep nil '(proper-list integer))) 19 | (ok (typep '(1) '(proper-list integer))) 20 | (ok (typep '(1 2) '(proper-list integer))) 21 | (ng (typep '(1 (2)) '(proper-list integer))) 22 | (ng (typep '(1 . 2) '(proper-list integer))) 23 | (ng (typep '(#\a #\b) '(proper-list integer))) 24 | 25 | (ok (typep nil '(proper-list person))) 26 | (ok (typep (list (make-person :name "Eitaro")) 27 | '(proper-list person))) 28 | (ng (typep '(1) '(proper-list person)))) 29 | --------------------------------------------------------------------------------