├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── TODO ├── demo ├── api.lisp ├── demo.lisp ├── demo.org ├── implementation.lisp ├── model.lisp ├── openapi │ ├── Makefile │ ├── openapi.lisp │ ├── petstore.v2.json │ ├── petstore.v3.html │ ├── petstore.v3.json │ ├── petstore.v3.yaml │ └── petstore3.md └── schemas.lisp ├── docs ├── .nojekyll ├── Makefile ├── cl-rest-server.aux ├── cl-rest-server.fn ├── cl-rest-server.fns ├── cl-rest-server.ge ├── cl-rest-server.ges ├── cl-rest-server.info ├── cl-rest-server.log ├── cl-rest-server.pdf ├── cl-rest-server.texi ├── cl-rest-server.toc ├── cl-rest-server │ ├── 0.html │ ├── 1.html │ ├── 10.html │ ├── 11.html │ ├── 12.html │ ├── 13.html │ ├── 14.html │ ├── 15.html │ ├── 16.html │ ├── 17.html │ ├── 18.html │ ├── 19.html │ ├── 1a.html │ ├── 1b.html │ ├── 1c.html │ ├── 1d.html │ ├── 1e.html │ ├── 1f.html │ ├── 2.html │ ├── 20.html │ ├── 21.html │ ├── 22.html │ ├── 23.html │ ├── 24.html │ ├── 25.html │ ├── 26.html │ ├── 27.html │ ├── 28.html │ ├── 29.html │ ├── 2a.html │ ├── 2b.html │ ├── 2c.html │ ├── 2d.html │ ├── 2e.html │ ├── 2f.html │ ├── 3.html │ ├── 30.html │ ├── 31.html │ ├── 32.html │ ├── 33.html │ ├── 34.html │ ├── 35.html │ ├── 36.html │ ├── 37.html │ ├── 38.html │ ├── 39.html │ ├── 3a.html │ ├── 3b.html │ ├── 3c.html │ ├── 3d.html │ ├── 3e.html │ ├── 3f.html │ ├── 4.html │ ├── 40.html │ ├── 41.html │ ├── 42.html │ ├── 43.html │ ├── 44.html │ ├── 45.html │ ├── 46.html │ ├── 47.html │ ├── 48.html │ ├── 49.html │ ├── 4a.html │ ├── 4b.html │ ├── 4c.html │ ├── 4d.html │ ├── 4e.html │ ├── 4f.html │ ├── 5.html │ ├── 50.html │ ├── 51.html │ ├── 52.html │ ├── 53.html │ ├── 54.html │ ├── 55.html │ ├── 56.html │ ├── 57.html │ ├── 58.html │ ├── 59.html │ ├── 5a.html │ ├── 5b.html │ ├── 5c.html │ ├── 5d.html │ ├── 5e.html │ ├── 5f.html │ ├── 6.html │ ├── 60.html │ ├── 61.html │ ├── 62.html │ ├── 63.html │ ├── 64.html │ ├── 65.html │ ├── 66.html │ ├── 67.html │ ├── 68.html │ ├── 69.html │ ├── 6a.html │ ├── 6b.html │ ├── 7.html │ ├── 8.html │ ├── 9.html │ ├── API-configuration.html │ ├── API-definition.html │ ├── API-documentation.html │ ├── API-example.html │ ├── API-implementation.html │ ├── API-options.html │ ├── API.html │ ├── Accessing-the-API.html │ ├── CORS-configuration.html │ ├── Conditional-dispatch.html │ ├── Error-handling.html │ ├── Features.html │ ├── Global-error-mode.html │ ├── Index.html │ ├── Indices-and-tables.html │ ├── Install.html │ ├── Introduction.html │ ├── Logging-configuration.html │ ├── Options.html │ ├── Resource-operation-arguments.html │ ├── Resource-operation-options.html │ ├── Resource-operations.html │ ├── Resource-options.html │ ├── Resources.html │ ├── Starting-the-API.html │ ├── a.html │ ├── api-accessing_002dthe_002dapi.html │ ├── api-api_002ddefinition.html │ ├── api-api_002dexample.html │ ├── api-api_002dimplementation.html │ ├── api-api_002doptions.html │ ├── api-conditional_002ddispatch.html │ ├── api-doc.html │ ├── api-function-rest_002dserver-implement_002dresource_002doperation_002dcase.html │ ├── api-function-rest_002dserver-start_002dapi.html │ ├── api-macro-rest_002dserver-define_002dapi.html │ ├── api-macro-rest_002dserver-define_002dapi_002dresource.html │ ├── api-macro-rest_002dserver-implement_002dresource_002doperation.html │ ├── api-macro-rest_002dserver-with_002dapi.html │ ├── api-macro-rest_002dserver-with_002dapi_002dbackend.html │ ├── api-macro-rest_002dserver-with_002dapi_002dresource.html │ ├── api-quicklisp.html │ ├── api-resource_002doperation_002darguments.html │ ├── api-resource_002doperation_002doptions.html │ ├── api-resource_002doperations.html │ ├── api-resource_002doptions.html │ ├── api-resources.html │ ├── api-starting_002dthe_002dapi.html │ ├── api_002dconfiguration-api_002dconfiguration.html │ ├── api_002dconfiguration-cors_002dconfiguration.html │ ├── api_002dconfiguration-doc.html │ ├── api_002dconfiguration-function-rest_002dserver-configure_002dapi.html │ ├── api_002dconfiguration-function-rest_002dserver-start_002dapi_002dlogging.html │ ├── api_002dconfiguration-logging_002dconfiguration.html │ ├── api_002dconfiguration-options.html │ ├── b.html │ ├── c.html │ ├── d.html │ ├── documentation-api_002ddocumentation.html │ ├── documentation-doc.html │ ├── e.html │ ├── error_002dhandling-doc.html │ ├── error_002dhandling-error_002dhandling.html │ ├── error_002dhandling-global_002derror_002dmode.html │ ├── error_002dhandling-variable-rest_002dserver-_002acatch_002derrors_002a.html │ ├── error_002dhandling-variable-rest_002dserver-_002aserver_002dcatch_002derrors_002a.html │ ├── f.html │ ├── index-doc.html │ ├── index-indices_002dand_002dtables.html │ ├── index.html │ ├── install-doc.html │ ├── install-install.html │ ├── introduction-doc.html │ ├── introduction-features.html │ ├── introduction-introduction.html │ ├── introduction-welcome_002dto_002dcommon_002dlisp_002drest_002dserver_002ds_002ddocumentation.html │ ├── symbols-api.html │ ├── symbols-doc.html │ ├── symbols-function-rest_002dserver-accept_002dserializer.html │ ├── symbols-function-rest_002dserver-add_002dlist_002dmember.html │ ├── symbols-function-rest_002dserver-attribute.html │ ├── symbols-function-rest_002dserver-boolean_002dvalue.html │ ├── symbols-function-rest_002dserver-configure_002dapi.html │ ├── symbols-function-rest_002dserver-configure_002dapi_002dresource.html │ ├── symbols-function-rest_002dserver-configure_002dresource_002doperation_002dimplementation.html │ ├── symbols-function-rest_002dserver-disable_002dapi_002dlogging.html │ ├── symbols-function-rest_002dserver-element.html │ ├── symbols-function-rest_002dserver-elements.html │ ├── symbols-function-rest_002dserver-enable_002dapi_002dlogging.html │ ├── symbols-function-rest_002dserver-find_002dapi.html │ ├── symbols-function-rest_002dserver-find_002dschema.html │ ├── symbols-function-rest_002dserver-format_002dabsolute_002dresource_002doperation_002durl.html │ ├── symbols-function-rest_002dserver-http_002derror.html │ ├── symbols-function-rest_002dserver-list_002dvalue.html │ ├── symbols-function-rest_002dserver-make_002dresource_002doperation.html │ ├── symbols-function-rest_002dserver-self_002dreference.html │ ├── symbols-function-rest_002dserver-serializable_002dclass_002dschema.html │ ├── symbols-function-rest_002dserver-set_002dattribute.html │ ├── symbols-function-rest_002dserver-set_002dreply_002dcontent_002dtype.html │ ├── symbols-function-rest_002dserver-start_002dapi.html │ ├── symbols-function-rest_002dserver-start_002dapi_002ddocumentation.html │ ├── symbols-function-rest_002dserver-start_002dapi_002dlogging.html │ ├── symbols-function-rest_002dserver-stop_002dapi.html │ ├── symbols-function-rest_002dserver-stop_002dapi_002dlogging.html │ ├── symbols-function-rest_002dserver-validation_002derror.html │ ├── symbols-macro-rest_002dserver-caching.html │ ├── symbols-macro-rest_002dserver-define_002dapi.html │ ├── symbols-macro-rest_002dserver-define_002dapi_002dresource.html │ ├── symbols-macro-rest_002dserver-define_002dresource_002doperation.html │ ├── symbols-macro-rest_002dserver-define_002dschema.html │ ├── symbols-macro-rest_002dserver-define_002dserializable_002dclass.html │ ├── symbols-macro-rest_002dserver-define_002dswagger_002dresource.html │ ├── symbols-macro-rest_002dserver-error_002dhandling.html │ ├── symbols-macro-rest_002dserver-fetch_002dcontent.html │ ├── symbols-macro-rest_002dserver-implement_002dresource_002doperation.html │ ├── symbols-macro-rest_002dserver-implement_002dresource_002doperation_002dcase.html │ ├── symbols-macro-rest_002dserver-logging.html │ ├── symbols-macro-rest_002dserver-permission_002dchecking.html │ ├── symbols-macro-rest_002dserver-schema.html │ ├── symbols-macro-rest_002dserver-serialization.html │ ├── symbols-macro-rest_002dserver-unserialization.html │ ├── symbols-macro-rest_002dserver-validation.html │ ├── symbols-macro-rest_002dserver-with_002dapi.html │ ├── symbols-macro-rest_002dserver-with_002dapi_002dbackend.html │ ├── symbols-macro-rest_002dserver-with_002dapi_002dresource.html │ ├── symbols-macro-rest_002dserver-with_002dattribute.html │ ├── symbols-macro-rest_002dserver-with_002dcontent.html │ ├── symbols-macro-rest_002dserver-with_002delement.html │ ├── symbols-macro-rest_002dserver-with_002djson_002dreply.html │ ├── symbols-macro-rest_002dserver-with_002dlist.html │ ├── symbols-macro-rest_002dserver-with_002dlist_002dmember.html │ ├── symbols-macro-rest_002dserver-with_002dpagination.html │ ├── symbols-macro-rest_002dserver-with_002dpermission_002dchecking.html │ ├── symbols-macro-rest_002dserver-with_002dposted_002dcontent.html │ ├── symbols-macro-rest_002dserver-with_002dreply_002dcontent_002dtype.html │ ├── symbols-macro-rest_002dserver-with_002dserializer.html │ ├── symbols-macro-rest_002dserver-with_002dserializer_002doutput.html │ ├── symbols-macro-rest_002dserver-with_002dxml_002dreply.html │ ├── symbols-variable-rest_002dserver-_002acatch_002derrors_002a.html │ └── symbols-variable-rest_002dserver-_002aserver_002dcatch_002derrors_002a.html ├── janix-texinfo.css ├── manual.css ├── reset.css └── style.css ├── lib └── jwtcmd.py ├── rest-server-demo.asd ├── rest-server-openapi-demo.asd ├── rest-server-tests.asd ├── rest-server.asd ├── src ├── api-documentation.lisp ├── api.lisp ├── argument-type.lisp ├── auth.lisp ├── caching.lisp ├── cors.lisp ├── decorator-class.lisp ├── error-handling.lisp ├── flow.dia ├── flow.lisp ├── flow.xml ├── jwt.lisp ├── logging.lisp ├── mimeparse.lisp ├── oauth.lisp ├── oauth2.lisp ├── openapi.lisp ├── package.lisp ├── pagination.lisp ├── resource-operation.lisp ├── resource.lisp ├── rest-server.lisp ├── schema.lisp ├── serialization.lisp ├── specials.lisp ├── swagger.lisp ├── util.lisp └── xml.lisp └── test ├── TODO.txt ├── api.lisp ├── authentication.lisp ├── decorations.lisp ├── oauth.lisp ├── oauth2-api.lisp └── test.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.fasl 3 | /doc/rest-server.aux 4 | /doc/rest-server.cp 5 | /doc/rest-server.cps 6 | /doc/rest-server.fn 7 | /doc/rest-server.ky 8 | /doc/rest-server.log 9 | /doc/rest-server.pg 10 | /doc/rest-server.toc 11 | /doc/rest-server.tp 12 | /doc/rest-server.vr 13 | /doc/build 14 | /doc/cl-rest-server.aux 15 | /doc/cl-rest-server.fn 16 | /doc/cl-rest-server.fns 17 | /doc/cl-rest-server.ge 18 | /doc/cl-rest-server.ges 19 | /doc/cl-rest-server.log 20 | /doc/cl-rest-server.toc 21 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: lisp 2 | 3 | branches: 4 | only: 5 | - master 6 | 7 | env: 8 | matrix: 9 | - LISP=sbcl 10 | - LISP=abcl 11 | 12 | install: 13 | - curl https://gist.githubusercontent.com/mmontone/87a4a3d361fa4ebfba72/raw/43458e7280e5ddaf844c86b8fd9a8562e8b2f3ca/install.sh | bash 14 | 15 | before_script: 16 | 17 | script: 18 | - cl-launch -i "(setf *readtable* (copy-readtable nil))(ql:quickload :rest-server-tests)(rest-server-tests:debug-tests)" 19 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2012 Mariano Montone 2 | 3 | Permission is hereby granted, free of charge, to any person 4 | obtaining a copy of this software and associated documentation 5 | files (the \"Software\"), to deal in the Software without 6 | restriction, including without limitation the rights to use, 7 | copy, modify, merge, publish, distribute, sublicense, and/or 8 | sell copies of the Software, and to permit persons to whom the 9 | Software is furnished to do so, subject to the following 10 | conditions: 11 | 12 | The above copyright notice and this permission notice shall be 13 | included in all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, 16 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES 17 | OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 18 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 19 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 20 | WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 21 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Common Lisp REST Server 2 | ======================= 3 | 4 | *rest-server* is a library for writing REST Web APIs in Common Lisp 5 | 6 | [![Build Status](https://travis-ci.org/mmontone/cl-rest-server.svg?branch=master)](https://travis-ci.org/mmontone/cl-rest-server) 7 | 8 | | :warning: WARNING | 9 | |:------------------------------------------------------------------| 10 | | This project's documentation is outdated and cannot be relied on. | 11 | | Not everything works. The project needs to be better maintained. | 12 | 13 | 14 | ## Install 15 | 16 | The library is available at [Ultralisp](https://ultralisp.org). 17 | 18 | ## Documentation 19 | 20 | [HTML](http://mmontone.github.io/cl-rest-server/cl-rest-server/) 21 | 22 | ## Features 23 | 24 | * Method matching 25 | - Based on HTTP method (GET, PUT, POST, DELETE) 26 | - Based on Accept request header 27 | - URL parsing (argument types) 28 | 29 | * Serialization 30 | - Different serialization types (JSON, XML, S-expressions) 31 | 32 | * Error handling 33 | - Development and production modes 34 | - HTTP status codes 35 | 36 | * Validation via schemas 37 | 38 | * Annotations for api logging, caching, permission checking, and more. 39 | 40 | * Authentication 41 | - Different methods (token based, oauth) 42 | 43 | * API client 44 | - Generation of API client functions via macros 45 | 46 | * Alpha OpenAPI support 47 | - [Parse Open API v3 apis and generate Lisp API spec from it](test/openapi.lisp) 48 | 49 | * APIs documentation 50 | - Via Swagger: http://swagger.wordnik.com 51 | 52 | ## Demo 53 | 54 | * [Basic service](/demo) 55 | * [OpenAPI service](/demo/openapi) 56 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | * Read accepted content types from uri suffix. i.e. /api/users/1.xml or /api/users/1.json 2 | * Floats in schemas 3 | * API versioning 4 | -------------------------------------------------------------------------------- /demo/api.lisp: -------------------------------------------------------------------------------- 1 | (in-package :rest-server-demo) 2 | 3 | (define-api users-demo-api () 4 | (:title "Users demo api" 5 | :documentation "An api demo with a simple users CRUD" 6 | :client-package :rest-server-demo.client 7 | :export-client-functions t) 8 | (users (:produces (:json :xml) 9 | :consumes (:json) 10 | :documentation "Users operations" 11 | :models (user) 12 | :path "/users") 13 | (list-users (:request-method :get 14 | :produces (:json) 15 | :path "/users" 16 | :documentation "Retrive the users list") 17 | (&optional (page :integer 1 "The page") 18 | (expand :list nil "Attributes to expand"))) 19 | (fetch-user (:request-method :get 20 | :produces (:json) 21 | :path "/users/{id}" 22 | :documentation "Retrive an user") 23 | ((id :integer "The user id") 24 | &optional 25 | (expand :list nil "Attributes to expand"))) 26 | (create-user (:request-method :post 27 | :consumes (:json) 28 | :path "/users" 29 | :documentation "Create a user" 30 | :body-schema user) 31 | ()) 32 | (update-user (:request-method :put 33 | :consumes (:json) 34 | :path "/users/{id}" 35 | :documentation "Update a user" 36 | :body-schema user) 37 | ((id :integer "The user id"))) 38 | (delete-user (:request-method :delete 39 | :consumes (:json) 40 | :path "/users/{id}" 41 | :documentation "Delete a user") 42 | ((id :integer "The user id"))))) 43 | -------------------------------------------------------------------------------- /demo/demo.lisp: -------------------------------------------------------------------------------- 1 | (defpackage rest-server-demo.client 2 | (:use :cl)) 3 | 4 | (defpackage rest-server-demo 5 | (:use :cl :rest-server :generic-serializer) 6 | (:export :start-demo-api)) 7 | 8 | (in-package rest-server-demo) 9 | 10 | (defun start-demo-api () 11 | (rs:start-api 'users-demo-api :port 9090)) 12 | -------------------------------------------------------------------------------- /demo/demo.org: -------------------------------------------------------------------------------- 1 | * REST SERVER DEMO 2 | 3 | ** Load the demo 4 | 5 | #+BEGIN_SRC lisp :exports code :results pp :session 6 | (ql:quickload :rest-server-demo) 7 | #+END_SRC 8 | 9 | ** Start the demo api 10 | 11 | #+BEGIN_SRC lisp :exports code :results pp :session 12 | (rest-server-demo:start-demo-api) 13 | #+END_SRC 14 | 15 | ** Access the api via the generated client functions 16 | 17 | #+BEGIN_SRC lisp :exports both :results org :session 18 | (rs:with-api-backend "http://localhost:9090" 19 | (rest-server-demo.client:list-users)) 20 | #+END_SRC 21 | 22 | #+RESULTS: 23 | #+BEGIN_SRC org 24 | ((:PAGE . 1) (:NEXT . "http://localhost:9090/users?page=2&expand=") 25 | (:PREVIOUS . "http://localhost:9090/users?page=0&expand=") (:RESULTS)) 26 | 200 27 | #+END_SRC 28 | 29 | #+BEGIN_SRC lisp :exports both :results org :session 30 | (rs:with-api-backend "http://localhost:9090" 31 | (rest-server-demo.client:create-user nil)) 32 | #+END_SRC 33 | 34 | #+RESULTS: 35 | #+BEGIN_SRC org 36 | ((:ID . 2) (:REALNAME)) 37 | 200 38 | #+END_SRC 39 | 40 | #+BEGIN_SRC lisp :exports both :results org :session 41 | (rs:with-api-backend "http://localhost:9090" 42 | (rest-server-demo.client:create-user '((:realname . "Mariano")))) 43 | #+END_SRC 44 | 45 | #+RESULTS: 46 | #+BEGIN_SRC org 47 | ((:ID . 4) (:REALNAME . "Mariano")) 48 | 200 49 | #+END_SRC 50 | 51 | #+BEGIN_SRC lisp :exports both :results org :session 52 | (rs:with-api-backend "http://localhost:9090" 53 | (rest-server-demo.client:list-users)) 54 | #+END_SRC 55 | 56 | #+RESULTS: 57 | #+BEGIN_SRC org 58 | ((:PAGE . 1) (:NEXT . "http://localhost:9090/users?page=2&expand=") 59 | (:PREVIOUS . "http://localhost:9090/users?page=0&expand=") 60 | (:RESULTS ((:ID . 4) (:REALNAME . "Mariano")) 61 | ((:ID . 3) (:REALNAME . "Mariano")) ((:ID . 2) (:REALNAME)))) 62 | 200 63 | #+END_SRC 64 | 65 | #+BEGIN_SRC lisp :exports both :results org :session 66 | (rs:with-api-backend "http://localhost:9090" 67 | (rest-server-demo.client:fetch-user 3)) 68 | #+END_SRC 69 | 70 | #+RESULTS: 71 | #+BEGIN_SRC org 72 | ((:HREF . "http://localhost:9090/users/3") (:ID . 3) (:REALNAME . "Mariano")) 73 | 200 74 | #+END_SRC 75 | -------------------------------------------------------------------------------- /demo/implementation.lisp: -------------------------------------------------------------------------------- 1 | (in-package :rest-server-demo) 2 | 3 | (implement-resource-operation users-demo-api 4 | (list-users 5 | (:logging :enabled t) 6 | (:error-handling :enabled t)) 7 | (&rest args &key expand (page 1)) 8 | (declare (ignorable args)) 9 | (let ((serializer (rest-server::accept-serializer))) 10 | (set-reply-content-type (generic-serializer::serializer-content-type serializer)) 11 | (with-output-to-string (s) 12 | (with-serializer-output s 13 | (with-serializer serializer 14 | (with-pagination (:page page :expand expand) 15 | (with-list ("users") 16 | (loop for user in (simple-users-model:all-users (* 10 (1- page)) 10) 17 | do 18 | (with-list-member ("user") 19 | (with-object ("user") 20 | (set-attribute "id" (cdr (assoc :id user))) 21 | (set-attribute "realname" (cdr (assoc :realname user))))))))))))) 22 | 23 | (implement-resource-operation users-demo-api 24 | (fetch-user 25 | (:logging :enabled nil) 26 | (:serialization :enabled t)) 27 | (id &key expand) 28 | (declare (ignore expand)) 29 | (let ((user (simple-users-model:get-user id))) 30 | (if (not user) 31 | (error 'http-not-found-error) 32 | ; else 33 | (object "user" 34 | (attribute "href" 35 | (format-absolute-resource-operation-url rest-server::*resource-operation* :id id)) 36 | (attribute "id" id) 37 | (attribute "realname" (cdr (assoc :realname user))))))) 38 | 39 | (implement-resource-operation 40 | users-demo-api 41 | create-user (&posted-content posted-content) 42 | (let ((user 43 | (simple-users-model:add-user (cdr (assoc :realname posted-content))))) 44 | (with-json-reply 45 | (json:encode-json-alist-to-string user)))) 46 | 47 | (implement-resource-operation 48 | users-demo-api 49 | update-user (&posted-content posted-content id) 50 | (let ((user (simple-users-model:get-user id))) 51 | (if (not user) 52 | (error 'http-not-found-error) 53 | ; else 54 | (progn 55 | (simple-users-model::set-user-realname user (cdr (assoc :realname posted-content))) 56 | (simple-users-model:update-user user))))) 57 | 58 | (implement-resource-operation users-demo-api 59 | delete-user (id) 60 | (simple-users-model:delete-user id)) 61 | -------------------------------------------------------------------------------- /demo/model.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :simple-users-model 2 | (:use :cl) 3 | (:export 4 | :get-user 5 | :all-users 6 | :add-user 7 | :update-user 8 | :delete-user)) 9 | 10 | (in-package :simple-users-model) 11 | 12 | (defparameter *user-id* 1) 13 | (defvar *users* nil) 14 | 15 | (defun make-user (id realname) 16 | (list (cons :id id) 17 | (cons :realname realname))) 18 | 19 | (defun user-id (user) 20 | (cdr (assoc :id user))) 21 | 22 | (defun user-realname (user) 23 | (cdr (assoc :realname user))) 24 | 25 | (defun set-user-realname (user realname) 26 | (setf (cdr (assoc :realname user)) realname)) 27 | 28 | (defun add-user (realname) 29 | (let ((user (make-user (incf *user-id*) 30 | realname))) 31 | (push user 32 | *users*) 33 | user)) 34 | 35 | (defun update-user (user) 36 | (delete-user (user-id user)) 37 | (push user *users*)) 38 | 39 | (defun get-user (id) 40 | (find id *users* :key (lambda (user) 41 | (cdr (assoc :id user))))) 42 | 43 | (defun delete-user (id) 44 | (setf *users* (delete id *users* :test #'equalp :key #'first))) 45 | 46 | (defun all-users (&optional offset segment) 47 | (let ((users (copy-list *users*))) 48 | (if offset 49 | (apply #'subseq users (cons (min offset (length users)) 50 | (and segment (list (min (+ offset segment) 51 | (length users)))))) 52 | users))) 53 | -------------------------------------------------------------------------------- /demo/openapi/Makefile: -------------------------------------------------------------------------------- 1 | all: petstore.v3.html 2 | 3 | petstore.v3.html: 4 | which redoc-cli || npm install -g redoc-cli 5 | redoc-cli bundle ./petstore.v3.json -o petstore.v3.html 6 | 7 | clean: 8 | rm petstore.v3.html 9 | -------------------------------------------------------------------------------- /demo/openapi/openapi.lisp: -------------------------------------------------------------------------------- 1 | ;; Just load this file, then evaluate (rest-server/demo/open-api:start-petstore-api) for a demo of how OpenAPI support works. 2 | ;; Test with the url: http://localhost:3006/pet/55 3 | 4 | (defpackage :rest-server/demo/open-api 5 | (:use 6 | :cl 7 | :rest-server 8 | :generic-serializer 9 | :rs.openapi) 10 | (:export :start-petstore-api)) 11 | 12 | (in-package :rest-server/demo/open-api) 13 | 14 | (define-schemas-from-spec 15 | #.(asdf:system-relative-pathname :rest-server 16 | "demo/openapi/petstore.v3.json")) 17 | (define-api-from-spec petstore () () 18 | #.(asdf:system-relative-pathname :rest-server 19 | "demo/openapi/petstore.v3.json")) 20 | 21 | (rs:implement-resource-operation petstore 22 | get-pet-by-id (pet-id) 23 | (format nil "Pet with id: ~A" pet-id) 24 | ) 25 | 26 | (rs:implement-resource-operation petstore 27 | get-user-by-name (username) 28 | (format nil "User: ~A" username) 29 | ) 30 | 31 | (rs:implement-resource-operation petstore 32 | login-user (username password) 33 | (format nil "User login with ~A and ~A" username password)) 34 | 35 | (defun start-petstore-api () 36 | (rs:start-api 'petstore :port 3006)) 37 | 38 | (defun export-petstore-api () 39 | (rs.openapi:export-api-spec (find-api 'petstore))) 40 | -------------------------------------------------------------------------------- /demo/schemas.lisp: -------------------------------------------------------------------------------- 1 | (in-package :rest-server-demo) 2 | 3 | (schemata:define-schema user 4 | (schemata:object user 5 | ((:id integer :documentation "The user id") 6 | (:realname string :documentation "The user realname")))) 7 | 8 | -------------------------------------------------------------------------------- /docs/.nojekyll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mmontone/cl-rest-server/1eec95480e36a0ee1e1666d32d0643d2da9a1b17/docs/.nojekyll -------------------------------------------------------------------------------- /docs/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: html clean 2 | 3 | html: 4 | makeinfo --html --split=chapter --css-include manual.css cl-rest-server.texi 5 | 6 | pdf: 7 | makeinfo --pdf cl-rest-server.texi 8 | 9 | clean: 10 | rm -f cl-rest-server/* 11 | -------------------------------------------------------------------------------- /docs/cl-rest-server.fns: -------------------------------------------------------------------------------- 1 | \initial {(} 2 | \entry{\code {(accept\w {-}serializer)}}{12} 3 | \entry{\code {(add\w {-}list\w {-}member)}}{13} 4 | \entry{\code {(attribute)}}{14} 5 | \entry{\code {(boolean\w {-}value)}}{12} 6 | \entry{\code {(cachingargs}}{14} 7 | \entry{\code {(configure\w {-}api\w {-}resourceapi-or-name}}{12} 8 | \entry{\code {(configure\w {-}apiapi-or-name}}{10, 13} 9 | \entry{\code {(configure\w {-}resource\w {-}operation\w {-}implementationname}}{13} 10 | \entry{\code {(define\w {-}api\w {-}resourcename}}{3, 14} 11 | \entry{\code {(define\w {-}apiname}}{3, 14} 12 | \entry{\code {(define\w {-}resource\w {-}operationname}}{13} 13 | \entry{\code {(disable\w {-}api\w {-}logging)}}{12} 14 | \entry{\code {(element)}}{14} 15 | \entry{\code {(elements)}}{13} 16 | \entry{\code {(enable\w {-}api\w {-}logging)}}{13} 17 | \entry{\code {(find\w {-}apiname}}{13} 18 | \entry{\code {(find\w {-}schema)}}{12} 19 | \entry{\code {(format\w {-}absolute\w {-}resource\w {-}operation\w {-}urlresource-operation}}{12} 20 | \entry{\code {(http\w {-}error)}}{12} 21 | \entry{\code {(implement\w {-}resource\w {-}operation\w {-}casename}}{12} 22 | \entry{\code {(implement\w {-}resource\w {-}operationapi-name}}{6, 12} 23 | \entry{\code {(list\w {-}value)}}{12} 24 | \entry{\code {(make\w {-}resource\w {-}operationname}}{13} 25 | \entry{\code {(permission\w {-}checkingargs}}{12} 26 | \entry{\code {(self\w {-}reference&rest}}{13} 27 | \entry{\code {(serializable\w {-}class\w {-}schema)}}{13} 28 | \entry{\code {(set\w {-}attribute)}}{13} 29 | \entry{\code {(set\w {-}reply\w {-}content\w {-}typecontent-type)}}{12} 30 | \entry{\code {(start\w {-}api\w {-}documentationapi}}{12} 31 | \entry{\code {(start\w {-}api\w {-}logging)}}{10, 14} 32 | \entry{\code {(start\w {-}apiapi}}{7, 13} 33 | \entry{\code {(stop\w {-}api\w {-}logging)}}{13} 34 | \entry{\code {(stop\w {-}apiapi-acceptor)}}{13} 35 | \entry{\code {(validation\w {-}error)}}{13} 36 | \entry{\code {(with\w {-}api\w {-}backendbackend}}{8, 12} 37 | \entry{\code {(with\w {-}api\w {-}resourceresource}}{4, 14} 38 | \entry{\code {(with\w {-}apiapi}}{3, 12} 39 | \entry{\code {(with\w {-}content}}{14} 40 | \entry{\code {(with\w {-}json\w {-}reply&body}}{13} 41 | \entry{\code {(with\w {-}pagination}}{14} 42 | \entry{\code {(with\w {-}permission\w {-}checkingcheck}}{14} 43 | \entry{\code {(with\w {-}posted\w {-}contentargs}}{14} 44 | \entry{\code {(with\w {-}reply\w {-}content\w {-}type}}{14} 45 | \entry{\code {(with\w {-}xml\w {-}reply&body}}{12} 46 | \initial {*} 47 | \entry{\code {*catch\w {-}errors*}}{9, 14} 48 | \entry{\code {*server\w {-}catch\w {-}errors*}}{9, 14} 49 | \initial {D} 50 | \entry{\code {define\w {-}schema}}{12} 51 | \entry{\code {define\w {-}serializable\w {-}class}}{13} 52 | \entry{\code {define\w {-}swagger\w {-}resource}}{14} 53 | \initial {E} 54 | \entry{\code {error\w {-}handling}}{14} 55 | \initial {F} 56 | \entry{\code {fetch\w {-}content}}{13} 57 | \initial {L} 58 | \entry{\code {logging}}{13} 59 | \initial {S} 60 | \entry{\code {schema}}{13} 61 | \entry{\code {serialization}}{12} 62 | \initial {U} 63 | \entry{\code {unserialization}}{13} 64 | \initial {V} 65 | \entry{\code {validation}}{14} 66 | \initial {W} 67 | \entry{\code {with\w {-}attribute}}{13} 68 | \entry{\code {with\w {-}element}}{14} 69 | \entry{\code {with\w {-}list}}{13} 70 | \entry{\code {with\w {-}list\w {-}member}}{12} 71 | \entry{\code {with\w {-}serializer}}{14} 72 | \entry{\code {with\w {-}serializer\w {-}output}}{12} 73 | -------------------------------------------------------------------------------- /docs/cl-rest-server.ges: -------------------------------------------------------------------------------- 1 | \initial {*} 2 | \entry{*catch-errors* (Lisp variable)}{9, 14} 3 | \entry{*server-catch-errors* (Lisp variable)}{9, 14} 4 | \initial {A} 5 | \entry{accept-serializer (Lisp function)}{12} 6 | \entry{add-list-member (Lisp function)}{13} 7 | \entry{attribute (Lisp function)}{14} 8 | \initial {B} 9 | \entry{boolean-value (Lisp function)}{12} 10 | \initial {C} 11 | \entry{caching (Lisp macro)}{14} 12 | \entry{configure-api (Lisp function)}{10, 13} 13 | \entry{configure-api-resource (Lisp function)}{12} 14 | \entry{configure-resource-operation-implementation (Lisp function)}{13} 15 | \initial {D} 16 | \entry{define-api (Lisp macro)}{3, 14} 17 | \entry{define-api-resource (Lisp macro)}{3, 14} 18 | \entry{define-resource-operation (Lisp macro)}{13} 19 | \entry{define-schema (Lisp macro)}{12} 20 | \entry{define-serializable-class (Lisp macro)}{13} 21 | \entry{define-swagger-resource (Lisp macro)}{14} 22 | \entry{disable-api-logging (Lisp function)}{12} 23 | \initial {E} 24 | \entry{element (Lisp function)}{14} 25 | \entry{elements (Lisp function)}{13} 26 | \entry{enable-api-logging (Lisp function)}{13} 27 | \entry{error-handling (Lisp macro)}{14} 28 | \initial {F} 29 | \entry{fetch-content (Lisp macro)}{13} 30 | \entry{find-api (Lisp function)}{13} 31 | \entry{find-schema (Lisp function)}{12} 32 | \entry{format-absolute-resource-operation-url (Lisp function)}{12} 33 | \initial {H} 34 | \entry{http-error (Lisp function)}{12} 35 | \initial {I} 36 | \entry{implement-resource-operation (Lisp macro)}{6, 12} 37 | \entry{implement-resource-operation-case (Lisp macro)}{12} 38 | \initial {L} 39 | \entry{list-value (Lisp function)}{12} 40 | \entry{logging (Lisp macro)}{13} 41 | \initial {M} 42 | \entry{make-resource-operation (Lisp function)}{13} 43 | \initial {P} 44 | \entry{permission-checking (Lisp macro)}{12} 45 | \initial {S} 46 | \entry{schema (Lisp macro)}{13} 47 | \entry{self-reference (Lisp function)}{13} 48 | \entry{serializable-class-schema (Lisp function)}{13} 49 | \entry{serialization (Lisp macro)}{12} 50 | \entry{set-attribute (Lisp function)}{13} 51 | \entry{set-reply-content-type (Lisp function)}{12} 52 | \entry{start-api (Lisp function)}{7, 13} 53 | \entry{start-api-documentation (Lisp function)}{12} 54 | \entry{start-api-logging (Lisp function)}{10, 14} 55 | \entry{stop-api (Lisp function)}{13} 56 | \entry{stop-api-logging (Lisp function)}{13} 57 | \initial {U} 58 | \entry{unserialization (Lisp macro)}{13} 59 | \initial {V} 60 | \entry{validation (Lisp macro)}{14} 61 | \entry{validation-error (Lisp function)}{13} 62 | \initial {W} 63 | \entry{with-api (Lisp macro)}{3, 12} 64 | \entry{with-api-backend (Lisp macro)}{8, 12} 65 | \entry{with-api-resource (Lisp macro)}{4, 14} 66 | \entry{with-attribute (Lisp macro)}{13} 67 | \entry{with-content (Lisp macro)}{14} 68 | \entry{with-element (Lisp macro)}{14} 69 | \entry{with-json-reply (Lisp macro)}{13} 70 | \entry{with-list (Lisp macro)}{13} 71 | \entry{with-list-member (Lisp macro)}{12} 72 | \entry{with-pagination (Lisp macro)}{14} 73 | \entry{with-permission-checking (Lisp macro)}{14} 74 | \entry{with-posted-content (Lisp macro)}{14} 75 | \entry{with-reply-content-type (Lisp macro)}{14} 76 | \entry{with-serializer (Lisp macro)}{14} 77 | \entry{with-serializer-output (Lisp macro)}{12} 78 | \entry{with-xml-reply (Lisp macro)}{12} 79 | -------------------------------------------------------------------------------- /docs/cl-rest-server.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mmontone/cl-rest-server/1eec95480e36a0ee1e1666d32d0643d2da9a1b17/docs/cl-rest-server.pdf -------------------------------------------------------------------------------- /docs/cl-rest-server.toc: -------------------------------------------------------------------------------- 1 | @numchapentry{Introduction}{1}{Introduction}{1} 2 | @numsecentry{Features}{1.1}{Features}{1} 3 | @numchapentry{Install}{2}{Install}{2} 4 | @numchapentry{API definition}{3}{API definition}{3} 5 | @numsecentry{API options}{3.1}{API options}{3} 6 | @numsecentry{Resources}{3.2}{Resources}{3} 7 | @numsubsecentry{Resource options}{3.2.1}{Resource options}{3} 8 | @numsecentry{Resource operations}{3.3}{Resource operations}{4} 9 | @numsubsecentry{Resource operation options}{3.3.1}{Resource operation options}{4} 10 | @numsubsecentry{Resource operation arguments}{3.3.2}{Resource operation arguments}{4} 11 | @numsecentry{API example}{3.4}{API example}{5} 12 | @numchapentry{API implementation}{4}{API implementation}{6} 13 | @numchapentry{Starting the API}{5}{Starting the API}{7} 14 | @numchapentry{Accessing the API}{6}{Accessing the API}{8} 15 | @numchapentry{Error handling}{7}{Error handling}{9} 16 | @numsecentry{Global error mode}{7.1}{Global error mode}{9} 17 | @numchapentry{API configuration}{8}{API configuration}{10} 18 | @numsecentry{CORS configuration}{8.1}{CORS configuration}{10} 19 | @numsubsecentry{Options:}{8.1.1}{Options}{10} 20 | @numsecentry{Logging configuration}{8.2}{Logging configuration}{10} 21 | @numchapentry{API documentation}{9}{API documentation}{11} 22 | @numchapentry{API}{10}{API}{12} 23 | @unnchapentry{Indices and tables}{10002}{Indices and tables}{15} 24 | @unnchapentry{Index}{10003}{Index}{16} 25 | -------------------------------------------------------------------------------- /docs/cl-rest-server/0.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 0 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 0.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/2b.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 2b (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 2b.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/2c.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 2c (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 2c.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/2d.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 2d (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 2d.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/2e.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 2e (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 2e.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/2f.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 2f (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 2f.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/30.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 30 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 30.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/31.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 31 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 31.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/32.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 32 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 32.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/33.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 33 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 33.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/34.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 34 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 34.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/35.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 35 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 35.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/36.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 36 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 36.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/37.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 37 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 37.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/38.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 38 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 38.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/39.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 39 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 39.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/3a.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 3a (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 3a.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/3b.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 3b (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 3b.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/3c.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 3c (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 3c.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/3d.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 3d (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 3d.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/3e.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 3e (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 3e.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/3f.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 3f (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 3f.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/40.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 40 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 40.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/41.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 41 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 41.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/42.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 42 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 42.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/43.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 43 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 43.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/44.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 44 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 44.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/45.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 45 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 45.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/46.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 46 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 46.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/47.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 47 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 47.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/48.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 48 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 48.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/49.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 49 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 49.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/4a.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 4a (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 4a.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/4b.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 4b (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 4b.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/4c.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 4c (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 4c.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/4d.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 4d (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 4d.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/4e.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 4e (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 4e.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/4f.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 4f (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 4f.

120 | 121 | -------------------------------------------------------------------------------- /docs/cl-rest-server/5.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | 5 (Common Lisp REST Server Documentation) 14 | 15 | 16 | 17 | 18 | 19 | 20 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 |

The node you are looking for is at 5.

120 | 121 | -------------------------------------------------------------------------------- /docs/manual.css: -------------------------------------------------------------------------------- 1 | /* Style-sheet to use for manuals (copied from Emacs) */ 2 | 3 | @import url('../style.css'); 4 | 5 | /* makeinfo 6.5 converts @quotation to
. Highlight them. */ 6 | blockquote { 7 | font-style: normal; 8 | border-left: solid 10px red; 9 | padding-left: 2.5%; 10 | margin-left: 0px; 11 | } 12 | 13 | /* Increase inter-line spacing to improve readability. */ 14 | p, pre, li, dt, dd, table, code, address { line-height: 1.5em; } 15 | 16 | var { font-style: italic; } 17 | 18 | /* Lay out @lisp just like @example. Copied from what /style.css 19 | does for the 'example' class. */ 20 | div.lisp { padding: .8em 1.2em .4em; } 21 | pre.lisp { padding: .8em 1.2em; } 22 | div.lisp, pre.lisp { 23 | margin: 1em 0 1em 3% ; 24 | -webkit-border-radius: .3em; 25 | -moz-border-radius: .3em; 26 | border-radius: .3em; 27 | border: 1px solid #d4cbb6; 28 | background-color: #f2efe4; 29 | } 30 | div.lisp > pre.lisp { 31 | padding: 0 0 .4em; 32 | margin: 0; 33 | border: none; 34 | } 35 | 36 | /* makeinfo 6.7 uses
for navigation links above node 37 | titles. Make those links less prominent. */ 38 | .header { 39 | line-height: 2em; 40 | font-size: 87.5%; 41 | color: #433; 42 | } 43 | 44 | /* In title and node titles, use Fira Sans if available as it is more 45 | pleasant and more compact than Helvetica. */ 46 | .settitle, .top, .chapter, .section, .subsection, .subsubsection { 47 | font-family: Fira Sans, sans; 48 | } 49 | 50 | /* ----- coreutils specific styling ----- */ 51 | 52 | /* layout.css indents "body p" when it should probably only indent "body > p"? 53 | In any case, disable indenting of p in these sub elements. */ 54 | dd p,li p { 55 | margin-left: 0; 56 | margin-right: 0; 57 | } 58 | 59 | /* underlined links are distracting, especially within outlined tables. */ 60 | a { /*add :link for external links*/ 61 | text-decoration: none; /* don't underline links by default */ 62 | outline-style: none; /* don't put dotted box around clicked links */ 63 | } 64 | a:hover { 65 | text-decoration: underline; 66 | } 67 | 68 | body { 69 | /* Make sure the body doesn't become to wide: long lines are hard to 70 | read. */ 71 | max-width: 45em; 72 | } 73 | -------------------------------------------------------------------------------- /docs/reset.css: -------------------------------------------------------------------------------- 1 | /* 2 | Software License Agreement (BSD License) 3 | 4 | Copyright (c) 2006, Yahoo! Inc. 5 | All rights reserved. 6 | 7 | Redistribution and use of this software in source and 8 | binary forms, with or without modification, arepermitted 9 | provided that the following conditions are met: 10 | 11 | * Redistributions of source code must retain the above 12 | copyright notice, this list of conditions and the 13 | following disclaimer. 14 | 15 | * Redistributions in binary form must reproduce the above 16 | copyright notice, this list of conditions and the 17 | following disclaimer in the documentation and/or other 18 | materials provided with the distribution. 19 | 20 | * Neither the name of Yahoo! Inc. nor the names of its 21 | contributors may be used to endorse or promote products 22 | derived from this software without specific prior 23 | written permission of Yahoo! Inc. 24 | 25 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 26 | CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, 27 | INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 28 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 29 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 30 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 31 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 32 | NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 33 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 34 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 35 | IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 36 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 37 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 38 | SUCH DAMAGE. 39 | */ 40 | 41 | html { 42 | color: #000; 43 | background: #FFF; 44 | } 45 | 46 | body, div, dl, dt, dd, ul, ol, li, h1, h2, h3, h4, 47 | h5, h6, pre, code, form, fieldset, legend, input, 48 | button, textarea, p, blockquote, th, td { 49 | margin: 0; 50 | padding: 0; 51 | } 52 | 53 | table { 54 | border-collapse: collapse; 55 | border-spacing: 0; 56 | } 57 | 58 | fieldset, img { 59 | border: 0; 60 | } 61 | 62 | address, caption, cite, code, dfn, em, strong, 63 | th, var, optgroup { 64 | font-style: inherit; 65 | font-weight: inherit; 66 | } 67 | 68 | del, ins { 69 | text-decoration: none; 70 | } 71 | 72 | li { 73 | list-style:none; 74 | } 75 | 76 | caption, th { 77 | text-align: left; 78 | } 79 | 80 | h1, h2, h3, h4, h5, h6 { 81 | font-size: 100%; 82 | font-weight: normal; 83 | } 84 | 85 | q:before, q:after { 86 | content:''; 87 | } 88 | 89 | abbr, acronym { 90 | border: 0; 91 | font-variant: normal; 92 | } 93 | 94 | sup { 95 | vertical-align: baseline; 96 | } 97 | sub { 98 | vertical-align: baseline; 99 | } 100 | 101 | legend { 102 | color: #000; 103 | } 104 | 105 | input, button, textarea, select, optgroup, option { 106 | font-family: inherit; 107 | font-size: inherit; 108 | font-style: inherit; 109 | font-weight: inherit; 110 | } 111 | 112 | input, button, textarea, select { 113 | *font-size: 100%; 114 | } 115 | -------------------------------------------------------------------------------- /lib/jwtcmd.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | 3 | import sys 4 | import jwt 5 | import json 6 | 7 | secret = 'lalala' 8 | algorithm = 'HS256' 9 | 10 | if __name__ == '__main__': 11 | 12 | action = sys.argv[1] 13 | string = sys.argv[2] 14 | 15 | if action == 'encode': 16 | print jwt.encode(json.loads(string), secret, algorithm=algorithm) 17 | elif action == 'decode': 18 | print json.dumps(jwt.decode(string, secret, algorithms=[algorithm])) 19 | else: 20 | raise Exception('Invalid action') 21 | -------------------------------------------------------------------------------- /rest-server-demo.asd: -------------------------------------------------------------------------------- 1 | (defsystem rest-server-demo 2 | :author "Mariano Montone " 3 | :version "0.1" 4 | :maintainer "Mariano Montone " 5 | :licence "MIT" 6 | :description "rest-server demo application" 7 | :long-description "rest-server demo application" 8 | :components 9 | ((:module :demo 10 | :components 11 | ((:file "demo") 12 | (:file "schemas") 13 | (:file "api") 14 | (:file "model") 15 | (:file "implementation")))) 16 | :serial t 17 | :depends-on (:rest-server)) 18 | -------------------------------------------------------------------------------- /rest-server-openapi-demo.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem rest-server-openapi-demo 2 | :author "Mariano Montone " 3 | :version "0.1" 4 | :maintainer "Mariano Montone " 5 | :licence "MIT" 6 | :description "rest-server OpenAPI demo application" 7 | :long-description "rest-server OpenAPI demo application" 8 | :components 9 | ((:module :demo 10 | :components 11 | ((:module :openapi 12 | :components 13 | ((:file "openapi")))))) 14 | :depends-on (:rest-server)) 15 | -------------------------------------------------------------------------------- /rest-server-tests.asd: -------------------------------------------------------------------------------- 1 | (defsystem rest-server-tests 2 | :name "rest-server-tests" 3 | :author "Mariano Montone " 4 | :version "0.1" 5 | :maintainer "Mariano Montone " 6 | :licence " 7 | Copyright (c) 2012 Mariano Montone 8 | 9 | Permission is hereby granted, free of charge, to any person 10 | obtaining a copy of this software and associated documentation 11 | files (the \"Software\"), to deal in the Software without 12 | restriction, including without limitation the rights to use, 13 | copy, modify, merge, publish, distribute, sublicense, and/or 14 | sell copies of the Software, and to permit persons to whom the 15 | Software is furnished to do so, subject to the following 16 | conditions: 17 | 18 | The above copyright notice and this permission notice shall be 19 | included in all copies or substantial portions of the Software. 20 | 21 | THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, 22 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES 23 | OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 24 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 25 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 26 | WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 27 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 28 | OTHER DEALINGS IN THE SOFTWARE." 29 | :description "rest-server tests" 30 | :long-description "rest-server tests" 31 | :components 32 | ((:module :test 33 | :components 34 | ((:file "test") 35 | (:file "api") 36 | (:file "authentication") 37 | #+oauth2(:file "oauth2-api") 38 | #+oauth(:file "oauth")) 39 | :serial t)) 40 | :serial t 41 | :depends-on (:rest-server :fiveam :cl-html5-parser) 42 | :perform (asdf:test-op (o c) 43 | (uiop:symbol-call :rest-server-tests :run-tests))) 44 | -------------------------------------------------------------------------------- /rest-server.asd: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | 3 | (defpackage rest-server-system 4 | (:use :cl :asdf)) 5 | 6 | (in-package :rest-server-system) 7 | 8 | (defsystem rest-server 9 | :name "rest-server" 10 | :author "Mariano Montone " 11 | :version "0.1" 12 | :maintainer "Mariano Montone " 13 | :licence " 14 | Copyright (c) 2012 Mariano Montone 15 | 16 | Permission is hereby granted, free of charge, to any person 17 | obtaining a copy of this software and associated documentation 18 | files (the \"Software\"), to deal in the Software without 19 | restriction, including without limitation the rights to use, 20 | copy, modify, merge, publish, distribute, sublicense, and/or 21 | sell copies of the Software, and to permit persons to whom the 22 | Software is furnished to do so, subject to the following 23 | conditions: 24 | 25 | The above copyright notice and this permission notice shall be 26 | included in all copies or substantial portions of the Software. 27 | 28 | THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, 29 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES 30 | OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 31 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 32 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 33 | WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 34 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 35 | OTHER DEALINGS IN THE SOFTWARE." 36 | :description "REST APIs servers in Common Lisp." 37 | :long-description "REST APIs servers in Common Lisp" 38 | :components 39 | ((:module :src 40 | :components 41 | ((:file "package") 42 | (:file "specials") 43 | (:file "util") 44 | (:file "rest-server") 45 | (:file "mimeparse") 46 | (:file "argument-type") 47 | (:file "serialization") 48 | (:file "xml") 49 | (:file "schema") 50 | (:file "error-handling") 51 | (:file "auth") 52 | (:file "oauth") 53 | (:file "oauth2") 54 | (:file "api") 55 | (:file "resource") 56 | (:file "resource-operation") 57 | (:file "logging") 58 | (:file "caching") 59 | (:file "pagination") 60 | (:file "jwt") 61 | (:file "cors") 62 | (:file "swagger") 63 | (:file "api-documentation") 64 | (:file "openapi")) 65 | :serial t)) 66 | :serial t 67 | :depends-on (:hunchentoot 68 | :alexandria 69 | :log5 70 | :cl-json 71 | :cl-yaml 72 | :cxml 73 | :local-time 74 | :split-sequence 75 | :parse-number 76 | :string-case 77 | :drakma 78 | :cl-who 79 | :ironclad 80 | :babel 81 | :closer-mop 82 | :group-by 83 | :chronicity 84 | :net-telent-date 85 | :md5 86 | :cl-annot 87 | :dynamic-mixins 88 | :generic-serializer 89 | :schemata 90 | :schemata.json-schema 91 | :cl-oauth 92 | :trivial-mimes 93 | :access 94 | :string-case 95 | :cl-algebraic-data-type 96 | #-abcl :trivial-shell) 97 | :in-order-to ((asdf:test-op (asdf:test-op :rest-server-tests)))) 98 | -------------------------------------------------------------------------------- /src/cors.lisp: -------------------------------------------------------------------------------- 1 | (in-package :rest-server) 2 | 3 | (defparameter +cors-default-allow-headers+ 4 | (list "Cache-Control" 5 | "Pragma" 6 | "Origin" 7 | "Authorization" 8 | "Content-Type" 9 | "X-Requested-With")) 10 | 11 | (defparameter +cors-default-allow-methods+ 12 | (list :get :put :post :delete :patch)) 13 | 14 | (defclass cors-mixin () 15 | ((cors-enabled :initarg :cors-enabled 16 | :accessor cors-enabled 17 | :initform t) 18 | (cors-allow-origin :initarg :cors-allow-origin 19 | :accessor cors-allow-origin 20 | :initform "*") 21 | (cors-allow-headers :initarg :cors-allow-headers 22 | :accessor cors-allow-headers 23 | :initform +cors-default-allow-headers+) 24 | (cors-allow-methods :initarg :cors-allow-methods 25 | :accessor cors-allow-methods 26 | :initform +cors-default-allow-methods+))) 27 | 28 | (defun format-cors-allow-headers (headers) 29 | (format nil "~{~A~^, ~}" headers)) 30 | 31 | (defun format-cors-allow-methods (methods) 32 | (format nil "~{~A~^, ~}" (mapcar (alexandria:compose #'string-upcase 33 | #'string) 34 | methods))) 35 | 36 | (defun send-cors-headers (cors) 37 | (when (cors-enabled cors) 38 | (setf (hunchentoot:header-out "Access-Control-Allow-Origin") 39 | (cors-allow-origin cors)) 40 | (setf (hunchentoot:header-out "Access-Control-Allow-Headers") 41 | (format-cors-allow-headers (cors-allow-headers cors))) 42 | (setf (hunchentoot:header-out "Access-Control-Allow-Methods") 43 | (format-cors-allow-methods (cors-allow-methods cors))))) 44 | 45 | (defmethod resource-execute-function-implementation 46 | :after 47 | ((resource cors-mixin) 48 | resource-operation-implementation 49 | request) 50 | (send-cors-headers resource)) 51 | 52 | (defmethod process-api-resource-option ((option (eql :cors)) resource 53 | &key (enabled t) 54 | (allow-origin "*") 55 | (allow-headers +cors-default-allow-headers+) 56 | (allow-methods +cors-default-allow-methods+)) 57 | (dynamic-mixins:ensure-mix resource 'cors-resource) 58 | (setf (cors-enabled resource) enabled) 59 | (setf (cors-allow-origin resource) allow-origin) 60 | (setf (cors-allow-headers resource) allow-headers) 61 | (setf (cors-allow-methods resource) allow-methods)) 62 | 63 | (defclass cors-api (cors-mixin) 64 | ()) 65 | 66 | (defmethod api-execute-function-implementation :after 67 | ((api cors-api) resource-operation-implementation 68 | resource request) 69 | (send-cors-headers api)) 70 | 71 | (defmethod resource-operation-http-options :after 72 | ((api cors-api) resource-operation) 73 | (send-cors-headers api)) 74 | 75 | (defmethod resource-http-options :after 76 | (resource (api cors-api)) 77 | (send-cors-headers api)) 78 | 79 | (defmethod process-api-option ((option (eql :cors)) api 80 | &key 81 | (enabled t) 82 | (allow-origin "*") 83 | (allow-headers +cors-default-allow-headers+) 84 | (allow-methods +cors-default-allow-methods+)) 85 | (dynamic-mixins:ensure-mix api 'cors-api) 86 | (setf (cors-enabled api) enabled) 87 | (setf (cors-allow-origin api) allow-origin) 88 | (setf (cors-allow-headers api) allow-headers) 89 | (setf (cors-allow-methods api) allow-methods)) 90 | -------------------------------------------------------------------------------- /src/flow.lisp: -------------------------------------------------------------------------------- 1 | (in-package :rest-server) 2 | 3 | ;; flow from https://raw.githubusercontent.com/wiki/basho/webmachine/images/http-headers-status-v3.png 4 | 5 | ;; compile flow.dia diagram with this: http://wizard4j.org/pc?action=languageDia 6 | ;; and write the output to flow.xml 7 | 8 | (defparameter *flow-chart-file* (asdf:system-relative-pathname :rest-server "src/flow.xml")) 9 | 10 | (defparameter *flow* 11 | (cxml:parse-file 12 | *flow-chart-file* 13 | (cxml-dom:make-dom-builder))) 14 | 15 | (defun flow-document-parser (document) 16 | `(defun dipatch-api-request (api-acceptor request) 17 | ,(flow-parse-element (dom:document-element document)))) 18 | 19 | (defun child-nodes (element) 20 | (coerce (dom:child-nodes element) 'list)) 21 | 22 | (defun yes-branch (element) 23 | (loop for child in (remove-if-not #'dom:element-p (child-nodes element)) 24 | when (and (equalp (dom:tag-name child) "branch") 25 | (equalp (dom:get-attribute child "name") 26 | "yes")) 27 | do (return-from yes-branch (first (remove-if-not #'dom:element-p (child-nodes child))))) 28 | (error "Yes branch not found ~A" element)) 29 | 30 | (defun no-branch (element) 31 | (loop for child in (remove-if-not #'dom:element-p (child-nodes element)) 32 | when (and (equalp (dom:tag-name child) "branch") 33 | (equalp (dom:get-attribute child "name") 34 | "no")) 35 | do (return-from no-branch (first (remove-if-not #'dom:element-p (child-nodes child))))) 36 | (error "No branch not found ~A" element)) 37 | 38 | (defun flow-parse-element (element) 39 | (format t "parsing ~A~%" element) 40 | (let ((element-name (dom:tag-name element))) 41 | (cond 42 | ((equalp element-name "switch") 43 | (list 'if (list (switch-symbol element)) 44 | (flow-parse-element (yes-branch element)) 45 | (flow-parse-element (no-branch element)))) 46 | ((equalp element-name "info") 47 | (list (info-symbol element))) 48 | ((or (equalp element-name "flowchart") 49 | (equalp element-name "root")) 50 | (flow-parse-element 51 | (first 52 | (remove-if-not #'dom:element-p (child-nodes element))))) 53 | (t (error "~A" element))))) 54 | 55 | (defun info-symbol (element) 56 | (intern (format nil "FLOW-~A" 57 | (json:camel-case-to-lisp (dom:get-attribute element "name"))))) 58 | 59 | (defun switch-symbol (element) 60 | (intern (format nil "FLOW-~A-P" 61 | (json:camel-case-to-lisp (dom:get-attribute element "name"))))) 62 | 63 | (eval (flow-document-parser *flow*)) 64 | -------------------------------------------------------------------------------- /src/jwt.lisp: -------------------------------------------------------------------------------- 1 | (in-package :rest-server) 2 | 3 | (defparameter +python-script+ (asdf:system-relative-pathname 4 | :rest-server 5 | "lib/jwtcmd.py")) 6 | 7 | #-abcl 8 | (defun jwt-encode (json) 9 | (string-trim (list #\space #\newline) 10 | (trivial-shell:shell-command (format nil "python ~A encode '~A'" 11 | +python-script+ 12 | json)))) 13 | 14 | #-abcl 15 | (defun jwt-decode (json &optional (format :alist)) 16 | (let ((decoded-list 17 | (json:decode-json-from-string 18 | (trivial-shell:shell-command (format nil "python ~A decode '~A'" 19 | +python-script+ 20 | json))))) 21 | (ecase format 22 | (:plist (alexandria:alist-plist decoded-list)) 23 | (:alist decoded-list)))) 24 | 25 | #+abcl 26 | (defun jwt-encode (json) 27 | json) 28 | 29 | #+abcl 30 | (defun jwt-decode (json &optional (format :alist)) 31 | (let ((decoded-list (json:decode-json-from-string json))) 32 | (ecase format 33 | (:plist (alexandria:alist-plist decoded-list)) 34 | (:alist decoded-list)))) 35 | -------------------------------------------------------------------------------- /src/oauth.lisp: -------------------------------------------------------------------------------- 1 | (in-package :rest-server) 2 | 3 | (defclass oauth-authentication () 4 | ()) 5 | 6 | (defmethod authenticate ((authentication oauth-authentication) resource-operation) 7 | (handler-case (oauth:validate-access-token) 8 | (error (e) 9 | (princ-to-string e) 10 | (return-from authenticate))) 11 | (funcall resource-operation)) 12 | 13 | (defmacro define-oauth-resource (api-name) 14 | ;; OAuth resource 15 | `(progn 16 | (with-api ,api-name 17 | (define-api-resource oauth 18 | (:documentation "OAuth authentication resource" 19 | :path "/oauth") 20 | (register-oauth-consumer 21 | (:request-method :post 22 | :path "/oauth/register" 23 | :produces (:json) 24 | :documentation "Register a new OAuth consumer") 25 | ()) 26 | (get-oauth-request-token 27 | (:request-method :post 28 | :path "/oauth/token" 29 | :produces (:json) 30 | :documentation "Hand out OAuth request tokens") 31 | (&optional 32 | (scope :list "OAuth scope list"))) 33 | (get-oauth-user-authorization 34 | (:request-method :post 35 | :path "/oauth/authorize" 36 | :produces (:json) 37 | :documentation "Let the user authorize the access token. [6.2.1].") 38 | ()) 39 | (get-oauth-access-token 40 | (:request-method :post 41 | :path "/oauth/access" 42 | :produces (:json) 43 | :documentation "Get an access token from a previously issued and authorized request token.") 44 | ()))) 45 | 46 | ;; Api functions implementation 47 | (implement-resource-operation ,api-name register-oauth-consumer (posted-content) 48 | (let ((token 49 | (oauth:register-token 50 | (oauth:make-consumer-token)))) 51 | (with-output-to-string (json:*json-output*) 52 | (json:with-object () 53 | (json:encode-object-member :key (oauth:token-key token)) 54 | (json:encode-object-member :secret (oauth:token-secret token)) 55 | (json:encode-object-member :user-data (oauth:token-user-data token)) 56 | (json:encode-object-member :last-timestamp (oauth::consumer-token-last-timestamp token)))))) 57 | 58 | (implement-resource-operation ,api-name get-oauth-request-token (posted-content &key scope) 59 | (let ((request-token (oauth:validate-request-token-request))) 60 | (oauth:request-token-response request-token))) 61 | 62 | (implement-resource-operation ,api-name get-oauth-user-authorization (posted-content) 63 | (oauth:protocol-assert (eq (oauth:request-method) :get)) ; [6.2.1] 64 | (let ((request-token (oauth:get-supplied-request-token))) 65 | (when t ; XXX obtain user permission here 66 | (setf (oauth:request-token-authorized-p request-token) t) 67 | ;; now notify the Consumer that the request token has been authorized. 68 | (let ((callback-uri (oauth:request-token-callback-uri request-token))) 69 | (cond 70 | ((eq oauth:*protocol-version* :1.0) 71 | ;; callback uri is optional in 1.0; you might want to employ 72 | ;; some other means to construct it. 73 | (hunchentoot:abort-request-handler "Authorization complete.")) 74 | (t 75 | (oauth:protocol-assert callback-uri) 76 | (hunchentoot:redirect (princ-to-string (oauth:finalize-callback-uri request-token))))))) 77 | ;; only reached when authorization failed 78 | ;; NOTE: optionally notify the Consumer if the user refused authorization. 79 | )) 80 | 81 | (implement-resource-operation ,api-name get-oauth-access-token (posted-content) 82 | (let ((access-token (oauth:validate-access-token-request))) 83 | (princ-to-string access-token))))) 84 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :rest-server 2 | (:nicknames :rs) 3 | (:use :cl) 4 | (:export #:define-api 5 | #:implement-resource-operation 6 | #:configure-resource-operation-implementation 7 | #:configure-api 8 | #:configure-api-resource 9 | #:implement-resource-operation-case 10 | #:set-reply-content-type 11 | #:with-reply-content-type 12 | #:*extract-reply-content-type-from-url* 13 | #:*default-reply-content-type* 14 | #:with-json-reply 15 | #:with-xml-reply 16 | #:with-posted-content 17 | #:with-content 18 | #:find-api 19 | #:find-resource-operation 20 | #:with-api 21 | #:list-api-resources 22 | #:resource 23 | #:resource-name 24 | #:resource-documentation 25 | #:resource-path 26 | #:body-schema 27 | #:define-api-resource 28 | #:with-api-resource 29 | #:list-api-resource-functions 30 | #:define-resource-operation 31 | #:make-resource-operation 32 | #:format-resource-operation-url 33 | #:format-absolute-resource-operation-url 34 | #:with-api-backend 35 | #:start-api 36 | #:stop-api 37 | #:*debug-mode* 38 | #:*server-debug-mode* 39 | #:start-api-documentation 40 | #:api-docs-mixin 41 | #:self-reference 42 | #:with-pagination 43 | #:with-resource 44 | #:let-resource 45 | #:let-resource* 46 | #:with-permission-checking 47 | #:clear-cache 48 | #:&posted-content 49 | #:&resource-operation 50 | #:*signal-client-function-errors* 51 | #:with-signal-client-function-errors 52 | #:encode-file-data-uri-scheme 53 | ;; Decorations 54 | #:caching 55 | #:fetch-content 56 | #:permission-checking 57 | #:cors-api 58 | #:cors-resource)) 59 | 60 | (defpackage #:rest-server.logging 61 | (:nicknames #:rs.log) 62 | (:use :cl :rest-server) 63 | (:export #:start-api-logging 64 | #:stop-api-logging 65 | #:enable-api-logging 66 | #:disable-api-logging 67 | #:api-log-for 68 | #:logging-api 69 | #:logging 70 | #:logging-enabled)) 71 | 72 | (defpackage #:rest-server.error 73 | (:nicknames #:rs.error) 74 | (:use #:cl #:rest-server :generic-serializer) 75 | (:export 76 | #:*catch-errors* 77 | #:*server-catch-errors* 78 | #:http-error 79 | #:http-not-found-error 80 | #:http-internal-server-error 81 | #:http-authorization-required-error 82 | #:http-forbidden-error 83 | #:http-not-acceptable-error 84 | #:http-unsupported-media-type-error 85 | #:http-bad-request 86 | #:http-method-not-allowed-error 87 | #:error-handling 88 | #:with-error-handler)) 89 | 90 | (defpackage #:rest-server.auth 91 | (:nicknames #:rs.auth) 92 | (:use #:cl #:rest-server) 93 | (:export 94 | #:authorization 95 | #:oauth2-authorization 96 | #:token-authorization 97 | #:*auth* 98 | #:authorize 99 | #:auth-result 100 | #:auth-success 101 | #:auth-not-present 102 | #:auth-fail)) 103 | -------------------------------------------------------------------------------- /src/rest-server.lisp: -------------------------------------------------------------------------------- 1 | (in-package :rest-server) 2 | 3 | (defparameter *resource-operation* nil "The current resource operation") 4 | 5 | (log5:defcategory rest-server) 6 | 7 | (defparameter *signal-client-function-errors* t "When t, signal an exception in an error ocurrs in an api client function") 8 | 9 | (defun call-with-signal-client-function-errors (signal-p function) 10 | (let ((*signal-client-function-errors* signal-p)) 11 | (funcall function))) 12 | 13 | (defmacro with-signal-client-function-errors ((&optional signal-p '*signal-client-function-errors*) 14 | &body body) 15 | `(call-with-signal-client-function-errors ,signal-p (lambda () ,@body))) 16 | 17 | (defmacro with-content ((&key (setter ':=)) &body body) 18 | "Macro to build HTTP content to pass in client functions. 19 | 20 | Example: 21 | 22 | (with-api-backend *api-backend* 23 | (let ((content (with-content () 24 | (:= :name \"name\") 25 | (when some-condition 26 | (:= :attr 22))))) 27 | (app.api-client:my-client-function :content content))) 28 | " 29 | (alexandria:with-unique-names (content) 30 | `(let ((,content '())) 31 | (flet ((,setter (key value) 32 | (push (cons key value) ,content))) 33 | ,@body 34 | ,content)))) 35 | -------------------------------------------------------------------------------- /src/schema.lisp: -------------------------------------------------------------------------------- 1 | (in-package :rest-server) 2 | 3 | ;; Validation 4 | 5 | (defclass validation-resource-operation-implementation-decoration 6 | (rs::resource-operation-implementation-decoration) 7 | ((schema :initarg :schema 8 | :accessor validation-schema 9 | :initform (error "Provide the validation schema")) 10 | (format :initarg :format 11 | :accessor validation-format 12 | :initform :json)) 13 | (:metaclass closer-mop:funcallable-standard-class)) 14 | 15 | (defmethod rs::process-resource-operation-implementation-option 16 | ((option (eql :validation)) 17 | resource-operation-implementation 18 | &key (enabled t) 19 | (schema (error "Provide the validation schema")) 20 | (format :json) 21 | #+(or abcl ecl) &allow-other-keys) 22 | (if enabled 23 | (make-instance 'validation-resource-operation-implementation-decoration 24 | :schema schema 25 | :format format 26 | :decorates resource-operation-implementation) 27 | resource-operation-implementation)) 28 | 29 | (defmethod rs::execute :around ((decoration validation-resource-operation-implementation-decoration) 30 | &rest args) 31 | (let ((posted-content (first args))) ;; Asume the posted content is in the first argument 32 | (let ((valid-p (schemata:validate-with-schema (validation-schema decoration) 33 | posted-content))) 34 | (if (not valid-p) 35 | (error "The posted content is invalid") 36 | (call-next-method))))) 37 | 38 | (cl-annot:defannotation validation (args resource-operation-implementation) 39 | (:arity 2) 40 | `(rs::configure-resource-operation-implementation 41 | (rs::name (rs::resource-operation ,resource-operation-implementation)) 42 | (list :validation ,@args))) 43 | 44 | ;; Unserialization 45 | 46 | (defclass unserialization-resource-operation-implementation-decoration 47 | (resource-operation-implementation-decoration) 48 | ((schema :initarg :schema 49 | :accessor unserialization-schema 50 | :initform (error "Provide the unserialization schema")) 51 | (format :initarg :format 52 | :accessor unserialization-format 53 | :initform :json)) 54 | (:metaclass closer-mop:funcallable-standard-class)) 55 | 56 | (defmethod rs::process-resource-operation-implementation-option 57 | ((option (eql :unserialization)) 58 | resource-operation-implementation 59 | &key (enabled t) 60 | (schema (error "Provide the unserialization schema")) 61 | (format :json) 62 | #+(or abcl ecl) &allow-other-keys) 63 | (if enabled 64 | (make-instance 'unserialization-resource-operation-implementation-decoration 65 | :schema schema 66 | :format format 67 | :decorates resource-operation-implementation) 68 | resource-operation-implementation)) 69 | 70 | (defmethod rs::execute :around ((decoration unserialization-resource-operation-implementation-decoration) 71 | &rest args) 72 | (let ((posted-content (first args))) ;; Asume the posted content is in the first argument 73 | (apply #'call-next-method 74 | (schemata:unserialize-with-schema (unserialization-schema decoration) 75 | posted-content 76 | (unserialization-format decoration)) 77 | (rest args)))) 78 | 79 | (cl-annot:defannotation unserialization (args resource-operation-implementation) 80 | (:arity 2) 81 | `(rs::configure-resource-operation-implementation 82 | (rs::name (rs::resource-operation ,resource-operation-implementation)) 83 | (list :unserialization ,@args))) 84 | -------------------------------------------------------------------------------- /src/serialization.lisp: -------------------------------------------------------------------------------- 1 | (in-package :rest-server) 2 | 3 | (defun accept-serializer () 4 | (let ((content-type (rs::request-reply-content-type hunchentoot:*request*))) 5 | (or (and content-type 6 | (let ((accepts (mimeparse:best-match 7 | (list "text/lisp" 8 | "text/xml" 9 | "application/xml" 10 | "text/html" 11 | "application/json") 12 | content-type))) 13 | (string-case:string-case (accepts :default generic-serializer:*default-serializer*) 14 | ("text/xml" :xml) 15 | ("application/xml" :xml) 16 | ("text/html" :html) 17 | ("application/json" :json) 18 | ("text/lisp" :sexp)))) 19 | generic-serializer:*default-serializer*))) 20 | 21 | ;; Plugging 22 | 23 | (defclass serialization-resource-operation-implementation-decoration 24 | (rs::resource-operation-implementation-decoration) 25 | ((streamed :initarg :streamed 26 | :accessor streamed-p 27 | :initform nil 28 | :documentation "If the content is serialized with the streaming api")) 29 | (:metaclass closer-mop:funcallable-standard-class)) 30 | 31 | (defmethod rs::process-resource-operation-implementation-option 32 | ((option (eql :serialization)) 33 | resource-operation-implementation 34 | &key enabled streamed) 35 | (if enabled 36 | (make-instance 'serialization-resource-operation-implementation-decoration 37 | :decorates resource-operation-implementation 38 | :streamed streamed) 39 | resource-operation-implementation)) 40 | 41 | (defmethod rs::execute :around ((decoration serialization-resource-operation-implementation-decoration) 42 | &rest args) 43 | (declare (ignore args)) 44 | (let ((serializer (accept-serializer))) 45 | (set-reply-content-type (generic-serializer::serializer-content-type serializer)) 46 | (with-output-to-string (s) 47 | (generic-serializer:with-serializer-output s 48 | (generic-serializer:with-serializer serializer 49 | (if (streamed-p decoration) 50 | (call-next-method) 51 | (generic-serializer:serialize 52 | (call-next-method) 53 | generic-serializer::*serializer* 54 | s))))))) 55 | 56 | (cl-annot:defannotation serialization (args resource-operation-implementation) 57 | (:arity 2) 58 | `(rs::configure-resource-operation-implementation 59 | (rs::name (rs::resource-operation ,resource-operation-implementation)) 60 | (list :serialization ,@args))) 61 | -------------------------------------------------------------------------------- /src/specials.lisp: -------------------------------------------------------------------------------- 1 | (in-package :rest-server) 2 | 3 | (defvar *debug-mode* nil "If true, then error messages contain backtraces, etc") 4 | 5 | (defvar *server-debug-mode*) 6 | 7 | (defparameter *apis* (make-hash-table :test #'equalp) 8 | "Global hashtable containing the apis defined") 9 | 10 | (defparameter *api* nil "The current api") 11 | 12 | (defvar *rest-server-proxy* nil) 13 | 14 | (defparameter *register-api-resource* t "Wether to register the created resource in the current API") 15 | (defparameter *api-resource* nil "The current api resource") 16 | 17 | (defvar *register-resource-operation* t 18 | "Whether to try to register the resource operation on creation. Bind to nil to prevent that") 19 | 20 | (defparameter *text-content-types* (list :json :xml :lisp)) 21 | 22 | (defparameter *default-reply-content-type* "application/json") 23 | 24 | (defparameter *extract-reply-content-type-from-url* nil "If true, extracts the request content-type from the url when available. For example: GET /users/1.json") 25 | -------------------------------------------------------------------------------- /src/xml.lisp: -------------------------------------------------------------------------------- 1 | (in-package :rest-server) 2 | 3 | (defun make-xmls-builder (&key (include-default-values t) 4 | (include-namespace-uri t)) 5 | "Make a XMLS style builder. When 'include-namespace-uri is true a modified 6 | XMLS tree is generated that includes the element namespace URI rather than 7 | the qualified name prefix and also includes the namespace URI for attributes." 8 | (make-instance 'xmls-builder 9 | :include-default-values include-default-values 10 | :include-namespace-uri include-namespace-uri)) 11 | 12 | 13 | (defclass xmls-builder (cxml-xmls::xmls-builder) 14 | ()) 15 | 16 | (defun make-node (&key name ns attrs children) 17 | (declare (ignore ns attrs)) 18 | (cons name 19 | children)) 20 | 21 | (defun node-children (node) 22 | (cdr node)) 23 | 24 | (defun (setf node-children) (newval node) 25 | (setf (cdr node) newval)) 26 | 27 | (defmethod sax:start-element 28 | ((handler xmls-builder) namespace-uri local-name qname attributes) 29 | (let* ((include-default-values (cxml-xmls::include-default-values handler)) 30 | (include-namespace-uri (cxml-xmls::include-namespace-uri handler)) 31 | (attributes 32 | (loop 33 | for attr in attributes 34 | for attr-namespace-uri = (sax:attribute-namespace-uri attr) 35 | for attr-local-name = (sax:attribute-local-name attr) 36 | when (and (or (sax:attribute-specified-p attr) 37 | include-default-values) 38 | #+(or) 39 | (or (not include-namespace-uri) 40 | (not attr-namespace-uri) 41 | attr-local-name)) 42 | collect 43 | (list (cond (include-namespace-uri 44 | (cond (attr-namespace-uri 45 | (cons attr-local-name attr-namespace-uri)) 46 | (t 47 | (sax:attribute-qname attr)))) 48 | (t 49 | (sax:attribute-qname attr))) 50 | (sax:attribute-value attr)))) 51 | (namespace (when include-namespace-uri namespace-uri)) 52 | (node (make-node :name local-name 53 | :ns namespace 54 | :attrs attributes)) 55 | (parent (car (cxml-xmls::element-stack handler)))) 56 | (if parent 57 | (push node (node-children parent)) 58 | (setf (cxml-xmls::root handler) node)) 59 | (push node (cxml-xmls::element-stack handler)))) 60 | 61 | (defmethod sax:end-element 62 | ((handler xmls-builder) namespace-uri local-name qname) 63 | (declare (ignore namespace-uri local-name qname)) 64 | (let ((node (pop (cxml-xmls::element-stack handler)))) 65 | (setf (node-children node) (reverse (node-children node))))) 66 | 67 | (defmethod sax:characters ((handler xmls-builder) data) 68 | (let* ((parent (car (cxml-xmls::element-stack handler))) 69 | (prev (car (node-children parent)))) 70 | ;; Be careful to accept both rods and strings here, so that xmls can be 71 | ;; used with strings even if cxml is configured to use octet string rods. 72 | (if (typep prev '(or cxml-xmls::rod string)) 73 | ;; um entities herum wird SAX:CHARACTERS mehrfach aufgerufen fuer 74 | ;; den gleichen Textknoten. Hier muessen wir den bestehenden Knoten 75 | ;; erweitern, sonst ist das Dokument nicht normalisiert. 76 | ;; (XXX Oder sollte man besser den Parser entsprechend aendern?) 77 | (setf (car (node-children parent)) 78 | (concatenate `(vector ,(array-element-type prev)) 79 | prev 80 | data)) 81 | (push data (node-children parent))))) 82 | -------------------------------------------------------------------------------- /test/TODO.txt: -------------------------------------------------------------------------------- 1 | * Use something other than fiveam for testing, so that it is possible run :before and :after suite code (maybe port to stefil?) 2 | -------------------------------------------------------------------------------- /test/decorations.lisp: -------------------------------------------------------------------------------- 1 | (in-package :rest-server-tests) 2 | 3 | (define-api decorated-api () 4 | (:title "Decorated" 5 | :documentation "This is a decorated api") 6 | (decorations (:produces (:json) 7 | :consumes (:json) 8 | :documentation "Decorations test" 9 | :path "/decorations") 10 | (simple-decoration (:produces (:json) 11 | :consumes (:json) 12 | :documentation "Decorations test" 13 | :path "/decorations/simple-decoration") 14 | ()))) 15 | 16 | (implement-resource-operation decorated-api simple-decoration () 17 | "hello") 18 | 19 | (defclass simple-api-decoration (rs::api-definition) 20 | ()) 21 | 22 | (defmethod rs::api-execute-function-implementation :around 23 | ((api-definition simple-api-decoration) 24 | resource-operation-implementation 25 | resource 26 | request) 27 | (let ((reply (call-next-method))) 28 | (format nil "~A" reply))) 29 | 30 | (defmethod rs::process-api-option 31 | ((option-name (eql :simple-decoration)) 32 | api &rest args) 33 | (declare (ignorable args)) 34 | (dynamic-mixins:ensure-mix api 'simple-api-decoration)) 35 | 36 | (rs::configure-api 'decorated-api '(:simple-decoration)) 37 | 38 | (find-api 'decorated-api) 39 | 40 | (start-api 'decorated-api :port 8085 :access-log-destination nil) 41 | 42 | (drakma:http-request "http://localhost:8085/decorations/simple-decoration") 43 | 44 | (rs::configure-api 'decorated-api '(:swagger)) 45 | 46 | (drakma:http-request "http://localhost:8085/decorations/simple-decoration") 47 | 48 | (defclass simple-resource-decoration () 49 | ()) 50 | 51 | (defmethod rs::process-api-resource-option ((option (eql :simple-decoration)) resource &rest args) 52 | (declare (ignorable args)) 53 | (dynamic-mixins:ensure-mix resource 'simple-resource-decoration)) 54 | 55 | (defmethod rs::resource-execute-function-implementation :around 56 | ((resource simple-resource-decoration) 57 | resource-operation-implementation 58 | request) 59 | (let ((reply (call-next-method))) 60 | (format nil "~A" reply))) 61 | 62 | (rs::configure-api-resource 'decorated-api 'decorations '(:simple-decoration)) 63 | 64 | (drakma:http-request "http://localhost:8085/decorations/simple-decoration") 65 | -------------------------------------------------------------------------------- /test/oauth.lisp: -------------------------------------------------------------------------------- 1 | (in-package :rest-server-tests) 2 | 3 | (in-suite rest-server-tests) 4 | 5 | ;; OAuth API tests 6 | 7 | (defpackage :oauth-test 8 | (:use :rest-server :cl)) 9 | 10 | (in-package :oauth-test) 11 | 12 | (eval-when (:compile-toplevel :load-toplevel :execute) 13 | (define-api oauth-api () 14 | (:title "Api test" 15 | :documentation "This is an api test") 16 | (resource (:produces (:json :xml) 17 | :consumes (:json) 18 | :documentation "Protected resource" 19 | :path "/resource" 20 | :authorizations (:token :oauth)) 21 | (get-resource (:request-method :get 22 | :produces (:json) 23 | :path "/resource" 24 | :documentation "Access a protected resource" 25 | :authorizations (:oauth)) 26 | ())))) 27 | 28 | (implement-resource-operation oauth-api get-resource () 29 | "You have accessed the resource!!") 30 | 31 | (rs::define-oauth-resource oauth-api) 32 | 33 | (in-package :rest-server-tests) 34 | 35 | (defparameter *acceptor* 36 | (start-api 'oauth-test::oauth-api :port 8187 37 | :catch-errors t 38 | :access-log-destination nil 39 | :config 40 | '(:logging :enabled nil))) 41 | 42 | (stop-api *acceptor*) 43 | 44 | (drakma:http-request "http://localhost:8187/oauth/register") 45 | 46 | (drakma:http-request "http://localhost:8187/oauth/token?scope=lala") 47 | 48 | (drakma:http-request "http://localhost:8187/resource") 49 | -------------------------------------------------------------------------------- /test/test.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :rest-server-tests 2 | (:use 3 | :cl 4 | :rest-server 5 | :fiveam 6 | :rest-server.logging 7 | :generic-serializer) 8 | (:export :run-tests :debug-tests)) 9 | 10 | (defpackage :api-test 11 | (:use 12 | :rest-server 13 | :rest-server.logging 14 | :rest-server.error 15 | :cl 16 | :generic-serializer)) 17 | 18 | (in-package :rest-server-tests) 19 | 20 | (def-suite rest-server-tests :description "rest-server system tests") 21 | 22 | (defvar *api-acceptor*) 23 | 24 | (def-fixture api-fixture () 25 | (let ((*api-acceptor* (start-api 'api-test::api-test :port 8181 26 | :access-log-destination nil))) 27 | (rs::with-text-content-types 28 | (&body)) 29 | (stop-api *api-acceptor*))) 30 | 31 | (defvar *auth-api*) 32 | 33 | (def-fixture auth-api-fixture () 34 | (let ((*auth-api* (start-api 'auth-api-test :port 8182 35 | :access-log-destination nil))) 36 | (rs::with-text-content-types 37 | (&body)) 38 | (stop-api *auth-api*))) 39 | 40 | (defmacro deftest (name &body body) 41 | `(test (,name :compile-at :definition-time) 42 | ,@body)) 43 | 44 | (defun run-tests () 45 | (with-fixture api-fixture () 46 | (with-fixture auth-api-fixture () 47 | (run! 'rest-server-tests)))) 48 | 49 | (defun debug-tests () 50 | (with-fixture api-fixture () 51 | (with-fixture auth-api-fixture () 52 | (debug! 'rest-server-tests)))) 53 | 54 | (in-suite rest-server-tests) 55 | --------------------------------------------------------------------------------