├── .gitignore ├── .travis.yml ├── CHANGES.md ├── CONTRIBUTING.md ├── LICENSE ├── README.md ├── dev-src └── example │ ├── api.clj │ ├── client.clj │ ├── cqrs.clj │ ├── github │ ├── client.clj │ ├── github.clj │ └── security.clj │ ├── handlers.clj │ ├── http.clj │ ├── io.clj │ ├── io2.clj │ ├── kebab.clj │ ├── math.clj │ └── security.clj ├── doc └── cljdoc.edn ├── examples ├── component │ ├── .gitignore │ ├── README.md │ ├── project.clj │ └── src │ │ ├── sample │ │ ├── handler.clj │ │ ├── main.clj │ │ └── system.clj │ │ └── user.clj └── hello-world │ ├── .gitignore │ ├── README.md │ ├── project.clj │ └── src │ └── sample │ └── handler.clj ├── modules ├── kekkonen-core │ ├── project.clj │ └── src │ │ └── kekkonen │ │ ├── api.clj │ │ ├── client │ │ └── cqrs.clj │ │ ├── common.clj │ │ ├── core.clj │ │ ├── cqrs.clj │ │ ├── http.clj │ │ ├── impl │ │ └── logging.clj │ │ ├── interceptor.clj │ │ ├── middleware.clj │ │ ├── ring.clj │ │ ├── swagger.clj │ │ └── upload.clj └── kekkonen │ └── project.clj ├── project.clj ├── scripts ├── lein-modules └── set-version └── test └── kekkonen ├── api_test.clj ├── common_test.clj ├── core_test.clj ├── cqrs_test.clj ├── http_test.clj ├── interceptor_test.clj ├── middleware_test.clj ├── midje.clj ├── perf.clj ├── ring_test.clj ├── swagger_test.clj └── upload_test.clj /.gitignore: -------------------------------------------------------------------------------- 1 | target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | .project 11 | .settings 12 | bower_components 13 | *.log 14 | /kekkonen.iml 15 | /.idea 16 | .classpath 17 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | language: clojure 3 | lein: 2.8.1 4 | install: 5 | - ./scripts/lein-modules install 6 | - lein deps 7 | script: 8 | - lein with-profile $PROFILE do clean, midje, check 9 | # JDKs to use: 8 for legacy and 13 as the latest release 10 | jdk: 11 | - openjdk8 12 | - openjdk13 13 | # Clojure: 1.8 for legacy and 1.10 as the latest release 14 | env: 15 | - PROFILE=dev 16 | - PROFILE=dev,1.8 17 | cache: 18 | directories: 19 | - $HOME/.m2 20 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## Unreleased 2 | 3 | ## 0.5.2 (2019-11-01) 4 | 5 | * Add the missing clj-yaml dependency. 6 | 7 | ## 0.5.1 (2019-11-01) 8 | 9 | * Remove the dependency on `ring-middleware-format`, for real this time. 10 | 11 | ## 0.5.0 (2019-11-01) 12 | 13 | * Make Kekkonen compatible with Cloverage. 14 | * Update dependencies to support Java 13 by [Vadim Liventsev](https://github.com/vadim0x60). 15 | * Fix returning byte arrays with `kekkonen.upload/response` 16 | 17 | ## 0.4.0 (21.6.2017) 18 | 19 | * **BREAKING**: Drops Java 1.6 Compatability (due to Muuntaja) 20 | * **BREAKING**: use [Muuntaja](https://github.com/metosin/muuntaja) instead of [ring-middleware-format](https://github.com/ngrunwald/ring-middleware-format), [#255](https://github.com/metosin/compojure-api/pull/255) 21 | for format negotiation, encoding and decoding. 22 | - ?x more throughput on 1k JSON request-response echo 23 | - api options `[:mw :format]` has been deprecated (fails at api creation time), use `:formats` instead. It consumes either a 24 | Muuntaja instance, Muuntaja options map or `::kekkonen.middleware/defaults` (for defaults). See [how to configure Muuntaja](https://github.com/metosin/muuntaja/wiki/Configuration) how to use. 25 | 26 | * Updated deps: 27 | 28 | ```clj 29 | [clj-http "2.3.0"] is available but we use "2.2.0" 30 | [metosin/muuntaja "0.3.1"] is available but we use "0.3.0" 31 | [metosin/ring-http-response "0.9.0"] is available but we use "0.8.1" 32 | [metosin/ring-swagger "0.24.0"] is available but we use "0.23.0" 33 | [metosin/ring-swagger-ui "2.2.10"] is available but we use "2.2.8" 34 | [prismatic/plumbing "0.5.4"] is available but we use "0.5.3" 35 | [prismatic/schema "1.1.6"] is available but we use "1.1.3" 36 | [ring-middleware-format "0.7.2"] is available but we use "0.7.0" 37 | [ring/ring-defaults "0.3.0"] is available but we use "0.2.1" 38 | ``` 39 | 40 | * Removed deps: 41 | 42 | ```clj 43 | [ring-middleware-format "0.7.0"] 44 | ``` 45 | 46 | ## 0.3.4 (11.1.2017) 47 | 48 | * Updated dependencies to [avoid a path traversal vulnerability](https://groups.google.com/forum/#!topic/clojure/YDrKBV26rnA) in Ring. 49 | 50 | ```clj 51 | [frankiesardo/linked "1.2.9"] is available but we use "1.2.8" 52 | [metosin/ring-swagger "0.22.14"] is available but we use "0.22.10" 53 | [metosin/ring-swagger-ui "2.2.8"] is available but we use "2.2.2-0" 54 | [metosin/ring-http-response "0.8.1"] is available but we use "0.8.0" 55 | ``` 56 | 57 | ## 0.3.3 (29.8.2016) 58 | 59 | * Ring-coercion is applied also for `:default`, fixes [#45](https://github.com/metosin/kekkonen/issues/45) 60 | 61 | * updated dependencies: 62 | 63 | ```clj 64 | [prismatic/schema "1.1.3"] is available but we use "1.1.2" 65 | [metosin/ring-swagger "0.22.10"] is available but we use "0.22.9" 66 | [metosin/ring-swagger-ui "2.2.2-0"] is available but we use "2.1.4-0" 67 | [frankiesardo/linked "1.2.8"] is available but we use "1.2.6" 68 | ``` 69 | 70 | ## 0.3.2 (1.7.2016) 71 | 72 | * `kekkonen.upload/response` for easy returning of file-respones (uploads still Alpha) 73 | 74 | * updated dependencies: 75 | 76 | ```clj 77 | [metosin/ring-http-response "0.8.0"] is available but we use "0.7.0" 78 | [ring/ring-defaults "0.2.1"] 79 | ``` 80 | 81 | ## 0.3.1 (28.6.2016) 82 | 83 | * Alpha support for (ring-based) file uploads 84 | * `kekkonen.upload/multipart-params` interceptor, uses `ring.middleware.multipart-params/multipart-params-request` (same options) 85 | * `kekkonen.upload/TempFileUpload` & `kekkonen.upload/ByteArrayUpload` as swagger-aware types 86 | * `:kekkonen.ring/consumes` & `:kekkonen.ring/produces` - meta-data, just for docs now 87 | 88 | ```clj 89 | (defnk upload 90 | "upload a file to the server" 91 | {:interceptors [[upload/multipart-params]] 92 | :type ::ring/handler 93 | ::ring/method :put 94 | ::ring/consumes ["multipart/form-data"]} 95 | [[:request [:multipart-params file :- upload/TempFileUpload]]] 96 | (ok (dissoc file :tempfile))) 97 | 98 | (def app 99 | (api 100 | {:swagger {:ui "/api-docs" 101 | :spec "/swagger.json"} 102 | :api {:handlers {:http #'upload}}})) 103 | ``` 104 | 105 | ## 0.3.0 (27.6.2016) 106 | 107 | * **BREAKING**: Removed type-level interceptors from ring-adapter, use normal interceptors instead. 108 | * **BREAKING**: Ring request-parameters are now assoc-in'd (into `:data`) instead of deep-merging. For speed. 109 | * Handlers can be now be mounted to dispatcher root. 110 | * Removed `kekkonen.core/simple-coercion`, renamed `multi-coercion` to `coercion`. 111 | * Support for Context-based urls, thanks to [Wout Neirynck](https://github.com/wneirynck). 112 | * Data input schemas for apis can be vectors, fixes [#27](https://github.com/metosin/kekkonen/issues/27). 113 | * Use Pedestal-style interceptors, with `:name`, `:enter`, `:leave` and `:error` 114 | * Extended to contain `:input` and `:output` schemas. 115 | * Exceptions raised in the interceptor chain are rethrown as wrapped (Pedestal) exceptions, 116 | containing extra meta-data of the failed step: `:execution-id`, `:stage`, `:interceptor`, `:exception-type` and `:exception`. 117 | * extra fields are removed in the api exception handling 118 | * `kekkonen.core/request` & `kekkonen.core/response` exception handeled gracefully with the `api`s 119 | * Createing an `api` doesn't force schema validation by default 120 | * Interceptors are pre-compiled into Records in all layers for simplicity and better perf. 121 | * Remove the following excess meta-data from handlers: 122 | * `:ns-meta`, `:all-meta`, `:handler-input` & `:user-input` 123 | * Remove `:interceptors` from the `Dispatcher`, as they are now precompiled into handlers 124 | * Interceptors can be `nil`, allowing conditional interceptors 125 | 126 | ```clj 127 | (k/handler 128 | {:name "fixture!" 129 | :interceptors [[require-role :admin] (if-not env/dev-mode? log-it)] 130 | :handle (fn [ctx] ...)}) 131 | ``` 132 | 133 | * **BREAKING**: top-level swagger options are now in align to the compojure-api: 134 | * Fixes [#22](https://github.com/metosin/kekkonen/issues/22) 135 | * By default, `api`s don't bind swagger-spec & swagger-ui, use `:spec` & `:ui` options 136 | 137 | ### Old 138 | 139 | ```clj 140 | {:swagger {:info {:title "Kekkonen"}} 141 | :swagger-ui {:jsonEdit true}}) 142 | ``` 143 | 144 | ### New 145 | 146 | ```clj 147 | {:swagger 148 | {:spec "/swagger.json" 149 | :ui "/api-docs" 150 | :options {:ui {:jsonEdit true} 151 | :spec {:ignore-missing-mappings? false}} 152 | :data {:info {:title "Kekkonen"}}}} 153 | ``` 154 | 155 | * **BREAKING**: Handler dispatch function is now `:handle` instead of `:function` 156 | * Handlers can be defined via a single map with `:handle` key for the dispatch 157 | 158 | ```clj 159 | (k/handler 160 | {:name "hello" 161 | :handle (constantly "hello")}) 162 | ``` 163 | 164 | * updated dependencies: 165 | 166 | ```clj 167 | [prismatic/schema "1.1.2"] is available but we use "1.1.0" 168 | [prismatic/plumbing "0.5.3"] is available but we use "0.5.2" 169 | [metosin/ring-http-response "0.7.0"] is available but we use "0.6.5" 170 | [metosin/ring-swagger "0.22.9"] is available but we use "0.22.6" 171 | [clj-http "2.2.0"] available but we use "2.1.0" 172 | ``` 173 | 174 | ## 0.2.0 (29.3.2016) 175 | 176 | **[compare](https://github.com/metosin/kekkonen/compare/0.1.2...0.2.0)** 177 | 178 | * Change Transformers to (initial version of) Interceptors in both the Dispatcher & Ring. 179 | * `:transformers`-key is replaced with `:interceptors` 180 | * Interceptors are either functions `context => context` (just like the old transformers) or maps 181 | with keys `:enter` and `:leave`. Will be later merged to use the [Pedestal](http://pedestal.io/) defined 182 | interceptors. 183 | * User defined context-handers are now under `:meta` instead of `:user`. 184 | * Defined `:meta` keys are checked at dispatcher creation time. 185 | * By default, dispatcher will have a `:interceptors` meta-key registered. 186 | * It takes an vector of interceptors as value, applied first to the namespace/handler 187 | * Ring-adapter interceptors can use the dispatcher context, fixes [#26](https://github.com/metosin/kekkonen/issues/26) 188 | 189 | #### Old syntax 190 | 191 | ```clj 192 | (cqrs-api 193 | {:swagger {:info {:title "Kekkonen"}} 194 | :core {:handlers {:api {:math 'math 195 | :system [#'ping #'pong]}} 196 | :transformers [log-commands] 197 | :user {::roles require-roles}} 198 | :ring {:transformers [api-key-authenticator]}}) 199 | ``` 200 | 201 | #### New syntax 202 | 203 | ```clj 204 | (cqrs-api 205 | {:swagger {:info {:title "Kekkonen"}} 206 | :core {:handlers {:api {:math 'math 207 | :system [#'ping #'pong]}} 208 | :interceptors [log-commands] 209 | :meta {::roles require-roles}} 210 | :ring {:interceptors [api-key-authenticator]}}) 211 | ``` 212 | 213 | * Updated dependencies 214 | 215 | ```clj 216 | [prismatic/schema "1.1.0"] is available but we use "1.0.4" 217 | [metosin/ring-swagger "0.22.6"] is available but we use "0.22.1" 218 | [metosin/ring-swagger-ui "2.1.4-0"] is available but we use "2.1.3-4" 219 | [clj-http "2.1.0"] is available but we use "2.0.0" 220 | ``` 221 | 222 | ## 0.1.2 (30.12.2015) 223 | 224 | * Fix client using wrong keywords [#16](https://github.com/metosin/kekkonen/pull/16) 225 | * Deterministic order for user annotations [#15](https://github.com/metosin/kekkonen/pull/15) 226 | 227 | ```clj 228 | [prismatic/schema "1.0.4"] is available but we use "1.0.3" 229 | [metosin/ring-swagger "0.22.1"] is available but we use "0.22.0" 230 | [metosin/ring-swagger-ui "2.1.3-4"] is available but we use "2.1.3-2" 231 | ``` 232 | 233 | ## 0.1.1 (25.11.2015) 234 | 235 | - Fix Transit format options 236 | 237 | ## 0.1.0 (10.11.2015) 238 | 239 | - Initial public version 240 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # How to contribute 2 | 3 | Contributions are welcome. 4 | 5 | Please file bug reports and feature requests to https://github.com/metosin/kekkonen/issues. 6 | 7 | ## Making changes 8 | 9 | * Fork the repository on Github 10 | * Create a topic branch from where you want to base your work (usually the master branch) 11 | * Check the formatting rules from existing code (no trailing whitepace, mostly default indentation) 12 | * Ensure any new code is well-tested, and if possible, any issue fixed is covered by one or more new tests 13 | * Verify that all tests pass using ```lein midje``` 14 | * Push your code to your fork of the repository 15 | * Make a Pull Request 16 | 17 | ## Commit messages 18 | 19 | 1. Separate subject from body with a blank line 20 | 2. Limit the subject line to 50 characters 21 | 3. Capitalize the subject line 22 | 4. Do not end the subject line with a period 23 | 5. Use the imperative mood in the subject line 24 | - "Add x", "Fix y", "Support z", "Remove x" 25 | 6. Wrap the body at 72 characters 26 | 7. Use the body to explain what and why vs. how 27 | 28 | For comprehensive explanation read this [post by Chris Beams](http://chris.beams.io/posts/git-commit/#seven-rules). 29 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Eclipse Public License - v 2.0 2 | 3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE 4 | PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION 5 | OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 6 | 7 | 1. DEFINITIONS 8 | 9 | "Contribution" means: 10 | 11 | a) in the case of the initial Contributor, the initial content 12 | Distributed under this Agreement, and 13 | 14 | b) in the case of each subsequent Contributor: 15 | i) changes to the Program, and 16 | ii) additions to the Program; 17 | where such changes and/or additions to the Program originate from 18 | and are Distributed by that particular Contributor. A Contribution 19 | "originates" from a Contributor if it was added to the Program by 20 | such Contributor itself or anyone acting on such Contributor's behalf. 21 | Contributions do not include changes or additions to the Program that 22 | are not Modified Works. 23 | 24 | "Contributor" means any person or entity that Distributes the Program. 25 | 26 | "Licensed Patents" mean patent claims licensable by a Contributor which 27 | are necessarily infringed by the use or sale of its Contribution alone 28 | or when combined with the Program. 29 | 30 | "Program" means the Contributions Distributed in accordance with this 31 | Agreement. 32 | 33 | "Recipient" means anyone who receives the Program under this Agreement 34 | or any Secondary License (as applicable), including Contributors. 35 | 36 | "Derivative Works" shall mean any work, whether in Source Code or other 37 | form, that is based on (or derived from) the Program and for which the 38 | editorial revisions, annotations, elaborations, or other modifications 39 | represent, as a whole, an original work of authorship. 40 | 41 | "Modified Works" shall mean any work in Source Code or other form that 42 | results from an addition to, deletion from, or modification of the 43 | contents of the Program, including, for purposes of clarity any new file 44 | in Source Code form that contains any contents of the Program. Modified 45 | Works shall not include works that contain only declarations, 46 | interfaces, types, classes, structures, or files of the Program solely 47 | in each case in order to link to, bind by name, or subclass the Program 48 | or Modified Works thereof. 49 | 50 | "Distribute" means the acts of a) distributing or b) making available 51 | in any manner that enables the transfer of a copy. 52 | 53 | "Source Code" means the form of a Program preferred for making 54 | modifications, including but not limited to software source code, 55 | documentation source, and configuration files. 56 | 57 | "Secondary License" means either the GNU General Public License, 58 | Version 2.0, or any later versions of that license, including any 59 | exceptions or additional permissions as identified by the initial 60 | Contributor. 61 | 62 | 2. GRANT OF RIGHTS 63 | 64 | a) Subject to the terms of this Agreement, each Contributor hereby 65 | grants Recipient a non-exclusive, worldwide, royalty-free copyright 66 | license to reproduce, prepare Derivative Works of, publicly display, 67 | publicly perform, Distribute and sublicense the Contribution of such 68 | Contributor, if any, and such Derivative Works. 69 | 70 | b) Subject to the terms of this Agreement, each Contributor hereby 71 | grants Recipient a non-exclusive, worldwide, royalty-free patent 72 | license under Licensed Patents to make, use, sell, offer to sell, 73 | import and otherwise transfer the Contribution of such Contributor, 74 | if any, in Source Code or other form. This patent license shall 75 | apply to the combination of the Contribution and the Program if, at 76 | the time the Contribution is added by the Contributor, such addition 77 | of the Contribution causes such combination to be covered by the 78 | Licensed Patents. The patent license shall not apply to any other 79 | combinations which include the Contribution. No hardware per se is 80 | licensed hereunder. 81 | 82 | c) Recipient understands that although each Contributor grants the 83 | licenses to its Contributions set forth herein, no assurances are 84 | provided by any Contributor that the Program does not infringe the 85 | patent or other intellectual property rights of any other entity. 86 | Each Contributor disclaims any liability to Recipient for claims 87 | brought by any other entity based on infringement of intellectual 88 | property rights or otherwise. As a condition to exercising the 89 | rights and licenses granted hereunder, each Recipient hereby 90 | assumes sole responsibility to secure any other intellectual 91 | property rights needed, if any. For example, if a third party 92 | patent license is required to allow Recipient to Distribute the 93 | Program, it is Recipient's responsibility to acquire that license 94 | before distributing the Program. 95 | 96 | d) Each Contributor represents that to its knowledge it has 97 | sufficient copyright rights in its Contribution, if any, to grant 98 | the copyright license set forth in this Agreement. 99 | 100 | e) Notwithstanding the terms of any Secondary License, no 101 | Contributor makes additional grants to any Recipient (other than 102 | those set forth in this Agreement) as a result of such Recipient's 103 | receipt of the Program under the terms of a Secondary License 104 | (if permitted under the terms of Section 3). 105 | 106 | 3. REQUIREMENTS 107 | 108 | 3.1 If a Contributor Distributes the Program in any form, then: 109 | 110 | a) the Program must also be made available as Source Code, in 111 | accordance with section 3.2, and the Contributor must accompany 112 | the Program with a statement that the Source Code for the Program 113 | is available under this Agreement, and informs Recipients how to 114 | obtain it in a reasonable manner on or through a medium customarily 115 | used for software exchange; and 116 | 117 | b) the Contributor may Distribute the Program under a license 118 | different than this Agreement, provided that such license: 119 | i) effectively disclaims on behalf of all other Contributors all 120 | warranties and conditions, express and implied, including 121 | warranties or conditions of title and non-infringement, and 122 | implied warranties or conditions of merchantability and fitness 123 | for a particular purpose; 124 | 125 | ii) effectively excludes on behalf of all other Contributors all 126 | liability for damages, including direct, indirect, special, 127 | incidental and consequential damages, such as lost profits; 128 | 129 | iii) does not attempt to limit or alter the recipients' rights 130 | in the Source Code under section 3.2; and 131 | 132 | iv) requires any subsequent distribution of the Program by any 133 | party to be under a license that satisfies the requirements 134 | of this section 3. 135 | 136 | 3.2 When the Program is Distributed as Source Code: 137 | 138 | a) it must be made available under this Agreement, or if the 139 | Program (i) is combined with other material in a separate file or 140 | files made available under a Secondary License, and (ii) the initial 141 | Contributor attached to the Source Code the notice described in 142 | Exhibit A of this Agreement, then the Program may be made available 143 | under the terms of such Secondary Licenses, and 144 | 145 | b) a copy of this Agreement must be included with each copy of 146 | the Program. 147 | 148 | 3.3 Contributors may not remove or alter any copyright, patent, 149 | trademark, attribution notices, disclaimers of warranty, or limitations 150 | of liability ("notices") contained within the Program from any copy of 151 | the Program which they Distribute, provided that Contributors may add 152 | their own appropriate notices. 153 | 154 | 4. COMMERCIAL DISTRIBUTION 155 | 156 | Commercial distributors of software may accept certain responsibilities 157 | with respect to end users, business partners and the like. While this 158 | license is intended to facilitate the commercial use of the Program, 159 | the Contributor who includes the Program in a commercial product 160 | offering should do so in a manner which does not create potential 161 | liability for other Contributors. Therefore, if a Contributor includes 162 | the Program in a commercial product offering, such Contributor 163 | ("Commercial Contributor") hereby agrees to defend and indemnify every 164 | other Contributor ("Indemnified Contributor") against any losses, 165 | damages and costs (collectively "Losses") arising from claims, lawsuits 166 | and other legal actions brought by a third party against the Indemnified 167 | Contributor to the extent caused by the acts or omissions of such 168 | Commercial Contributor in connection with its distribution of the Program 169 | in a commercial product offering. The obligations in this section do not 170 | apply to any claims or Losses relating to any actual or alleged 171 | intellectual property infringement. In order to qualify, an Indemnified 172 | Contributor must: a) promptly notify the Commercial Contributor in 173 | writing of such claim, and b) allow the Commercial Contributor to control, 174 | and cooperate with the Commercial Contributor in, the defense and any 175 | related settlement negotiations. The Indemnified Contributor may 176 | participate in any such claim at its own expense. 177 | 178 | For example, a Contributor might include the Program in a commercial 179 | product offering, Product X. That Contributor is then a Commercial 180 | Contributor. If that Commercial Contributor then makes performance 181 | claims, or offers warranties related to Product X, those performance 182 | claims and warranties are such Commercial Contributor's responsibility 183 | alone. Under this section, the Commercial Contributor would have to 184 | defend claims against the other Contributors related to those performance 185 | claims and warranties, and if a court requires any other Contributor to 186 | pay any damages as a result, the Commercial Contributor must pay 187 | those damages. 188 | 189 | 5. NO WARRANTY 190 | 191 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT 192 | PERMITTED BY APPLICABLE LAW, THE PROGRAM IS PROVIDED ON AN "AS IS" 193 | BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR 194 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF 195 | TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR 196 | PURPOSE. Each Recipient is solely responsible for determining the 197 | appropriateness of using and distributing the Program and assumes all 198 | risks associated with its exercise of rights under this Agreement, 199 | including but not limited to the risks and costs of program errors, 200 | compliance with applicable laws, damage to or loss of data, programs 201 | or equipment, and unavailability or interruption of operations. 202 | 203 | 6. DISCLAIMER OF LIABILITY 204 | 205 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT 206 | PERMITTED BY APPLICABLE LAW, NEITHER RECIPIENT NOR ANY CONTRIBUTORS 207 | SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 208 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST 209 | PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 210 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 211 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 212 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE 213 | POSSIBILITY OF SUCH DAMAGES. 214 | 215 | 7. GENERAL 216 | 217 | If any provision of this Agreement is invalid or unenforceable under 218 | applicable law, it shall not affect the validity or enforceability of 219 | the remainder of the terms of this Agreement, and without further 220 | action by the parties hereto, such provision shall be reformed to the 221 | minimum extent necessary to make such provision valid and enforceable. 222 | 223 | If Recipient institutes patent litigation against any entity 224 | (including a cross-claim or counterclaim in a lawsuit) alleging that the 225 | Program itself (excluding combinations of the Program with other software 226 | or hardware) infringes such Recipient's patent(s), then such Recipient's 227 | rights granted under Section 2(b) shall terminate as of the date such 228 | litigation is filed. 229 | 230 | All Recipient's rights under this Agreement shall terminate if it 231 | fails to comply with any of the material terms or conditions of this 232 | Agreement and does not cure such failure in a reasonable period of 233 | time after becoming aware of such noncompliance. If all Recipient's 234 | rights under this Agreement terminate, Recipient agrees to cease use 235 | and distribution of the Program as soon as reasonably practicable. 236 | However, Recipient's obligations under this Agreement and any licenses 237 | granted by Recipient relating to the Program shall continue and survive. 238 | 239 | Everyone is permitted to copy and distribute copies of this Agreement, 240 | but in order to avoid inconsistency the Agreement is copyrighted and 241 | may only be modified in the following manner. The Agreement Steward 242 | reserves the right to publish new versions (including revisions) of 243 | this Agreement from time to time. No one other than the Agreement 244 | Steward has the right to modify this Agreement. The Eclipse Foundation 245 | is the initial Agreement Steward. The Eclipse Foundation may assign the 246 | responsibility to serve as the Agreement Steward to a suitable separate 247 | entity. Each new version of the Agreement will be given a distinguishing 248 | version number. The Program (including Contributions) may always be 249 | Distributed subject to the version of the Agreement under which it was 250 | received. In addition, after a new version of the Agreement is published, 251 | Contributor may elect to Distribute the Program (including its 252 | Contributions) under the new version. 253 | 254 | Except as expressly stated in Sections 2(a) and 2(b) above, Recipient 255 | receives no rights or licenses to the intellectual property of any 256 | Contributor under this Agreement, whether expressly, by implication, 257 | estoppel or otherwise. All rights in the Program not expressly granted 258 | under this Agreement are reserved. Nothing in this Agreement is intended 259 | to be enforceable by any entity that is not a Contributor or Recipient. 260 | No third-party beneficiary rights are created under this Agreement. 261 | 262 | Exhibit A - Form of Secondary Licenses Notice 263 | 264 | "This Source Code may also be made available under the following 265 | Secondary Licenses when the conditions for such availability set forth 266 | in the Eclipse Public License, v. 2.0 are satisfied: {name license(s), 267 | version(s), and exceptions or additional permissions here}." 268 | 269 | Simply including a copy of this Agreement, including this Exhibit A 270 | is not sufficient to license the Source Code under Secondary Licenses. 271 | 272 | If it is not possible or desirable to put the notice in a particular 273 | file, then You may include the notice in a location (such as a LICENSE 274 | file in a relevant directory) where a recipient would be likely to 275 | look for such a notice. 276 | 277 | You may add additional accurate notices of copyright ownership. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Kekkonen [![Build Status](https://travis-ci.org/metosin/kekkonen.svg?branch=master)](https://travis-ci.org/metosin/kekkonen) 2 | 3 | 4 | 5 | A lightweight, data-driven library for creating and consuming remote service with Clojure(Script). Key features: 6 | * not dependent on Ring/HTTP/REST, just your domain functions & data 7 | * enables apis over HTTP, Web Sockets, Message Queues or whatever 8 | * supports multiple api styles: Messaging, CQRS & HTTP 9 | * [Schema](https://github.com/Prismatic/schema) input & output coercion 10 | * live & secure api-docs with [Swagger](http://swagger.io/) 11 | * besides invoking handlers, clients are enable to: 12 | * securely browse the api namespaces at runtime 13 | * check & validate single or multiple handlers without side-effects 14 | * extract public handler meta-data for client-side reasoning 15 | * highly extensible via options, interceptors and meta-handlers 16 | * ships with sensible defaults 17 | 18 | Bubblin' Under: 19 | * all interceptors, fully async 20 | * support for speculative transactions 21 | * client-side bundled reads & writes 22 | 23 | Picture of [UKK](https://en.wikipedia.org/wiki/Urho_Kekkonen) © Pressfoton Etyk 1975 -team, Museovirasto 24 | 25 | See [Live demo](https://kekkonen.herokuapp.com/) & [Wiki](https://github.com/metosin/kekkonen/wiki). 26 | 27 | ## Latest version 28 | 29 | [![Clojars Project](http://clojars.org/metosin/kekkonen/latest-version.svg)](http://clojars.org/metosin/kekkonen) 30 | 31 | Quickstart: `lein new kekkonen kakkonen` 32 | 33 | ## Basic building blocks 34 | 35 | ### Handler 36 | 37 | ```clj 38 | {:name ::plus 39 | :type :handler 40 | :interceptors [] 41 | :input {:data {:y s/Int 42 | :x s/Int}} 43 | :output s/Int 44 | :handle (fn [{{:keys [x y]} :data}] 45 | (+ x y))} 46 | ``` 47 | 48 | ### Interceptor 49 | 50 | ```clj 51 | {:name ::require-roles 52 | :enter (fn [context] 53 | (let [roles (-> context :user :roles)] 54 | (if (seq (clojure.set/intersection roles required)) 55 | context)))} 56 | ``` 57 | 58 | ## Hello World (local dispatch) 59 | 60 | ```clj 61 | (require '[kekkonen.core :as k]) 62 | 63 | (def dispatcher 64 | (k/dispatcher 65 | {:handlers 66 | {:api (k/handler {:name :hello 67 | :handle (constantly "hello world"))}}})) 68 | 69 | (k/invoke dispatcher :api/hello) 70 | ; => "hello world" 71 | ``` 72 | 73 | ## Hello World (ring-based Query API) 74 | 75 | ```clj 76 | (require '[kekkonen.cqrs :refer :all]) 77 | (require '[org.httpkit.server :as server]) 78 | 79 | (defn ^:query hello 80 | {:input {:data {:name String}}} 81 | [ctx] 82 | (success (str "Hello, " (-> ctx :data :name)))) 83 | 84 | (server/run-server 85 | (cqrs-api {:core {:handlers #'hello}}}) 86 | {:port 4000}) 87 | ``` 88 | 89 | you can invoke the hello api with http://localhost:4000/hello?name=World 90 | 91 | ## CQRS API with Swagger Docs 92 | 93 | ```clj 94 | (ns example.api 95 | (:require [org.httpkit.server :as server] 96 | [kekkonen.cqrs :refer :all] 97 | [plumbing.core :refer [defnk]] 98 | [schema.core :as s])) 99 | 100 | ;; 101 | ;; Schemas 102 | ;; 103 | 104 | (s/defschema Pizza 105 | {:name s/Str 106 | (s/optional-key :description) s/Str 107 | :size (s/enum :S :M :L) 108 | :origin {:country (s/enum :FI :PO)}}) 109 | 110 | ;; 111 | ;; Handlers 112 | ;; 113 | 114 | (defnk ^:query ping [] 115 | (success {:ping "pong"})) 116 | 117 | (defnk ^:command echo-pizza 118 | "Echoes a pizza" 119 | {:responses {:default {:schema Pizza}}} 120 | [data :- Pizza] 121 | (success data)) 122 | 123 | (defnk ^:query plus 124 | [[:data x :- s/Int, y :- s/Int]] 125 | (success {:result (+ x y)})) 126 | 127 | (defnk ^:command inc! [counter] 128 | (success {:result (swap! counter inc)})) 129 | 130 | ;; 131 | ;; Application 132 | ;; 133 | 134 | (def app 135 | (cqrs-api 136 | {:swagger {:ui "/api-docs" 137 | :spec "/swagger.json" 138 | :data {:info {:title "Kekkonen example"}}} 139 | :core {:handlers {:api {:pizza #'echo-pizza 140 | :example [#'ping #'inc! #'plus]}} 141 | :context {:counter (atom 0)}}})) 142 | 143 | ;; 144 | ;; Start it 145 | ;; 146 | 147 | (comment 148 | (server/run-server #'app {:port 3000})) 149 | ``` 150 | 151 | Start the server and browse to http://localhost:3000/api-docs and you should see the following: 152 | 153 | ![swagger-example](https://raw.githubusercontent.com/wiki/metosin/kekkonen/swagger-example.png) 154 | 155 | More examples at [`/examples`](https://github.com/metosin/kekkonen/tree/master/examples) and 156 | info in the [Wiki](https://github.com/metosin/kekkonen/wiki/Basics). 157 | 158 | # Roadmap 159 | 160 | Mostly written as [issues](https://github.com/metosin/kekkonen/issues). Biggest things: 161 | 162 | * Create namespaces with handlers from external sources (db, file, [actors](https://github.com/puniverse/pulsar)) 163 | * Adapter for Websockets 164 | * (ClojureScript) api-docs beyond Swagger 165 | * Support for Om Next Remotes 166 | * Clojure(Script) client & project template (re-kekkonen) 167 | * Opinionated CQRS reference implementation, with eventing 168 | * Graph-based dependency management 169 | * Handler mutations & hot-swapping 170 | * Go Async 171 | 172 | # Presentations 173 | 174 | * ClojureD 2016: http://www.slideshare.net/metosin/wieldy-remote-apis-with-kekkonen-clojured-2016 175 | * ClojuTRE 2015: http://www.slideshare.net/metosin/clojutre2015-kekkonen-making-your-clojure-web-apis-more-awesome 176 | 177 | # Thinking aloud 178 | 179 | ## Why not just use multimethods for dispatch? 180 | 181 | Clojure multimethods introduce mutable implicit state. With multimethods, by requiring a namespace `x` you 182 | could get an extra methods for a multimethod as a [side-effect](https://github.com/clojure/clojure/blob/bc186508ab98514780efbbddb002bf6fd2938aee/src/jvm/clojure/lang/MultiFn.java#L58-L68). 183 | For internal functionality (like in the cljs frontends), it's totally awesome and polymorphic. 184 | 185 | For remoting, things should be explicit and secure. With Kekkonen, handler registration is explicit and security 186 | works like the UNIX directory structure: by not having access to namespace `:api.admin`, you can't have access 187 | to any anything (sub-namespaces or handler) under that, regardless of their access policies. 188 | 189 | ## HTTP is awesome, why hide it? 190 | 191 | Yes, it is awesome, and is used as a transport. But do you really want to handcraft you domain into `POST`s, `PUT`s 192 | and `PATCH`es do reverse-engineer back in the client? Is it easy to consume APIs that return status codes 193 | [451](https://github.com/metosin/ring-http-response/blob/fe13051fd89ce073b04b855dcff18a0ce8d07190/dev/user.clj#L57) 194 | or the [226](https://github.com/metosin/ring-http-response/blob/fe13051fd89ce073b04b855dcff18a0ce8d07190/dev/user.clj#L19)? 195 | 196 | Kekkonen tries to keep things simple. By abstracting the HTTP we can use plain clojure, websockets or queues without 197 | change in the interaction semantics. 198 | 199 | ## Looks similar to Fnhouse? 200 | 201 | Yes, we have reused many great ideas from fnhouse, see [Special Thanks](#special-thanks). Initial version of Kekkonen 202 | was supposed to be built on top of fnhouse but the we realized that most of the fnhouse internals would have had to be 203 | overridden due to difference in opinions. 204 | 205 | ## Is this an actor lib? 206 | 207 | No. But we might integrate into [Pulsar](https://github.com/puniverse/pulsar). 208 | 209 | # Special thanks 210 | 211 | - [Schema](https://github.com/Prismatic/schema) for everything 212 | - [Plumbing](https://github.com/Prismatic/plumbing) for the `fnk`y syntax 213 | - [Fnhouse](https://github.com/Prismatic/fnhouse) for inspiration and reused ideas 214 | - [Ring-swagger](https://github.com/metosin/ring-swagger) for the Schema2Swagger -bindings 215 | - [Muuntaja](https://github.com/metosin/muuntaja) for all the data formats 216 | - [Compojure-api](https://github.com/metosin/compojure-api) for some middleware goodies 217 | 218 | ## License 219 | 220 | Copyright © 2015-2018 [Metosin Oy](http://www.metosin.fi) 221 | 222 | Distributed under the Eclipse Public License 2.0. 223 | -------------------------------------------------------------------------------- /dev-src/example/api.clj: -------------------------------------------------------------------------------- 1 | (ns example.api 2 | (:require [org.httpkit.server :as server] 3 | [kekkonen.cqrs :refer :all] 4 | [plumbing.core :refer [defnk]] 5 | [schema.core :as s])) 6 | 7 | ;; 8 | ;; Schemas 9 | ;; 10 | 11 | (s/defschema Pizza 12 | {:name s/Str 13 | (s/optional-key :description) s/Str 14 | :size (s/enum :S :M :L) 15 | :origin {:country (s/enum :FI :PO)}}) 16 | 17 | ;; 18 | ;; Handlers 19 | ;; 20 | 21 | (defnk ^:query ping [] 22 | (success {:ping "pong"})) 23 | 24 | (defnk ^:command echo-pizza 25 | "Echoes a pizza" 26 | {:responses {:default {:schema Pizza}}} 27 | [data :- Pizza] 28 | (success data)) 29 | 30 | (defnk ^:query plus 31 | [[:data x :- s/Int, y :- s/Int]] 32 | (success {:result (+ x y)})) 33 | 34 | (defnk ^:command inc! 35 | [[:components counter]] 36 | (success {:result (swap! counter inc)})) 37 | 38 | ;; 39 | ;; Application 40 | ;; 41 | 42 | (def app 43 | (cqrs-api 44 | {:swagger {:ui "/api-docs" 45 | :spec "/swagger.json" 46 | :data {:info {:title "Kekkonen example"}}} 47 | :core {:handlers {:api {:pizza #'echo-pizza 48 | :sample [#'ping #'inc! #'plus]}} 49 | :context {:components {:counter (atom 0)}}}})) 50 | 51 | (comment 52 | (server/run-server #'app {:port 5000})) 53 | -------------------------------------------------------------------------------- /dev-src/example/client.clj: -------------------------------------------------------------------------------- 1 | (ns example.client) 2 | 3 | (require '[kekkonen.core :as k]) 4 | (require '[schema.core :as s]) 5 | (require '[plumbing.core :as p]) 6 | 7 | ;; 8 | ;; Handlers 9 | ;; 10 | 11 | ; simplest thing that works 12 | (def hello-world 13 | (k/handler 14 | {:name "hello-world" 15 | :handle (fn [_] 16 | "hello world.")})) 17 | 18 | (hello-world {}) 19 | 20 | ; with more stuff 21 | (def echo 22 | (k/handler 23 | {:description "this is a handler for echoing data" 24 | :name :echo 25 | :summary "echoes data" 26 | :handle (fn [{:keys [data]}] 27 | data)})) 28 | 29 | (echo {:data {:name "tommi"}}) 30 | 31 | ; fnks 32 | (def ^:handler plus 33 | (k/handler 34 | {:description "fnk echo" 35 | :name :fnkecho 36 | :summery "echoes data" 37 | :handle (p/fnk [[:data x :- s/Int, y :- s/Int]] 38 | (+ x y))})) 39 | 40 | (plus {:data {:x 1, :y 2}}) 41 | 42 | ; defnk 43 | (p/defnk ^:handler multiply 44 | "multiply x with y" 45 | [[:data x :- s/Int, y :- s/Int]] 46 | {:result (* x y)}) 47 | 48 | (multiply {:data {:x 4, :y 7}}) 49 | 50 | ; stateful inc! 51 | (p/defnk ^:handler inc! 52 | "adds a global counter" 53 | [[:components counter]] 54 | (swap! counter inc)) 55 | 56 | (inc! {:components {:counter (atom 10)}}) 57 | 58 | ;; 59 | ;; Dispatcher 60 | ;; 61 | 62 | ; create 63 | (def d (k/dispatcher 64 | {:handlers {:api {:calculator [#'multiply #'plus] 65 | :stateful #'inc! 66 | :others [echo 67 | hello-world] 68 | :public (k/handler 69 | {:name :ping 70 | :handle (p/fnk [] :pong)})}} 71 | :context {:components {:counter (atom 0)}}})) 72 | 73 | ; get a handler 74 | (k/some-handler d :api/nill) 75 | (k/some-handler d :api.stateful/inc!) 76 | 77 | ; invoke a handler 78 | (k/invoke d :api.stateful/inc!) 79 | 80 | ; multi-tenant SAAS ftw? 81 | (k/invoke d :api.stateful/inc! {:components {:counter (atom 99)}}) 82 | 83 | ; can i call it? 84 | (k/validate d :api.stateful/inc!) 85 | -------------------------------------------------------------------------------- /dev-src/example/cqrs.clj: -------------------------------------------------------------------------------- 1 | (ns example.cqrs 2 | (:require [org.httpkit.server :as server] 3 | [kekkonen.cqrs :refer :all] 4 | [plumbing.core :refer [defnk]] 5 | [schema.core :as s] 6 | [clojure.set :as set] 7 | [kekkonen.upload :as upload] 8 | [kekkonen.ring :as ring])) 9 | 10 | ;; 11 | ;; Security 12 | ;; 13 | 14 | (s/defschema User 15 | {:name s/Str 16 | :roles #{s/Keyword}}) 17 | 18 | (defn api-key-authenticator [context] 19 | (let [api-key (-> context :request :query-params :api_key) 20 | user (condp = api-key 21 | "seppo" {:name "Seppo" :roles #{}} 22 | "sirpa" {:name "Sirpa" :roles #{:boss}} 23 | nil)] 24 | (assoc context :user user))) 25 | 26 | (defn require-roles [required] 27 | (fn [context] 28 | (let [roles (-> context :user :roles)] 29 | (if (seq (set/intersection roles required)) 30 | context)))) 31 | 32 | (defnk ^:query get-user 33 | {:responses {:default {:schema (s/maybe User)}}} 34 | [user] (success user)) 35 | 36 | ;; 37 | ;; Schemas 38 | ;; 39 | 40 | (s/defschema Item 41 | "A database item" 42 | {:id s/Int 43 | :name s/Str 44 | :size (s/enum :S :M :L) 45 | (s/optional-key :description) s/Str 46 | :origin {:country (s/enum :FI :PO)}}) 47 | 48 | (s/defschema AddNewItem 49 | (dissoc Item :id)) 50 | 51 | ;; 52 | ;; Commands & Queries 53 | ;; 54 | 55 | (defnk ^:query get-items 56 | "Retrieves all items" 57 | {:responses {:default {:schema [Item]}}} 58 | [[:components db]] 59 | (success (vals @db))) 60 | 61 | (defnk ^:command add-item 62 | "Adds an item to database" 63 | {:responses {:default {:schema Item}}} 64 | [[:components db ids] 65 | data :- AddNewItem] 66 | (let [id (swap! ids inc) 67 | item (assoc data :id id)] 68 | (success 69 | (get (swap! db assoc id item) id)))) 70 | 71 | 72 | (defnk ^:command reset-items 73 | "Resets the database" 74 | {::roles #{:boss}} 75 | [[:components db] 76 | [:data really :- s/Bool]] 77 | (success 78 | (if really 79 | (swap! db empty) 80 | @db))) 81 | 82 | (defnk ^:query ping [] (success {:ping "pong"})) 83 | (defnk ^:query pong [] (success {:pong "ping"})) 84 | 85 | ;; 86 | ;; parameters 87 | ;; 88 | 89 | (defnk ^:query plus 90 | {:responses {:default {:schema {:result s/Int}}}} 91 | [[:data x :- s/Int, y :- s/Int]] 92 | (success {:result (+ x y)})) 93 | 94 | (defnk ^:query times 95 | {:responses {:default {:schema {:result s/Int}}}} 96 | [[:data x :- s/Int, y :- s/Int]] 97 | (success {:result (* x y)})) 98 | 99 | (defnk ^:command increment 100 | {:responses {:default {:schema {:result s/Int}}}} 101 | [[:components counter]] 102 | (success {:result (swap! counter (partial + 10))})) 103 | 104 | (defnk upload 105 | "upload a file to the server" 106 | {:interceptors [[upload/multipart-params]] 107 | :type ::ring/handler 108 | ::ring/method :put 109 | ::ring/consumes ["multipart/form-data"]} 110 | [[:request [:multipart-params file :- upload/TempFileUpload]]] 111 | (success (dissoc file :tempfile))) 112 | 113 | ;; 114 | ;; Application 115 | ;; 116 | 117 | (def app 118 | (cqrs-api 119 | {:swagger {:ui "/api-docs" 120 | :spec "/swagger.json" 121 | :data {:info {:title "Kekkonen"}}} 122 | :api {:handlers {:http #'upload}} 123 | :core {:handlers {:api {:item [#'get-items #'add-item #'reset-items] 124 | :calculator [#'plus #'times #'increment] 125 | :security #'get-user 126 | :system [#'ping #'pong]}} 127 | :context {:components {:db (atom {}) 128 | :ids (atom 0) 129 | :counter (atom 0)}} 130 | :meta {::roles require-roles}} 131 | :ring {:interceptors [api-key-authenticator]}})) 132 | 133 | (comment 134 | (server/run-server #'app {:port 3000})) 135 | -------------------------------------------------------------------------------- /dev-src/example/github/client.clj: -------------------------------------------------------------------------------- 1 | (ns example.github.client 2 | (:require [kekkonen.client.cqrs :as k])) 3 | 4 | (comment 5 | (def context (k/create "http://localhost:3000")) 6 | 7 | (./aprint context) 8 | 9 | (./aprint 10 | (:body (k/query context :api.a.b.c/ping))) 11 | 12 | (./aprint 13 | (:body (k/query context :api.calculator/plus))) 14 | 15 | (./aprint 16 | (:body (k/query context :api.calculator/plus {:x 1}))) 17 | 18 | (./aprint 19 | (:body (k/query context :api.calculator/plus {:x 1, :y 2}))) 20 | 21 | (def context2 (k/context context {:x 1})) 22 | 23 | (./aprint context2) 24 | 25 | (./aprint 26 | (:body (k/query context2 :api.calculator/plus {:y 2}))) 27 | 28 | (def context3 (k/context context2 {:y 2})) 29 | 30 | (./aprint 31 | (:body (k/query context3 :api.calculator/plus))) 32 | 33 | ;; 34 | ;; Special thingies 35 | ;; 36 | 37 | (./aprint 38 | (:body (k/query context3 :kekkonen/all))) 39 | 40 | (./pprint 41 | (map (juxt :action :type) (:body (k/query context3 :kekkonen/get-all)))) 42 | 43 | (./pprint 44 | (map (juxt :action :type) (:body (k/query context3 :kekkonen/available-handlers))))) 45 | -------------------------------------------------------------------------------- /dev-src/example/github/github.clj: -------------------------------------------------------------------------------- 1 | (ns example.github.github 2 | (:require [example.github.security :as security] 3 | [org.httpkit.server :as server] 4 | [kekkonen.cqrs :refer :all] 5 | [plumbing.core :as p] 6 | [schema.core :as s])) 7 | 8 | ;; 9 | ;; Schemas 10 | ;; 11 | 12 | (s/defschema Repository 13 | "A Repository" 14 | {:id s/Int 15 | :name s/Str 16 | :allowed #{s/Str} 17 | :watchers #{s/Str} 18 | :stargazers #{s/Str}}) 19 | 20 | (s/def compojure-api 21 | {:id 1 22 | :name "Compojure API" 23 | :allowed #{"seppo" "sirpa"} 24 | :watchers #{} 25 | :stargazers #{}}) 26 | 27 | ;; 28 | ;; Commands & Queries 29 | ;; 30 | 31 | (p/defnk ^:query list-repositorys 32 | "Retrieves all Repos" 33 | {:responses {success-status {:schema [Repository]}}} 34 | [[:components repos]] 35 | (success (vals @repos))) 36 | 37 | (p/defnk ^:query get-repository 38 | "Retrieves repo details" 39 | {:responses {success-status {:schema (s/maybe Repository)}}} 40 | [[:components repos] 41 | [:data id :- s/Int]] 42 | (success (@repos id))) 43 | 44 | (p/defnk ^:command fork 45 | "Forks a repo" 46 | [[:data id :- s/Int]] 47 | (success {:forked id})) 48 | 49 | (p/defnk ^:command watch 50 | "Watch a repo" 51 | [user 52 | [:data id :- s/Int] 53 | [:components repos]] 54 | (swap! repos #(update-in % [id :watchers] conj user)) 55 | (success {:forked id})) 56 | 57 | (p/defnk ^:command un-watch 58 | "Unwatch a repo" 59 | [user 60 | [:data id :- s/Int] 61 | [:components repos]] 62 | (swap! repos #(update-in % [id :watchers] disj user)) 63 | (success {:forked id})) 64 | 65 | (p/defnk ^:command star 66 | "Star a repo" 67 | [user 68 | [:data id :- s/Int] 69 | [:components repos]] 70 | (swap! repos #(update-in % [id :stargazers] conj user)) 71 | (success)) 72 | 73 | (p/defnk ^:command un-star 74 | "Unstar a repo" 75 | [user 76 | [:data id :- s/Int] 77 | [:components repos]] 78 | (swap! repos #(update-in % [id :stargazers] disj user)) 79 | (success)) 80 | 81 | (do 82 | ;; 83 | ;; testing 84 | ;; 85 | 86 | (p/defnk ^:query ping [] (success {:ping "pong"})) 87 | 88 | (p/defnk ^:command boss-move 89 | "For bosses only" 90 | {:roles #{:boss}} 91 | [] (success {:all :done})) 92 | 93 | (p/defnk ^:query plus 94 | {:responses {success-status {:schema {:result s/Int}}}} 95 | [[:data x :- s/Int, y :- s/Int]] 96 | (success {:result (+ x y)})) 97 | 98 | (p/defnk ^:command times 99 | {:responses {success-status {:schema {:result s/Int}}}} 100 | [[:data x :- s/Int, y :- s/Int]] 101 | (success {:result (* x y)})) 102 | 103 | (p/defnk ^:command inc! 104 | {:responses {success-status {:schema {:result s/Int}}}} 105 | [[:components counter]] 106 | (success {:result (swap! counter inc)}))) 107 | 108 | 109 | ;; 110 | ;; Application 111 | ;; 112 | 113 | (def app 114 | (cqrs-api 115 | {:swagger {:ui "/api-docs" 116 | :spec "/swagger.json" 117 | :data {:info {:title "Kekkonen" 118 | :version "1.0"}}} 119 | :core {:handlers {:api {:github [#'get-repository 120 | #'list-repositorys 121 | #'fork 122 | #'watch 123 | #'un-watch 124 | #'star 125 | #'un-star] 126 | :calculator [#'plus #'times #'inc!] 127 | :security #'security/get-user 128 | :a {:b {:c [#'ping 129 | #'boss-move]}}}} 130 | :context {:components {:repos (atom {(:id compojure-api) 131 | compojure-api}) 132 | :counter (atom 0)}} 133 | :meta {:roles security/require-roles}} 134 | :ring {:interceptors [security/api-key-authenticator]}})) 135 | 136 | (comment 137 | (server/run-server #'app {:port 3000})) 138 | -------------------------------------------------------------------------------- /dev-src/example/github/security.clj: -------------------------------------------------------------------------------- 1 | (ns example.github.security 2 | (:require [kekkonen.cqrs :refer :all] 3 | [plumbing.core :as p] 4 | [schema.core :as s] 5 | [clojure.set :as set])) 6 | 7 | ;; 8 | ;; Security 9 | ;; 10 | 11 | (s/defschema User 12 | {:name s/Str 13 | :roles #{s/Keyword}}) 14 | 15 | (defn api-key-authenticator [context] 16 | (let [api-key (-> context :request :query-params :api_key) 17 | user (condp = api-key 18 | "123" {:name "Seppo" :roles #{}} 19 | "234" {:name "Sirpa" :roles #{:boss}} 20 | nil)] 21 | (assoc context :user user))) 22 | 23 | (defn require-roles [required] 24 | (fn [context] 25 | (let [roles (-> context :user :roles)] 26 | (if (seq (set/intersection roles required)) 27 | context)))) 28 | 29 | (p/defnk ^:query get-user 30 | {:responses {success-status {:schema (s/maybe User)}}} 31 | [user] (success user)) 32 | -------------------------------------------------------------------------------- /dev-src/example/handlers.clj: -------------------------------------------------------------------------------- 1 | (ns example.handlers 2 | (:require [org.httpkit.server :as server] 3 | [plumbing.core :as p] 4 | [ring.util.http-response :refer [ok]] 5 | [kekkonen.ring :as r] 6 | [kekkonen.core :as k] 7 | [kekkonen.middleware :as mw] 8 | [schema.core :as s])) 9 | 10 | (p/defnk ^:handler ping [] (ok {:ping "pong"})) 11 | 12 | (p/defnk ^:handler snoop 13 | [request] (ok (dissoc request :body))) 14 | 15 | (p/defnk ^:handler echo 16 | [[:request [:body-params x :- s/Str]]] 17 | (ok {:x x})) 18 | 19 | (def app 20 | (mw/wrap-api 21 | (r/ring-handler 22 | (k/dispatcher 23 | {:handlers {:api 'example.handlers}})))) 24 | 25 | (comment 26 | (server/run-server #'app {:port 3000})) 27 | -------------------------------------------------------------------------------- /dev-src/example/http.clj: -------------------------------------------------------------------------------- 1 | (ns example.http 2 | (:require [org.httpkit.server :as server] 3 | [kekkonen.http :as http] 4 | [ring.util.http-response :refer [ok]] 5 | [plumbing.core :refer [defnk]] 6 | [schema.core :as s] 7 | [kekkonen.upload :as upload])) 8 | 9 | (defnk ^:get plus 10 | {:responses {:default {:schema {:result s/Int}}}} 11 | [[:request [:query-params x :- s/Int, y :- s/Int]]] 12 | (ok {:result (+ x y)})) 13 | 14 | (defnk ^:post times 15 | {:responses {:default {:schema {:result s/Int}}}} 16 | [[:request [:body-params x :- s/Int, y :- s/Int]]] 17 | (ok {:result (* x y)})) 18 | 19 | (defnk ^:put minus 20 | {:responses {:default {:schema {:result s/Int}}}} 21 | [[:request [:header-params x :- s/Int, y :- s/Int]]] 22 | (ok {:result (- x y)})) 23 | 24 | (defnk ^:put upload 25 | "upload a file to the server" 26 | {:interceptors [[upload/multipart-params]]} 27 | [[:request [:multipart-params file :- upload/TempFileUpload]]] 28 | (ok (dissoc file :tempfile))) 29 | 30 | (def app 31 | (http/http-api 32 | {:swagger {:ui "/" 33 | :spec "/swagger.json" 34 | :data {:info {:title "HTTP API example"}}} 35 | :core {:handlers {:file #'upload 36 | :math [#'plus #'times #'minus]}}})) 37 | 38 | (comment 39 | (server/run-server #'app {:port 3000})) 40 | -------------------------------------------------------------------------------- /dev-src/example/io.clj: -------------------------------------------------------------------------------- 1 | (ns example.io 2 | (:require [kekkonen.core :as k] 3 | [plumbing.core :refer [defnk]])) 4 | 5 | (defrecord IO [io]) 6 | 7 | (defnk ^:handler save-user [data db] 8 | (->IO 9 | (concat 10 | [[:io/db data]] 11 | (if-not (@db data) 12 | [[:io/email data]])))) 13 | 14 | (defnk ^:io db [data db] 15 | (swap! db conj data) 16 | (println ".. saved to db:" data)) 17 | 18 | (defnk ^:io email [data] 19 | (println ".. sent email:" data)) 20 | 21 | (def io-interceptor 22 | {:leave (fn [{:keys [response ::k/dispatcher] :as ctx}] 23 | (when (instance? IO response) 24 | (doseq [[io data] (:io response)] 25 | (k/invoke dispatcher io {:data data}))) 26 | ctx)}) 27 | 28 | (def k 29 | (k/dispatcher 30 | {:handlers {:action [#'save-user] 31 | :io [#'db #'email]} 32 | :context {:db (atom #{})} 33 | :type-resolver (k/type-resolver :handler :io) 34 | :interceptors [io-interceptor]})) 35 | 36 | (println (k/invoke k :action/save-user {:data "Laura"})) 37 | ; .. saved to db: Laura 38 | ; .. sent email: Laura 39 | ; #example.io.IO{:io ([:io/db Laura] [:io/email Laura])} 40 | 41 | (println (k/invoke k :action/save-user {:data "Lotta"})) 42 | ; .. saved to db: Lotta 43 | ; .. sent email: Lotta 44 | ; #example.io.IO{:io ([:io/db Lotta] [:io/email Lotta])} 45 | 46 | (println (k/invoke k :action/save-user {:data "Lotta"})) 47 | ; .. saved to db: Lotta 48 | ; #example.io.IO{:io ([:io/db Lotta])} 49 | -------------------------------------------------------------------------------- /dev-src/example/io2.clj: -------------------------------------------------------------------------------- 1 | (ns example.io2 2 | (:require [kekkonen.core :as k] 3 | [plumbing.core :refer [defnk]])) 4 | 5 | ;; 6 | ;; IO 7 | ;; 8 | 9 | (defrecord IO [io]) 10 | 11 | (defrecord IOResult [io acc]) 12 | 13 | (defn run-io! [dispatcher {:keys [io]}] 14 | (reduce 15 | (fn [{:keys [io acc]} [action data]] 16 | (let [io-result (k/invoke dispatcher action {:data data, :acc acc})] 17 | (when-not (or (map? io-result) (nil? io-result)) 18 | (throw (ex-info "IO must return a map or nil" {:result io-result}))) 19 | {:io (conj io [action data io-result]) 20 | :acc (merge acc io-result)})) 21 | (map->IOResult 22 | {:io [] 23 | :acc {}}) 24 | io)) 25 | 26 | (defn log! [fmt & args] 27 | (apply printf (str "\u001B[35m" fmt "\u001B[0m\n") args)) 28 | 29 | (def io-interceptor 30 | {:leave (fn [{:keys [response ::k/dispatcher] :as ctx}] 31 | (if (instance? IO response) 32 | (update ctx :response (partial run-io! dispatcher)) 33 | ctx))}) 34 | 35 | ;; 36 | ;; Application 37 | ;; 38 | 39 | ;; actions 40 | 41 | (defnk ^:handler save-user [data db] 42 | (->IO 43 | (concat 44 | [[:io/db data]] 45 | (if-not (@db data) 46 | [[:io/email data]])))) 47 | 48 | ;; side-effects 49 | 50 | (defnk ^:io db [data ids db] 51 | (let [id (swap! ids inc)] 52 | (swap! db assoc data id) 53 | (log! ".. created user %s (id=%s)" data id) 54 | {:id id})) 55 | 56 | (defnk ^:io email [data [:acc id]] 57 | (log! ".. sent email to %s (id=%s)" data id)) 58 | 59 | ;; dispatcher 60 | 61 | (def dispatcher 62 | (k/dispatcher 63 | {:handlers {:action [#'save-user] 64 | :io [#'db #'email]} 65 | :context {:db (atom {}), :ids (atom 0)} 66 | :type-resolver (k/type-resolver :handler :io) 67 | :interceptors [io-interceptor]})) 68 | 69 | ;; 70 | ;; Running it 71 | ;; 72 | 73 | (println (k/invoke dispatcher :action/save-user {:data "Laura"})) 74 | ; .. created user Laura (id=1) 75 | ; .. sent email to Laura (id=1) 76 | ; #example.io2.IOResult{:io [[:io/db Laura {:id 1}] [:io/email Laura nil]], :acc {:id 1}} 77 | 78 | (println (k/invoke dispatcher :action/save-user {:data "Lotta"})) 79 | ; .. created user Lotta (id=2) 80 | ; .. sent email to Lotta (id=2) 81 | ; #example.io2.IOResult{:io [[:io/db Lotta {:id 2}] [:io/email Lotta nil]], :acc {:id 2}} 82 | 83 | (println (k/invoke dispatcher :action/save-user {:data "Lotta"})) 84 | ; .. created user Lotta (id=3) 85 | ; #example.io2.IOResult{:io [[:io/db Lotta {:id 3}]], :acc {:id 3}} 86 | -------------------------------------------------------------------------------- /dev-src/example/kebab.clj: -------------------------------------------------------------------------------- 1 | (ns example.kebab 2 | (:require [org.httpkit.server :as server] 3 | [kekkonen.cqrs :refer :all] 4 | [plumbing.core :refer [defnk fnk]] 5 | [example.security :as security] 6 | example.math 7 | [schema.core :as s] 8 | [kekkonen.core :as k])) 9 | 10 | ;; 11 | ;; Tx 12 | ;; 13 | 14 | (defn forward [dispatcher action ctx data] 15 | (try 16 | (k/invoke dispatcher action (assoc ctx :data data)) 17 | (catch Exception e 18 | (ex-data e)))) 19 | 20 | (defnk ^:command speculative 21 | "Dummy implementation. In real life, use a real TX system such as the RDB\n\n 22 | **{:action :kebab/add-kebab, :data {:name \"Abu Fuad\", :type :doner}}**" 23 | {:summary "Runs a speculative transaction."} 24 | [db ids 25 | [:data action :- s/Keyword, data :- s/Any] 26 | :as ctx] 27 | 28 | (let [db' (atom @db) 29 | ids' (atom @ids) 30 | ctx' (merge ctx {:db db', :ids ids'}) 31 | 32 | dispatcher (k/get-dispatcher ctx) 33 | response (forward dispatcher action ctx' data)] 34 | 35 | response)) 36 | 37 | (defnk ^:command transact 38 | "Dummy implementation. In real life, use a real TX system such as the RDB.\n\n 39 | **{:commands [{:action :kebab/add-kebab, :data {:name \"Abu Fuad\", :type :doner}} 40 | {:action :kebab/add-kebab, :data {:name \"Kuningaskebab\", :type :mustamakkara}}]}**" 41 | {:summary "Runs multiple commands in a single transaction."} 42 | [db ids 43 | [:data commands :- [{:action s/Keyword 44 | :data s/Any}]] :as ctx] 45 | 46 | (let [db' (atom @db) 47 | ids' (atom @ids) 48 | ctx' (merge ctx {:db db', :ids ids'}) 49 | 50 | dispatcher (k/get-dispatcher ctx) 51 | responses (map 52 | (fnk [action data] 53 | (forward dispatcher action ctx' data)) 54 | commands) 55 | 56 | {successed true, failed false} (group-by success? responses) 57 | should-commit? (not (seq failed)) 58 | response (if should-commit? success failure)] 59 | 60 | (when should-commit? 61 | (reset! db @db') 62 | (reset! ids @ids')) 63 | 64 | (response {:success successed 65 | :failed failed}))) 66 | 67 | ;; 68 | ;; Schemas 69 | ;; 70 | 71 | (s/defschema Kebab 72 | {:id s/Int 73 | :name s/Str 74 | :type (s/enum :doner :shish :souvlaki :mustamakkara)}) 75 | 76 | (s/defschema NewKebab 77 | (dissoc Kebab :id)) 78 | 79 | ;; 80 | ;; Commands & Queries 81 | ;; 82 | 83 | (defnk ^:query get-kebabs 84 | "Retrieves all kebabs" 85 | {:responses {:default {:schema [Kebab]}}} 86 | [db] 87 | (success (vals @db))) 88 | 89 | (defnk ^:command add-kebab 90 | "Adds an kebab to database" 91 | {:responses {:default {:schema Kebab}}} 92 | [db, ids, data :- NewKebab] 93 | 94 | (if (-> data :type (= :mustamakkara)) 95 | (failure "Oh nous, not a Kebab!") 96 | (let [item (assoc data :id (swap! ids inc))] 97 | (swap! db assoc (:id item) item) 98 | (success item)))) 99 | 100 | (defnk ^:command reset-kebabs 101 | "Deletes all kebabs" 102 | {:roles #{:admin}} 103 | [db] 104 | (reset! db nil) 105 | (success)) 106 | 107 | ;; 108 | ;; Application 109 | ;; 110 | 111 | (def app 112 | (cqrs-api 113 | {:swagger {:ui "/api-docs" 114 | :spec "/swagger.json" 115 | :data {:info {:title "Kebab Api"}}} 116 | :core {:handlers {:kebab [#'get-kebabs #'add-kebab #'reset-kebabs] 117 | :math 'example.math 118 | :tx [#'transact #'speculative]} 119 | :context {:db (atom {}) 120 | :ids (atom 0) 121 | :counter (atom 0)} 122 | :meta {:roles security/require-roles}} 123 | :ring {:interceptors [security/api-key-authenticator]}})) 124 | 125 | (comment 126 | (server/run-server #'app {:port 7001})) 127 | 128 | (comment 129 | 130 | {:action :kebab/add-kebab 131 | :data {:name "Abu Fuad", :type :doner}} 132 | 133 | {:commands 134 | [{:action :kebab/add-kebab 135 | :data {:name "Abu Fuad", :type :doner}} 136 | {:action :kebab/add-kebab 137 | :data {:name "Kuningaskebab", :type :mustamakkara}}]}) 138 | -------------------------------------------------------------------------------- /dev-src/example/math.clj: -------------------------------------------------------------------------------- 1 | (ns example.math 2 | (:require [plumbing.core :refer [defnk]] 3 | [kekkonen.cqrs :refer :all] 4 | [schema.core :as s])) 5 | 6 | (defnk ^:query ping [] 7 | (success {:ping "pong"})) 8 | 9 | (defnk ^:query plus 10 | [[:data x :- s/Int, y :- s/Int]] 11 | (success (+ x y))) 12 | 13 | (defnk ^:command increment 14 | [counter] 15 | (success (swap! counter inc))) 16 | -------------------------------------------------------------------------------- /dev-src/example/security.clj: -------------------------------------------------------------------------------- 1 | (ns example.security 2 | (:require [clojure.set :as set])) 3 | 4 | (defn api-key-authenticator [context] 5 | (let [api-key (-> context :request :query-params :api_key) 6 | user (condp = api-key 7 | "seppo" {:name "Seppo" :roles #{}} 8 | "admin" {:name "Sirpa" :roles #{:admin}} 9 | nil)] 10 | (assoc context :user user))) 11 | 12 | (defn require-roles [required] 13 | (fn [context] 14 | (let [roles (-> context :user :roles)] 15 | (if (seq (set/intersection roles required)) 16 | context)))) 17 | -------------------------------------------------------------------------------- /doc/cljdoc.edn: -------------------------------------------------------------------------------- 1 | {:cljdoc/include-namespaces-from-dependencies 2 | [metosin/kekkonen 3 | metosin/kekkonen-core]} 4 | -------------------------------------------------------------------------------- /examples/component/.gitignore: -------------------------------------------------------------------------------- 1 | /.lein-* 2 | /.nrepl-port 3 | target/ 4 | -------------------------------------------------------------------------------- /examples/component/README.md: -------------------------------------------------------------------------------- 1 | # Kekkonen with Component sample 2 | 3 | ## Usage 4 | 5 | ### Run the application locally 6 | 7 | ``` 8 | lein repl 9 | user=> (go) 10 | ``` 11 | 12 | ### Packaging and running as standalone jar 13 | 14 | ``` 15 | lein uberjar 16 | java -server -jar target/sample.jar 17 | ``` 18 | 19 | ## License 20 | 21 | Copyright © 2015-2016 [Metosin Oy](http://www.metosin.fi) 22 | 23 | Distributed under the Eclipse Public License, the same as Clojure. 24 | -------------------------------------------------------------------------------- /examples/component/project.clj: -------------------------------------------------------------------------------- 1 | (defproject sample "0.1.0-SNAPSHOT" 2 | :description "Kekkonen with Component sample" 3 | :dependencies [[org.clojure/clojure "1.7.0"] 4 | [http-kit "2.1.19"] 5 | [com.stuartsierra/component "0.3.1"] 6 | [reloaded.repl "0.2.2"] 7 | [metosin/palikka "0.5.1"] 8 | [metosin/kekkonen "0.5.3-SNAPSHOT"]] 9 | :profiles {:uberjar {:aot [sample.main] 10 | :main sample.main 11 | :uberjar-name "sample.jar"}}) 12 | -------------------------------------------------------------------------------- /examples/component/src/sample/handler.clj: -------------------------------------------------------------------------------- 1 | (ns sample.handler 2 | (:require [plumbing.core :refer [defnk]] 3 | [kekkonen.cqrs :refer :all] 4 | [kekkonen.upload :as upload] 5 | [schema.core :as s])) 6 | 7 | (s/defschema Pizza 8 | {:name s/Str 9 | (s/optional-key :description) s/Str 10 | :size (s/enum :S :M :L) 11 | :origin {:country (s/enum :FI :PO)}}) 12 | 13 | ;; 14 | ;; Handlers 15 | ;; 16 | 17 | (defnk ^:query ping [] 18 | (success {:ping "pong"})) 19 | 20 | (defnk ^:command echo-pizza 21 | "Echoes a pizza" 22 | {:responses {:default {:schema Pizza}}} 23 | [data :- Pizza] 24 | (success data)) 25 | 26 | (defnk ^:query plus 27 | "playing with data" 28 | [[:data x :- s/Int, y :- s/Int]] 29 | (success (+ x y))) 30 | 31 | (defnk ^:command inc! 32 | "a stateful counter" 33 | [[:state counter]] 34 | (success (swap! counter inc))) 35 | 36 | (defnk ^:command upload 37 | "Upload a file to a server" 38 | {:interceptors [[upload/multipart-params]]} 39 | [[:state file] 40 | [:request [:multipart-params upload :- upload/TempFileUpload]]] 41 | (reset! file upload) 42 | (success (dissoc upload :tempfile))) 43 | 44 | (defnk ^:query download 45 | "Download the file from the server" 46 | [[:state file]] 47 | (let [{:keys [tempfile content-type filename]} @file] 48 | (upload/response tempfile content-type filename))) 49 | 50 | ;; 51 | ;; Application 52 | ;; 53 | 54 | (defn create [system] 55 | (cqrs-api 56 | {:swagger {:ui "/" 57 | :spec "/swagger.json" 58 | :data {:info {:title "Kekkonen sample API" 59 | :description "created with http://kekkonen.io"}}} 60 | :core {:handlers {:pizza #'echo-pizza 61 | :math [#'inc! #'plus] 62 | :ping #'ping 63 | :file [#'upload #'download]} 64 | :context system}})) 65 | -------------------------------------------------------------------------------- /examples/component/src/sample/main.clj: -------------------------------------------------------------------------------- 1 | (ns sample.main 2 | (:require [reloaded.repl :refer [set-init! go]]) 3 | (:gen-class)) 4 | 5 | (defn -main [& [port]] 6 | (let [port (or port 3000)] 7 | (require 'sample.system) 8 | (set-init! #((resolve 'sample.system/new-system) {:http {:port port}})) 9 | (go))) 10 | -------------------------------------------------------------------------------- /examples/component/src/sample/system.clj: -------------------------------------------------------------------------------- 1 | (ns sample.system 2 | (:require [com.stuartsierra.component :as component] 3 | [palikka.components.http-kit :as http-kit] 4 | [sample.handler :as handler])) 5 | 6 | (defn new-system [config] 7 | (component/map->SystemMap 8 | {:state (reify component/Lifecycle 9 | (start [_] {:counter (atom 0)})) 10 | :http (component/using 11 | (http-kit/create 12 | (:http config) 13 | {:fn 14 | (if (:dev-mode? config) 15 | ; re-create handler on every request 16 | (fn [system] #((handler/create system) %)) 17 | handler/create)}) 18 | [:state])})) 19 | -------------------------------------------------------------------------------- /examples/component/src/user.clj: -------------------------------------------------------------------------------- 1 | (ns user 2 | (:require [reloaded.repl :refer [system init start stop go reset]] 3 | [sample.system :refer [new-system]])) 4 | 5 | (reloaded.repl/set-init! #(new-system {:http {:port 3000}, :dev-mode? true})) 6 | -------------------------------------------------------------------------------- /examples/hello-world/.gitignore: -------------------------------------------------------------------------------- 1 | /.lein-* 2 | /.nrepl-port 3 | target/ 4 | -------------------------------------------------------------------------------- /examples/hello-world/README.md: -------------------------------------------------------------------------------- 1 | # Hello World with Kekkonen 2 | 3 | ## Usage 4 | 5 | ``` 6 | lein repl 7 | sample.handler=> (start) 8 | ``` 9 | 10 | ## License 11 | 12 | Copyright © 2015-2016 [Metosin Oy](http://www.metosin.fi) 13 | 14 | Distributed under the Eclipse Public License, the same as Clojure. 15 | -------------------------------------------------------------------------------- /examples/hello-world/project.clj: -------------------------------------------------------------------------------- 1 | (defproject sample "0.1.0-SNAPSHOT" 2 | :description "Hello World with Kekkonen" 3 | :dependencies [[org.clojure/clojure "1.7.0"] 4 | [http-kit "2.1.19"] 5 | [metosin/kekkonen "0.5.3-SNAPSHOT"]] 6 | :repl-options {:init-ns sample.handler}) 7 | -------------------------------------------------------------------------------- /examples/hello-world/src/sample/handler.clj: -------------------------------------------------------------------------------- 1 | (ns sample.handler 2 | (:require [org.httpkit.server :as server] 3 | [plumbing.core :refer [defnk]] 4 | [kekkonen.cqrs :refer :all])) 5 | 6 | (defnk ^:query hello [[:data name :- String]] 7 | (success {:message (str "Hello, " name)})) 8 | 9 | (def app (cqrs-api {:core {:handlers #'hello}})) 10 | 11 | (defn start [] 12 | (server/run-server #'app {:port 3000})) 13 | 14 | ; ... or as a one-liner with vanilla Clojure 15 | ; 16 | ; (defn start [] 17 | ; (server/run-server 18 | ; (cqrs-api 19 | ; {:core 20 | ; {:handlers 21 | ; (query 22 | ; {:name "hello" 23 | ; :handle (fn [{{:keys [name]} :data}] 24 | ; (success {:message (str "Hello, " name)}))})}}) 25 | ; {:port 3000})) 26 | -------------------------------------------------------------------------------- /modules/kekkonen-core/project.clj: -------------------------------------------------------------------------------- 1 | (defproject metosin/kekkonen-core "0.5.3-SNAPSHOT" 2 | :description "A lightweight, remote api library for Clojure." 3 | :url "https://github.com/metosin/kekkonen" 4 | :license {:name "Eclipse Public License" :url "http://www.eclipse.org/legal/epl-v10.html"} 5 | :scm {:name "git" 6 | :url "https://github.com/metosin/kekkonen" 7 | :dir "../.."} 8 | :plugins [[lein-parent "0.3.4"]] 9 | :parent-project {:path "../../project.clj" 10 | :inherit [:deploy-repositories :managed-dependencies]} 11 | :dependencies [[prismatic/plumbing] 12 | [prismatic/schema] 13 | [frankiesardo/linked] 14 | 15 | ;; http-stuff, separate module? 16 | [clj-commons/clj-yaml] 17 | [metosin/ring-swagger] 18 | [metosin/ring-swagger-ui] 19 | [metosin/ring-http-response] 20 | [metosin/muuntaja] 21 | [ring/ring-defaults] 22 | 23 | ;; client stuff, separate module? 24 | [clj-http]]) 25 | -------------------------------------------------------------------------------- /modules/kekkonen-core/src/kekkonen/api.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.api 2 | (:require [kekkonen.ring :as r] 3 | [kekkonen.core :as k] 4 | [kekkonen.middleware :as mw] 5 | [kekkonen.swagger :as ks] 6 | [schema.core :as s] 7 | [kekkonen.common :as kc])) 8 | 9 | (s/defschema Options 10 | {:core k/KeywordMap 11 | (s/optional-key :api) {:handlers s/Any} 12 | (s/optional-key :ring) r/Options 13 | (s/optional-key :mw) k/KeywordMap 14 | (s/optional-key :swagger) ks/Options}) 15 | 16 | (s/def +default-options+ :- Options 17 | {:core (-> k/+default-options+ 18 | (kc/merge-map-like r/+ring-dispatcher-options+)) 19 | :api {:handlers r/+kekkonen-handlers+} 20 | :ring r/+default-options+ 21 | :mw mw/+default-options+ 22 | :swagger {:data {:info {:title "Kekkonen API" 23 | :version "0.0.1"}}}}) 24 | 25 | (defn api [options] 26 | (let [options (-> (kc/deep-merge-map-like +default-options+ options) 27 | (->> (s/validate Options)) 28 | (update-in [:mw :formats] mw/create-muuntaja)) 29 | api-handlers (-> options :api :handlers) 30 | swagger-data (merge (-> options :swagger :data) (mw/api-info (:mw options))) 31 | swagger-options (-> options :swagger) 32 | swagger-handler (ks/swagger-handler swagger-data swagger-options) 33 | dispatcher (cond-> (k/dispatcher (:core options)) 34 | api-handlers (k/inject api-handlers) 35 | swagger-handler (k/inject swagger-handler))] 36 | (mw/wrap-api 37 | (r/routes 38 | [(r/ring-handler dispatcher (:ring options)) 39 | (ks/swagger-ui swagger-options)]) 40 | (:mw options)))) 41 | -------------------------------------------------------------------------------- /modules/kekkonen-core/src/kekkonen/client/cqrs.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.client.cqrs 2 | (:require [clj-http.client :as http] 3 | [clojure.string :as str] 4 | [schema.core :as s] 5 | [kekkonen.common :as kc] 6 | [ring.util.http-predicates :as hp])) 7 | 8 | (s/defn ^:private action->uri [action :- s/Keyword] 9 | (str/replace (str/join "/" ((juxt namespace name) action)) #"\." "/")) 10 | 11 | (defn context [client data] 12 | (kc/deep-merge client {:data data})) 13 | 14 | (def +options+ {:query {:params :query-params, :f http/get} 15 | :command {:params :body-params, :f http/post}}) 16 | 17 | (s/defn ^:private action 18 | ([options client name] 19 | (action options client name {})) 20 | ([options client name data] 21 | (let [{:keys [f params]} options 22 | uri (str (:url client) "/" (action->uri name)) 23 | request (merge 24 | (:request client) 25 | {params (merge (:data client) data)})] 26 | (f uri request)))) 27 | 28 | ;; 29 | ;; Public api 30 | ;; 31 | 32 | (defn create [url] 33 | {:url url 34 | :data nil 35 | :request {:as :transit+json 36 | :throw-exceptions false 37 | :content-type :transit+json}}) 38 | 39 | (def query (partial action (:query +options+))) 40 | (def command (partial action (:command +options+))) 41 | 42 | (def success? hp/ok?) 43 | (def failure? hp/bad-request?) 44 | (def error? hp/internal-server-error?) 45 | -------------------------------------------------------------------------------- /modules/kekkonen-core/src/kekkonen/common.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.common 2 | (:require [clojure.walk :as walk] 3 | [schema.core :as s] 4 | [plumbing.core :as p] 5 | [linked.core :as linked] 6 | [plumbing.fnk.pfnk :as pfnk])) 7 | 8 | (defn map-like? 9 | "Checks wether x is a map or vector of tuples" 10 | [x] 11 | (boolean 12 | (or (map? x) 13 | (and (vector? x) 14 | (seq x) 15 | (every? vector? x) 16 | (every? #(= (count %) 2) x))))) 17 | 18 | (defn merge-map-like 19 | "Merges map-like collections into a linked map" 20 | [& cols] 21 | (into (linked/map) (apply concat cols))) 22 | 23 | ;; 24 | ;; Deep Merge: fast 25 | ;; 26 | 27 | (defn- deep-merge* [& colls] 28 | (let [f (fn [old new] 29 | (if (and (map? old) (map? new)) 30 | (merge-with deep-merge* old new) 31 | new))] 32 | (if (every? map? colls) 33 | (apply merge-with f colls) 34 | (last colls)))) 35 | 36 | (defn deep-merge 37 | "Deep-merges things together" 38 | [& coll] 39 | (let [values (filter identity coll)] 40 | (if (every? map? values) 41 | (apply merge-with deep-merge* values) 42 | (last values)))) 43 | 44 | ;; 45 | ;; Deep Merge: slower, merges all map-like forms 46 | ;; 47 | 48 | (defn- deep-merge-map-like* [& maps] 49 | (let [f (fn [old new] 50 | (if (and (map-like? old) (map-like? new)) 51 | (merge-with deep-merge-map-like* (merge-map-like old) (merge-map-like new)) 52 | new))] 53 | (if (every? map-like? maps) 54 | (apply merge-with f (map merge-map-like maps)) 55 | (last maps)))) 56 | 57 | (defn deep-merge-map-like 58 | "Deep-merges maps together, non-map-likes are overridden" 59 | [& maps] 60 | (let [maps (filter identity maps)] 61 | (assert (every? map? maps)) 62 | (apply merge-with deep-merge-map-like* maps))) 63 | 64 | ;; 65 | ;; Others 66 | ;; 67 | 68 | (defn join [& x-or-xs] 69 | (vec (keep identity (flatten x-or-xs)))) 70 | 71 | (defn vectorize [x] 72 | (if (sequential? x) (vec x) [x])) 73 | 74 | (defn dissoc-in 75 | "Dissociates an entry from a nested associative structure returning a new 76 | nested structure. `keys` is a sequence of keys. Any empty maps that result 77 | will not be present in the new structure." 78 | [m [k & ks]] 79 | (if ks 80 | (if-let [nextmap (get m k)] 81 | (let [newmap (dissoc-in nextmap ks)] 82 | (if (seq newmap) 83 | (assoc m k newmap) 84 | (dissoc m k))) 85 | m) 86 | (dissoc m k))) 87 | 88 | (defn strip-nil-values 89 | "Recursively strip away nils and empty maps" 90 | [m] 91 | (walk/postwalk 92 | (fn [x] 93 | (if (and (not (record? x)) (map? x)) 94 | (into (empty x) (remove (comp #(or (nil? %) (and (map? %) (empty? %))) val) x)) 95 | x)) 96 | m)) 97 | 98 | (defn deep-merge-from-to [data [from to]] 99 | (update-in data to deep-merge (get-in data from))) 100 | 101 | (defn deep-merge-to-from [data [to from]] 102 | (deep-merge-from-to data [from to])) 103 | 104 | (defn copy-from-to [data [from to]] 105 | (assoc-in data to (get-in data from))) 106 | 107 | (defn copy-to-from [data [to from]] 108 | (copy-from-to data [from to])) 109 | 110 | (defn move-from-to [data [from to]] 111 | (if-let [target (get-in data from)] 112 | (-> data 113 | (assoc-in to target) 114 | (dissoc-in from)) 115 | data)) 116 | 117 | (defn move-to-from [data [to from]] 118 | (move-from-to data [from to])) 119 | 120 | (defn merge-map-schemas [& schemas] 121 | (reduce 122 | (fn [acc schema] 123 | (if-not (= schema s/Any) 124 | (deep-merge acc schema) 125 | acc)) 126 | {} schemas)) 127 | 128 | (defn any-map-schema? [schema] 129 | (or (= schema s/Any) 130 | (= schema {s/Keyword s/Any}))) 131 | 132 | ;; 133 | ;; Schema tools 134 | ;; 135 | 136 | (defn extract-schema 137 | ([x] 138 | (extract-schema x s/Any)) 139 | ([x default] 140 | (p/for-map [k [:input :output] 141 | :let [schema (let [pfnk-schema (case k 142 | :input pfnk/input-schema 143 | :output pfnk/output-schema) 144 | pfnk? (fn [x] (and (satisfies? pfnk/PFnk x) (:schema (meta x))))] 145 | (if (var? x) 146 | (cond 147 | (pfnk? @x) (pfnk-schema @x) 148 | :else (or (-> x meta k) s/Any)) 149 | (or (and (-> x meta :schema) (pfnk-schema x)) 150 | ;; TODO: maek it better 151 | (and (= :input k) (:input x)) 152 | (-> x meta k) 153 | default)))] 154 | :when schema] 155 | k schema))) 156 | -------------------------------------------------------------------------------- /modules/kekkonen-core/src/kekkonen/core.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.core 2 | (:require [schema.core :as s] 3 | [plumbing.core :as p] 4 | [clojure.string :as str] 5 | [plumbing.map :as pm] 6 | [kekkonen.common :as kc] 7 | [linked.core :as linked] 8 | [kekkonen.interceptor :as interceptor] 9 | [clojure.walk :as walk] 10 | [schema.coerce :as sc] 11 | [schema.utils :as su] 12 | [clojure.set :as set]) 13 | (:import [clojure.lang Var IPersistentMap Symbol PersistentVector AFunction Keyword] 14 | [java.io Writer]) 15 | (:refer-clojure :exclude [namespace])) 16 | 17 | ;; 18 | ;; Common 19 | ;; 20 | 21 | (s/defschema Function 22 | (s/=> {s/Keyword s/Any} s/Any)) 23 | 24 | (s/defschema KeywordMap 25 | {s/Keyword s/Any}) 26 | 27 | ;; 28 | ;; Interceptors 29 | ;; 30 | 31 | (defrecord Interceptor [name input output enter leave error]) 32 | 33 | (s/defschema InterceptorLike 34 | (s/conditional 35 | fn? Function 36 | :else (s/constrained 37 | {(s/optional-key :name) (s/maybe (s/cond-pre s/Keyword s/Str s/Symbol)) 38 | (s/optional-key :input) s/Any 39 | (s/optional-key :output) s/Any 40 | (s/optional-key :enter) (s/maybe Function) 41 | (s/optional-key :leave) (s/maybe Function) 42 | (s/optional-key :error) (s/maybe Function)} 43 | (fn [{:keys [enter leave error]}] (or enter leave error)) 44 | 'enter-leave-or-error-required))) 45 | 46 | ;; 47 | ;; Context & Handler 48 | ;; 49 | 50 | (s/defschema Context 51 | (merge 52 | KeywordMap 53 | {(s/optional-key :data) s/Any})) 54 | 55 | (s/defschema Handler 56 | {:handle Function 57 | :type s/Keyword 58 | :name s/Keyword 59 | :ns (s/maybe s/Keyword) 60 | :action s/Keyword 61 | :description (s/maybe s/Str) 62 | 63 | ;; extra meta-data 64 | :meta KeywordMap 65 | ;; interceptors 66 | :interceptors [Interceptor] 67 | 68 | ;; schemas 69 | :input s/Any 70 | :output s/Any 71 | 72 | (s/optional-key :source-map) {:line s/Int 73 | :column s/Int 74 | :file s/Str 75 | :ns s/Symbol 76 | :name s/Symbol} 77 | s/Keyword s/Any}) 78 | 79 | ;; 80 | ;; Type Resolution 81 | ;; 82 | 83 | (s/defn type-resolver [& types :- [s/Keyword]] 84 | (fn [meta] 85 | (reduce 86 | (fn [_ type] 87 | (if (or (some-> meta type true?) (some-> meta :type (= type))) 88 | (reduced (-> meta (assoc :type type) (dissoc type))))) 89 | nil types))) 90 | 91 | (s/defn any-type-resolver [meta] 92 | (if (:type meta) meta)) 93 | 94 | (def default-type-resolver (type-resolver :handler)) 95 | 96 | ;; 97 | ;; Exposing handler meta-data 98 | ;; 99 | 100 | (defn stringify-schema [schema] 101 | (walk/prewalk 102 | (fn [x] 103 | (if-not (or (and (map? x) (not (record? x))) (vector? x) (string? x) (keyword? x) (nil? x)) 104 | (pr-str x) x)) 105 | schema)) 106 | 107 | ; TODO: pass Schemas as-is -> implement https://github.com/metosin/web-schemas 108 | (s/defn public-handler 109 | [handler :- Handler] 110 | (some-> handler 111 | (select-keys [:input :name :ns :output :source-map :type :action]) 112 | (update-in [:input] stringify-schema) 113 | (update-in [:output] stringify-schema))) 114 | 115 | ;; 116 | ;; Collecting 117 | ;; 118 | 119 | (defprotocol Collector 120 | (-collect [this type-resolver])) 121 | 122 | (s/defn collect 123 | [collector type-resolver] 124 | (-collect collector type-resolver)) 125 | 126 | ;; 127 | ;; Handlers 128 | ;; 129 | 130 | (s/defn ^:private user-meta [meta :- KeywordMap] 131 | (dissoc 132 | meta 133 | ; reserved dispatcher handler stuff 134 | :type :input :output :description 135 | ; clojure var meta 136 | :line :column :file :name :ns :doc 137 | ; cloverage meta 138 | :end-line :end-column :idx 139 | ; plumbing details 140 | :schema :plumbing.fnk.impl/positional-info 141 | ; arglist 142 | :arglists)) 143 | 144 | (s/defn handler 145 | ([meta :- KeywordMap] 146 | (handler (dissoc meta :handle) (:handle meta))) 147 | ([meta :- KeywordMap, f :- Function] 148 | (assert (:name meta) "handler should have :name") 149 | (vary-meta f merge {:type :handler} meta))) 150 | 151 | (defn handler? [x] 152 | (and (map? x) (:handle x) (:type x))) 153 | 154 | ;; 155 | ;; Namespaces 156 | ;; 157 | 158 | (s/defrecord Namespace [name :- s/Keyword, meta :- KeywordMap] 159 | Collector 160 | (-collect [this _] 161 | this)) 162 | 163 | (s/defn namespace [meta :- KeywordMap] 164 | (->Namespace (:name meta) (dissoc meta :name))) 165 | 166 | ;; 167 | ;; Collection helpers 168 | ;; 169 | 170 | (extend-type AFunction 171 | Collector 172 | (-collect [this type-resolver] 173 | (if-let [{:keys [name description type] :as meta} (type-resolver (meta this))] 174 | (let [{:keys [input output]} (kc/extract-schema this)] 175 | (if name 176 | {(namespace 177 | {:name (keyword name)}) 178 | {:handle this 179 | :type type 180 | :name (keyword name) 181 | :meta (user-meta meta) 182 | :description (or description "") 183 | :input input 184 | :output output}})) 185 | (throw (ex-info (format "Function %s can't be type-resolved" this) {:target this}))))) 186 | 187 | (extend-type Var 188 | Collector 189 | (-collect [this type-resolver] 190 | (if-let [{:keys [line column file ns name doc type] :as meta} (type-resolver (meta this))] 191 | (let [{:keys [input output]} (kc/extract-schema this)] 192 | {(namespace 193 | {:name (keyword name)}) 194 | {:handle @this 195 | :type type 196 | :name (keyword name) 197 | :meta (user-meta meta) 198 | :description doc 199 | :input input 200 | :output output 201 | :source-map {:line line 202 | :column column 203 | :file file 204 | :ns (ns-name ns) 205 | :name name}}}) 206 | (throw (ex-info (format "Var %s can't be type-resolved" this) {:target this}))))) 207 | 208 | (extend-type Symbol 209 | Collector 210 | (-collect [this type-resolver] 211 | (require this) 212 | (some->> this 213 | ns-publics 214 | (map val) 215 | (filter #(type-resolver (meta %))) 216 | (map #(-collect % type-resolver)) 217 | (apply merge)))) 218 | 219 | (extend-type Keyword 220 | Collector 221 | (-collect [this _] 222 | (namespace {:name this}))) 223 | 224 | (extend-type PersistentVector 225 | Collector 226 | (-collect [this type-resolver] 227 | (->> this 228 | (map #(-collect % type-resolver)) 229 | (apply merge)))) 230 | 231 | (extend-type IPersistentMap 232 | Collector 233 | (-collect [this type-resolver] 234 | (p/for-map [[k v] this] 235 | (-collect k type-resolver) (-collect v type-resolver)))) 236 | 237 | ;; 238 | ;; Dispatcher 239 | ;; 240 | 241 | (s/defrecord Dispatcher 242 | [handlers :- {s/Keyword Handler} 243 | context :- KeywordMap 244 | coercion :- {:input (s/maybe KeywordMap) 245 | :output s/Any} 246 | meta :- KeywordMap]) 247 | 248 | (defmethod clojure.core/print-method Dispatcher 249 | [_ ^Writer writer] 250 | (.write writer "#")) 251 | 252 | ;; 253 | ;; Working with contexts 254 | ;; 255 | 256 | (s/defn get-dispatcher [context :- Context] 257 | (get context ::dispatcher)) 258 | 259 | (s/defn get-handler [context :- Context] 260 | (get context ::handler)) 261 | 262 | (s/defn with-context [dispatcher :- Dispatcher, context :- Context] 263 | (update-in dispatcher [:context] kc/deep-merge context)) 264 | 265 | (s/defn context-copy 266 | "Returns a function that assocs in a value from to-kws path into from-kws in a context" 267 | [from :- [s/Any], to :- [s/Any]] 268 | (s/fn [context :- Context] 269 | (assoc-in context to (get-in context from {})))) 270 | 271 | (s/defn context-dissoc [from-kws :- [s/Any]] 272 | "Returns a function that dissocs in a value from from-kws in a context" 273 | (s/fn [context :- Context] 274 | (kc/dissoc-in context from-kws))) 275 | 276 | ;; 277 | ;; coercion 278 | ;; 279 | 280 | (def ^:private memoized-coercer (memoize sc/coercer)) 281 | 282 | (defn coerce! [schema matcher value in type] 283 | (let [coercer (memoized-coercer schema matcher) 284 | coerced (coercer value)] 285 | (if-not (su/error? coerced) 286 | coerced 287 | (throw 288 | (ex-info 289 | "Coercion error" 290 | {:type type 291 | :in in 292 | :value value 293 | :schema schema 294 | :error (su/error-val coerced)}))))) 295 | 296 | (defn coercion [data] 297 | (let [ks->coerce (into {} (pm/flatten data))] 298 | (fn [context schema] 299 | (reduce-kv 300 | (fn [ctx ks coerce] 301 | (if-let [coercion-schema (get-in schema ks)] 302 | (update-in ctx ks (partial coerce coercion-schema)) 303 | ctx)) 304 | context 305 | ks->coerce)))) 306 | 307 | (defn input-coerce! 308 | ([context schema] 309 | (if-let [dispatcher (get-dispatcher context)] 310 | (input-coerce! context schema (-> dispatcher :coercion :input)) 311 | (throw (ex-info "no attached dispatcher." {})))) 312 | ([context schema key->matcher] 313 | (if-not (kc/any-map-schema? schema) 314 | (as-> context context 315 | (if-let [coercion (::coercion context)] 316 | (coercion context schema) 317 | context) 318 | (if key->matcher 319 | (reduce-kv 320 | (fn [ctx k matcher] 321 | (let [schema (select-keys schema [k]) 322 | schema (if (seq schema) schema s/Any)] 323 | (merge ctx (coerce! schema matcher (select-keys ctx [k]) nil ::request)))) 324 | context 325 | key->matcher) 326 | context)) 327 | context))) 328 | 329 | ;; 330 | ;; Interceptors 331 | ;; 332 | 333 | (defn- initialize [context dispatcher handler mode] 334 | (let [ctx (assoc (kc/deep-merge (:context dispatcher) context) 335 | ::dispatcher dispatcher 336 | ::handler handler 337 | ::mode mode)] 338 | ctx)) 339 | 340 | (defn- with-input-schema [interceptor] 341 | (merge 342 | (kc/extract-schema (:enter interceptor) nil) 343 | interceptor)) 344 | 345 | (defn- with-input-coercion [interceptor] 346 | (if-let [input (:input interceptor)] 347 | (update interceptor :enter (fn [f] 348 | (fn [context] 349 | (let [dispatcher (::dispatcher context) 350 | input-matcher (-> dispatcher :coercion :input)] 351 | (f (input-coerce! context input input-matcher)))))) 352 | interceptor)) 353 | 354 | (defn- with-string-name [interceptor] 355 | (if (:name interceptor) 356 | (update interceptor :name str) 357 | interceptor)) 358 | 359 | (defn interceptor [interceptor-or-a-function] 360 | (map->Interceptor 361 | (s/validate 362 | InterceptorLike 363 | (-> 364 | (cond 365 | (fn? interceptor-or-a-function) {:enter interceptor-or-a-function} 366 | (map? interceptor-or-a-function) interceptor-or-a-function 367 | :else (throw (ex-info (str "Can't coerce into an interceptor: " interceptor-or-a-function) {}))) 368 | with-input-schema 369 | with-input-coercion 370 | with-string-name)))) 371 | 372 | (defn interceptors [data] 373 | (assert (vector? data) "interceptors must be defined as a vector") 374 | (map 375 | (fn [x] (interceptor (if (vector? x) (apply (first x) (rest x)) x))) 376 | (keep identity data))) 377 | 378 | ;; 379 | ;; Dispatching to handlers 380 | ;; 381 | 382 | (s/defn some-handler :- (s/maybe Handler) 383 | "Returns a handler or nil" 384 | [dispatcher, action :- s/Keyword] 385 | (get (:handlers dispatcher) action)) 386 | 387 | (defn- invalid-action! [action] 388 | (throw (ex-info (str "Invalid action: " action) {:type ::dispatch, :value action}))) 389 | 390 | (def ^:private validate-or-invoke? #{:validate :invoke}) 391 | (def ^:private invoke? (partial = :invoke)) 392 | 393 | (def ^:private execute-handler 394 | {:name ::handle 395 | :enter (fn [context] 396 | (let [{:keys [handle input output]} (::handler context) 397 | mode (::mode context) 398 | {{input-coercion :input, output-coercion :output} :coercion} (::dispatcher context)] 399 | (let [context (if (validate-or-invoke? mode) 400 | (input-coerce! context input input-coercion) context) 401 | response (if (invoke? mode) 402 | (as-> (handle context) response 403 | (if (and output output-coercion) 404 | (coerce! output output-coercion response nil ::response) 405 | response)))] 406 | (assoc context :response response))))}) 407 | 408 | (defn dispatch [dispatcher mode action context] 409 | (if-let [{:keys [interceptors] :as handler} (some-handler dispatcher action)] 410 | (let [context (-> context 411 | (initialize dispatcher handler mode) 412 | (interceptor/enqueue interceptors) 413 | (interceptor/execute))] 414 | (if (contains? context :response) 415 | (:response context) 416 | (invalid-action! action))) 417 | (invalid-action! action))) 418 | 419 | (s/defn check 420 | "Checks an action handler with the given context." 421 | ([dispatcher :- Dispatcher, action :- s/Keyword] 422 | (dispatch dispatcher :check action {})) 423 | ([dispatcher :- Dispatcher, action :- s/Keyword, context :- Context] 424 | (dispatch dispatcher :check action context))) 425 | 426 | (s/defn validate 427 | "Checks if context is valid for the handler (without calling the body). 428 | Returns nil or throws an exception." 429 | ([dispatcher :- Dispatcher, action :- s/Keyword] 430 | (dispatch dispatcher :validate action {})) 431 | ([dispatcher :- Dispatcher, action :- s/Keyword, context :- Context] 432 | (dispatch dispatcher :validate action context))) 433 | 434 | (s/defn invoke 435 | "Invokes an action handler with the given context." 436 | ([dispatcher :- Dispatcher, action :- s/Keyword] 437 | (dispatch dispatcher :invoke action {})) 438 | ([dispatcher :- Dispatcher, action :- s/Keyword, context :- Context] 439 | (dispatch dispatcher :invoke action context))) 440 | 441 | ;; 442 | ;; Listing handlers 443 | ;; 444 | 445 | (defn- filter-by-path [handlers path] 446 | (if-not path 447 | handlers 448 | (seq 449 | (filter 450 | (fn [{:keys [ns]}] 451 | (if ns 452 | (let [path-seq (str/split (subs (str path) 1) #"[\.]") 453 | action-seq (str/split (subs (str ns) 1) #"[\.]")] 454 | (= path-seq (take (count path-seq) action-seq))) 455 | true)) 456 | handlers)))) 457 | 458 | (defn- map-handlers [dispatcher mode prefix context success failure] 459 | (-> dispatcher 460 | :handlers 461 | vals 462 | (filter-by-path prefix) 463 | (->> 464 | (map 465 | (fn [handler] 466 | (try 467 | (when-not (= mode :all) 468 | (dispatch dispatcher mode (:action handler) context)) 469 | [handler (success handler)] 470 | (catch Exception e 471 | (if (-> e ex-data :type (= ::dispatch)) 472 | [nil nil] 473 | [handler (failure e)]))))) 474 | (filter first) 475 | (into {})))) 476 | 477 | (s/defn all-handlers :- [Handler] 478 | "Returns all handlers filtered by namespace" 479 | [dispatcher :- Dispatcher 480 | prefix :- (s/maybe s/Keyword)] 481 | (keep second (map-handlers dispatcher :all prefix {} identity (constantly nil)))) 482 | 483 | (s/defn available-handlers :- [Handler] 484 | "Returns all available handlers based on namespace and context" 485 | [dispatcher :- Dispatcher 486 | prefix :- (s/maybe s/Keyword) 487 | context :- Context] 488 | (keep first (map-handlers dispatcher :check prefix context identity (constantly nil)))) 489 | 490 | (s/defn dispatch-handlers :- {Handler s/Any} 491 | "Returns a map of action -> errors based on mode, namespace and context." 492 | [dispatcher :- Dispatcher 493 | mode :- (s/enum :check :validate) 494 | prefix :- (s/maybe s/Keyword) 495 | context :- Context] 496 | (map-handlers dispatcher mode prefix context (constantly nil) ex-data)) 497 | 498 | ;; 499 | ;; Creating a Dispatcher 500 | ;; 501 | 502 | (defn- extract-interceptors [meta metas] 503 | (reduce 504 | (fn [acc [k v]] 505 | (if-let [factory (get meta k)] 506 | (if-let [interceptors (seq (interceptors (kc/vectorize (factory v))))] 507 | (concat acc interceptors) 508 | acc) 509 | acc)) 510 | [] 511 | (apply concat metas))) 512 | 513 | (defn- collect-and-enrich [{:keys [handlers type-resolver meta interceptors]}] 514 | (let [handler-ns (fn [m] (if (seq m) (->> m (map :name) (map name) (str/join ".") keyword))) 515 | collect-ns-meta (fn [m] (if (seq m) (->> m (map :meta) (filterv (complement empty?))))) 516 | handler-action (fn [n ns] (keyword (str/join "/" (map name (filter identity [ns n]))))) 517 | reorder (fn [h m] 518 | (if-let [invalid-keys (seq (set/difference (set (keys m)) (set (keys meta))))] 519 | (throw (ex-info 520 | "invalid meta-data on handler" 521 | {:name (:name h) 522 | :invalid-keys invalid-keys 523 | :allowed-keys (keys meta)})) 524 | (into 525 | (linked/map) 526 | (keep 527 | (fn [k] 528 | (if-let [v (m k)] 529 | [k v])) 530 | (keys meta))))) 531 | enrich (fn [h m] 532 | (let [ns (handler-ns m) 533 | action (handler-action (:name h) ns) 534 | ns-meta (collect-ns-meta m) 535 | user-meta (:meta h) 536 | all-meta (map 537 | (partial reorder h) 538 | (if-not (empty? user-meta) 539 | (conj ns-meta user-meta) 540 | ns-meta)) 541 | interceptors (mapv 542 | interceptor 543 | (concat 544 | interceptors 545 | (extract-interceptors meta all-meta) 546 | [execute-handler])) 547 | input (apply kc/merge-map-schemas (:input h) (keep :input interceptors))] 548 | 549 | (merge h {:ns ns 550 | :interceptors interceptors 551 | :input (if (seq input) input s/Any) 552 | :action action}))) 553 | traverse (fn traverse [x m] 554 | (flatten 555 | (for [[k v] x] 556 | (if (handler? v) 557 | (enrich v m) 558 | (traverse v (conj m k))))))] 559 | (-> handlers 560 | (collect type-resolver) 561 | (traverse []) 562 | (->> (group-by :action) 563 | (p/map-vals first))))) 564 | 565 | ;; 566 | ;; Public API 567 | ;; 568 | 569 | (s/defschema Options 570 | {:handlers s/Any 571 | (s/optional-key :context) KeywordMap 572 | (s/optional-key :type-resolver) Function 573 | (s/optional-key :interceptors) [InterceptorLike] 574 | (s/optional-key :coercion) {(s/optional-key :input) (s/maybe KeywordMap) 575 | (s/optional-key :output) s/Any} 576 | (s/optional-key :meta) (s/cond-pre [[(s/one s/Keyword 'key) Function]] KeywordMap) 577 | s/Keyword s/Any}) 578 | 579 | (s/def +default-options+ :- Options 580 | {:handlers {} 581 | :context {} 582 | :interceptors [] 583 | :coercion {:input {:data (constantly nil)} 584 | :output (constantly nil)} 585 | :type-resolver default-type-resolver 586 | :meta {:interceptors interceptors 587 | :summary nil 588 | :description nil 589 | :no-doc nil}}) 590 | 591 | (s/defn dispatcher :- Dispatcher 592 | "Creates a Dispatcher" 593 | [options :- Options] 594 | (let [options (kc/deep-merge-map-like +default-options+ options) 595 | handlers (collect-and-enrich options)] 596 | (map->Dispatcher 597 | (merge 598 | (select-keys options [:context :coercion :meta]) 599 | {:handlers handlers})))) 600 | 601 | (s/defn transform-handlers 602 | "Applies f to all handlers. If the call returns nil, 603 | the handler is removed." 604 | [dispatcher :- Dispatcher, f :- Function] 605 | (update-in dispatcher [:handlers] (fn [handlers] 606 | (->> handlers 607 | (p/map-vals f) 608 | (filter (p/fn-> second)) 609 | (into (empty handlers)))))) 610 | 611 | (s/defn inject 612 | "Injects handlers into an existing Dispatcher" 613 | [dispatcher :- Dispatcher, handlers :- (s/constrained s/Any (complement nil?) 'not-nil)] 614 | (if handlers 615 | (let [handler (collect-and-enrich 616 | (merge dispatcher {:handlers handlers :type-resolver any-type-resolver}))] 617 | (update-in dispatcher [:handlers] merge handler)))) 618 | -------------------------------------------------------------------------------- /modules/kekkonen-core/src/kekkonen/cqrs.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.cqrs 2 | (:require [kekkonen.core :as k] 3 | [kekkonen.api :as ka] 4 | [kekkonen.common :as kc] 5 | [ring.util.http-response :as hr] 6 | [ring.util.http-status :as hs] 7 | [ring.util.http-predicates :as hp] 8 | [schema.core :as s])) 9 | 10 | ;; 11 | ;; response wrappers 12 | ;; 13 | 14 | (def success hr/ok) 15 | (def failure hr/bad-request) 16 | (def error hr/internal-server-error) 17 | 18 | (def failure! hr/bad-request!) 19 | (def error! hr/internal-server-error!) 20 | 21 | (def success-status hs/ok) 22 | (def failure-status hs/bad-request) 23 | (def error-status hs/internal-server-error) 24 | 25 | (def success? hp/ok?) 26 | (def failure? hp/bad-request?) 27 | (def error? hp/internal-server-error?) 28 | 29 | ;; 30 | ;; Actions 31 | ;; 32 | 33 | (s/defn command 34 | ([meta :- k/KeywordMap] 35 | (command (dissoc meta :handle) (:handle meta))) 36 | ([meta :- k/KeywordMap, f :- k/Function] 37 | (k/handler (merge meta {:type :command}) f))) 38 | 39 | (s/defn query 40 | ([meta :- k/KeywordMap] 41 | (query (dissoc meta :handle) (:handle meta))) 42 | ([meta :- k/KeywordMap, f :- k/Function] 43 | (k/handler (merge meta {:type :query}) f))) 44 | 45 | ;; 46 | ;; api 47 | ;; 48 | 49 | (defn cqrs-api [options] 50 | (ka/api 51 | (kc/deep-merge-map-like 52 | {:core {:type-resolver (k/type-resolver :command :query)} 53 | :swagger {:data {:info {:title "Kekkonen CQRS API"}}} 54 | :ring {:types {:query {:methods #{:get} 55 | :parameters {[:data] [:request :query-params]}} 56 | :command {:methods #{:post} 57 | :parameters {[:data] [:request :body-params]}}}}} 58 | options))) 59 | -------------------------------------------------------------------------------- /modules/kekkonen-core/src/kekkonen/http.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.http 2 | (:require [kekkonen.core :as k] 3 | [kekkonen.api :as ka] 4 | [kekkonen.common :as kc] 5 | [schema.core :as s])) 6 | 7 | (s/defn http-api [options] 8 | (ka/api 9 | (kc/deep-merge-map-like 10 | {:core {:type-resolver (k/type-resolver :get :head :patch :delete :options :post :put :any)} 11 | :swagger {:data {:info {:title "Kekkonen HTTP API"}}} 12 | :ring {:types {:get {:methods #{:get}} 13 | :head {:methods #{:head}} 14 | :patch {:methods #{:patch}} 15 | :delete {:methods #{:delete}} 16 | :options {:methods #{:options}} 17 | :post {:methods #{:post}} 18 | :put {:methods #{:put}} 19 | :any {:methods #{:get :head :patch :delete :options :post :put}} 20 | :handler {:methods #{:post} 21 | :parameters {[:data] [:request :body-params]}}}}} 22 | options))) 23 | -------------------------------------------------------------------------------- /modules/kekkonen-core/src/kekkonen/impl/logging.clj: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc kekkonen.impl.logging 2 | "Internal Kekkonen logging utility" 3 | (:require [clojure.string :as str])) 4 | 5 | ;; Cursive-users 6 | (declare log!) 7 | 8 | ;; use c.t.l logging if available, default to console logging 9 | (if (find-ns 'clojure.tools.logging) 10 | (eval 11 | `(do 12 | (require 'clojure.tools.logging) 13 | (defmacro ~'log! [& ~'args] 14 | `(do 15 | (clojure.tools.logging/log ~@~'args))))) 16 | (let [log (fn [level more] (println (.toUpperCase (name level)) (str/join " " more)))] 17 | (defn log! [level x & more] 18 | (if (instance? Throwable x) 19 | (do 20 | (log level more) 21 | (.printStackTrace x)) 22 | (log level (into [x] more)))))) 23 | -------------------------------------------------------------------------------- /modules/kekkonen-core/src/kekkonen/interceptor.clj: -------------------------------------------------------------------------------- 1 | ;; ns partially copy-pasted from pedestal. Will be merged later. 2 | (ns kekkonen.interceptor 3 | (:import [clojure.lang PersistentQueue] 4 | [java.util.concurrent.atomic AtomicLong])) 5 | 6 | (def ^:private ^AtomicLong execution-id (AtomicLong.)) 7 | 8 | (defn- interceptor-name [interceptor] 9 | (get interceptor :name (pr-str interceptor))) 10 | 11 | (defn- begin [context] 12 | (if (contains? context ::execution-id) 13 | context 14 | (let [execution-id (.incrementAndGet execution-id)] 15 | (assoc context ::execution-id execution-id)))) 16 | 17 | (defn- end [context] 18 | (if (contains? context ::execution-id) 19 | (dissoc context ::stack ::execution-id) 20 | context)) 21 | 22 | (defn- throwable->ex-info [^Throwable t execution-id interceptor stage] 23 | (ex-info (str "Interceptor Exception: " (.getMessage t)) 24 | (merge {:execution-id execution-id 25 | :stage stage 26 | :interceptor (interceptor-name interceptor) 27 | :exception-type (keyword (pr-str (type t))) 28 | :exception t} 29 | (ex-data t)) 30 | t)) 31 | 32 | (defn- try-f [context interceptor stage] 33 | (if-let [f (get interceptor stage)] 34 | (try 35 | (f context) 36 | (catch Throwable t 37 | (assoc context ::error (throwable->ex-info t (::execution-id context) interceptor stage)))) 38 | context)) 39 | 40 | (defn- enter-all [context] 41 | (loop [context context] 42 | (let [queue (::queue context) 43 | stack (::stack context)] 44 | (if (empty? queue) 45 | context 46 | (let [interceptor (peek queue) 47 | context (-> context 48 | (assoc ::queue (pop queue)) 49 | (assoc ::stack (conj stack interceptor)) 50 | (try-f interceptor :enter))] 51 | (cond 52 | (::error context) (dissoc context ::queue) 53 | true (recur context))))))) 54 | 55 | (defn- try-error [context interceptor] 56 | (let [execution-id (::execution-id context)] 57 | (if-let [error-fn (get interceptor :error)] 58 | (let [ex (::error context)] 59 | (try 60 | (error-fn (dissoc context ::error) ex) 61 | (catch Throwable t 62 | (if (identical? (type t) (type (:exception ex))) 63 | context 64 | (-> context 65 | (assoc ::error (throwable->ex-info t execution-id interceptor :error)) 66 | (update-in [::suppressed] conj ex)))))) 67 | context))) 68 | 69 | (defn- leave-all [context] 70 | (loop [context context] 71 | (let [stack (::stack context)] 72 | (if (empty? stack) 73 | context 74 | (let [interceptor (peek stack) 75 | context (assoc context ::stack (pop stack)) 76 | context (if (::error context) 77 | (try-error context interceptor) 78 | (try-f context interceptor :leave))] 79 | (recur context)))))) 80 | 81 | ;; 82 | ;; Public api 83 | ;; 84 | 85 | (defn interceptor? [x] 86 | (if-let [int-vals (vals (select-keys x [:enter :leave :error]))] 87 | (and (some identity int-vals) 88 | (every? fn? (remove nil? int-vals)) 89 | (or (interceptor-name x) true) 90 | true) 91 | false)) 92 | 93 | (defn enqueue [context interceptors] 94 | (update context ::queue 95 | (fnil into PersistentQueue/EMPTY) 96 | interceptors)) 97 | 98 | (defn terminate [context] 99 | (dissoc context ::queue)) 100 | 101 | (defn execute [context] 102 | (let [context (some-> context 103 | begin 104 | enter-all 105 | terminate 106 | leave-all 107 | end)] 108 | (if-let [ex (::error context)] 109 | (throw ex) 110 | context))) 111 | -------------------------------------------------------------------------------- /modules/kekkonen-core/src/kekkonen/middleware.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.middleware 2 | (:require ring.middleware.http-response 3 | [ring.util.http-response :as r] 4 | [ring.middleware.keyword-params :refer [wrap-keyword-params]] 5 | [ring.middleware.nested-params :refer [wrap-nested-params]] 6 | [ring.middleware.params :refer [wrap-params]] 7 | [slingshot.slingshot :as slingshot] 8 | [kekkonen.common :as kc] 9 | [kekkonen.impl.logging :as logging] 10 | [muuntaja.core :as muuntaja] 11 | [muuntaja.middleware] 12 | [clojure.walk :as walk] 13 | [schema.utils :as su] 14 | [schema.core :as s]) 15 | (:import [com.fasterxml.jackson.core JsonParseException] 16 | [org.yaml.snakeyaml.parser ParserException] 17 | [schema.utils ValidationError NamedError])) 18 | 19 | ;; 20 | ;; Exceptions handling 21 | ;; 22 | 23 | (defn- safe-handler 24 | "Prints stacktrace to console and returns safe error response. 25 | Error response only contains class of the Exception so that it won't accidentally 26 | expose secret details." 27 | [^Exception e _ _] 28 | (logging/log! :error e (.getMessage e)) 29 | (r/internal-server-error {:type "unknown-exception" 30 | :class (.getName (.getClass e))})) 31 | 32 | (defn stringify 33 | "Stringifies symbols and validation errors in Schema error, keeping the structure intact." 34 | [error] 35 | (walk/postwalk 36 | (fn [x] 37 | (cond 38 | (instance? ValidationError x) (str (su/validation-error-explain x)) 39 | (instance? NamedError x) (str (su/named-error-explain x)) 40 | (symbol? x) (str x) 41 | :else x)) 42 | error)) 43 | 44 | (defn coerce-error-handler [f] 45 | (fn [_ data _] 46 | (f (-> data 47 | (select-keys [:value :type :error :in #_:execution-id #_:stage]) 48 | (update-in [:error] #(stringify %)))))) 49 | 50 | (def ^:private missing-route-handler (constantly (r/not-found))) 51 | (def ^:private request-validation-handler (coerce-error-handler r/bad-request)) 52 | (def ^:private response-validation-handler (coerce-error-handler r/internal-server-error)) 53 | 54 | (defn- request-parsing-handler 55 | [^Exception ex _ _] 56 | (let [cause (.getCause ex)] 57 | (r/bad-request {:type (cond 58 | (instance? JsonParseException cause) "json-parse-exception" 59 | (instance? ParserException cause) "yaml-parse-exception" 60 | :else "parse-exception") 61 | :message (.getMessage cause)}))) 62 | 63 | (defn wrap-exceptions 64 | "Catches all exceptions and delegates to right error handler accoring to :type of Exceptions 65 | :handlers - a map from exception type to handler 66 | :default - default handler for everything no caught by handlers" 67 | [handler {:keys [handlers default]}] 68 | (let [default-handler (or default safe-handler)] 69 | (assert (fn? default-handler) "Default exception handler must be a function.") 70 | (fn [request] 71 | (slingshot/try+ 72 | (handler request) 73 | (catch (get % :type) {:keys [type] :as data} 74 | (let [handler (get handlers type default-handler)] 75 | (handler (:throwable &throw-context) data request))) 76 | (catch Object _ 77 | (default-handler (:throwable &throw-context) nil request)))))) 78 | 79 | ;; 80 | ;; Muuntaja stuff 81 | ;; 82 | 83 | (defn create-muuntaja [options] 84 | (if options 85 | (muuntaja.core/create 86 | (-> 87 | (if (= ::defaults options) 88 | muuntaja.core/default-options 89 | options))))) 90 | ;; 91 | ;; Keyword params 92 | ;; 93 | 94 | (defn wrap-keyword-keys [handler path] 95 | (fn [request] 96 | (handler (update-in request path walk/keywordize-keys)))) 97 | 98 | ;; 99 | ;; Not Found 100 | ;; 101 | 102 | (defn wrap-not-found [handler f] 103 | (fn [request] 104 | (let [response (handler request)] 105 | (if (and (not response) f) 106 | (f request) 107 | response)))) 108 | 109 | ;; 110 | ;; api info 111 | ;; 112 | 113 | (s/defn api-info [options] 114 | {:produces (some-> options :formats :produces) 115 | :consumes (some-> options :formats :consumes)}) 116 | 117 | ;; 118 | ;; Api Middleware 119 | ;; 120 | 121 | (def +default-options+ 122 | {:formats ::defaults 123 | :not-found missing-route-handler 124 | :exceptions {:default safe-handler 125 | :handlers {:kekkonen.core/dispatch missing-route-handler 126 | :kekkonen.core/request request-validation-handler 127 | :kekkonen.core/response response-validation-handler 128 | ::muuntaja/decode request-parsing-handler 129 | :kekkonen.ring/parsing request-parsing-handler 130 | :kekkonen.ring/request request-validation-handler 131 | :kekkonen.ring/response response-validation-handler}}}) 132 | 133 | (defn wrap-api 134 | "Opinionated chain of middlewares for web apis. Takes options-map to configure 135 | all the needed middlewares. See details and defaults from the source. 136 | 137 | Accepts the following options: 138 | 139 | - :exceptions options for kekkonen.core/wrap-exceptions 140 | - :handlers - map of type->exception-handler for exceptions. exception-handlers 141 | take 3 arguments: the exception, ExceptionInfo data and the originating request. 142 | tip: to catch normal Schema errors use :schema.core/error as type 143 | 144 | - :not-found a function request=>response to handle nil responses 145 | 146 | - :formats value should be :muuntaja.middleware/defaults (default), Muuntaja options 147 | map or a created Muuntaja. See Muuntaja wiki for details: 148 | https://github.com/metosin/muuntaja/wiki/Configuration" 149 | ([handler] 150 | (wrap-api handler {})) 151 | ([handler options] 152 | 153 | (assert 154 | (not (contains? options :format)) 155 | (str "ERROR: Option [:format] is not used with 0.4.0 or later. Kekkonen uses now Muuntaja insted of" 156 | "ring-middleware-format and the new formatting options for it should be under [:formats]. See " 157 | "'(doc kekkonen.middleware/wrap-api)' for more details.")) 158 | 159 | (let [options (kc/deep-merge +default-options+ options) 160 | {:keys [exceptions formats]} options 161 | muuntaja (create-muuntaja formats)] 162 | (-> handler 163 | ring.middleware.http-response/wrap-http-response 164 | (wrap-not-found (:not-found options)) 165 | (muuntaja.middleware/wrap-format-request muuntaja) 166 | (wrap-exceptions exceptions) 167 | (muuntaja.middleware/wrap-format-response muuntaja) 168 | (muuntaja.middleware/wrap-format-negotiate muuntaja) 169 | (wrap-keyword-keys [:query-params]) 170 | wrap-keyword-params 171 | wrap-nested-params 172 | wrap-params)))) 173 | -------------------------------------------------------------------------------- /modules/kekkonen-core/src/kekkonen/ring.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.ring 2 | (:require [schema.core :as s] 3 | [ring.swagger.coerce :as rsc] 4 | [kekkonen.core :as k] 5 | [kekkonen.common :as kc] 6 | [clojure.string :as str] 7 | [ring.swagger.json-schema :as rsjs] 8 | [ring.util.http-response :refer [ok]] 9 | [plumbing.core :as p] 10 | [plumbing.map :as pm] 11 | [kekkonen.interceptor :as interceptor]) 12 | (:import [kekkonen.core Dispatcher])) 13 | 14 | (def ^:private mode-parameter "kekkonen.mode") 15 | 16 | (s/defschema Options 17 | {:types {s/Keyword {:methods #{s/Keyword} 18 | (s/optional-key :parameters) {[s/Keyword] [s/Keyword]} 19 | (s/optional-key :allow-method-override?) s/Bool}} 20 | :coercion {s/Keyword k/Function} 21 | :interceptors [k/InterceptorLike]}) 22 | 23 | (s/def +default-options+ :- Options 24 | ; TODO: no types in default bindings? 25 | ; TODO: add type-resolver? 26 | {:types {::handler {:methods #{:post} 27 | :allow-method-override? true 28 | :parameters {[:data] [:request :body-params]}} 29 | :handler {:methods #{:post} 30 | :parameters {[:data] [:request :body-params]}}} 31 | :coercion {:query-params rsc/query-schema-coercion-matcher 32 | :path-params rsc/query-schema-coercion-matcher 33 | :form-params rsc/query-schema-coercion-matcher 34 | :header-params rsc/query-schema-coercion-matcher 35 | :multipart-params rsc/query-schema-coercion-matcher 36 | :body-params rsc/json-schema-coercion-matcher} 37 | :interceptors []}) 38 | 39 | (def +ring-dispatcher-options+ 40 | {:coercion {:input nil 41 | :output nil} 42 | :meta {::disable-mode nil 43 | ::method nil 44 | ::consumes nil 45 | ::produces nil 46 | :responses nil}}) 47 | 48 | ;; 49 | ;; Internals 50 | ;; 51 | 52 | (defn- handler-uri [handler] 53 | (str 54 | (if-let [ns (some-> handler :ns name)] 55 | (str "/" (str/replace ns #"\." "/"))) 56 | "/" (name (:name handler)))) 57 | 58 | (defn- ring-coercion [parameters coercion] 59 | (if coercion 60 | (let [coercions (pm/unflatten 61 | (for [[k matcher] coercion 62 | :when matcher] 63 | [[:request k] (fn [schema value] 64 | (k/coerce! schema matcher (or value {}) k ::request))]))] 65 | (k/coercion 66 | (if parameters 67 | (reduce kc/copy-to-from coercions parameters) 68 | coercions))))) 69 | 70 | (defn- ring-input-schema [input parameters] 71 | (if parameters 72 | (reduce kc/move-from-to input parameters) 73 | input)) 74 | 75 | (defn- attach-mode-parameter [schema] 76 | (let [key (s/optional-key mode-parameter) 77 | value (rsjs/describe (s/enum "invoke" "validate") "mode" :default "invoke") 78 | extra-keys-schema (s/find-extra-keys-schema (get-in schema [:request :header-params]))] 79 | (update-in schema [:request :header-params] merge {key value} (if-not extra-keys-schema {s/Any s/Any})))) 80 | 81 | (defn- request-mode [request] 82 | (if (= "validate" (-> request :headers (get mode-parameter))) 83 | :validate :invoke)) 84 | 85 | (defn- attach-ring-meta [options handler] 86 | (let [{:keys [parameters allow-method-override?] :as type-config} (get (:types options) (:type handler)) 87 | coercion (:coercion options) 88 | method (some-> handler :meta ::method) 89 | methods (if (and allow-method-override? method) 90 | (conj #{} method) 91 | (:methods type-config)) 92 | input-schema (-> (:input handler) 93 | (ring-input-schema parameters) 94 | (cond-> (not (get-in handler [:meta ::disable-mode])) attach-mode-parameter)) 95 | meta {:type-config type-config 96 | :methods methods 97 | :coercion (ring-coercion parameters coercion) 98 | :uri (handler-uri handler) 99 | :input input-schema}] 100 | (assoc handler :ring meta))) 101 | 102 | (defn- uri-without-context 103 | "Extracts the uri from the request but dropping the context" 104 | [{:keys [^String uri ^String context]}] 105 | (if (and context (.startsWith uri context)) 106 | (.substring uri (.length context)) 107 | uri)) 108 | 109 | (defn- copy-parameters [ctx parameters] 110 | (reduce-kv 111 | (fn [acc to from] 112 | (let [value (get-in acc from)] 113 | (assoc-in acc to value))) 114 | ctx 115 | parameters)) 116 | 117 | (defn- prepare [handler] 118 | (let [parameters (-> handler :ring :type-config :parameters) 119 | coercion (-> handler :ring :coercion)] 120 | {:enter (fn [ctx] 121 | (-> ctx 122 | (assoc ::k/coercion coercion) 123 | (copy-parameters parameters)))})) 124 | 125 | (defn- clean-context [context] 126 | (-> context 127 | (kc/dissoc-in [:request :query-params :kekkonen.action]) 128 | (kc/dissoc-in [:request :query-params :kekkonen.mode]) 129 | (kc/dissoc-in [:request :query-params :kekkonen.ns]))) 130 | 131 | ;; 132 | ;; Response Coercion 133 | ;; 134 | 135 | (defn- get-response-schema [responses status] 136 | (or (-> responses (get status) :schema) 137 | (-> responses :default :schema))) 138 | 139 | (defn- coerce-response [response responses matcher] 140 | (let [status (get response :status 200)] 141 | (if-let [schema (get-response-schema responses status)] 142 | (let [coerced (k/coerce! schema matcher (:body response) :response ::response)] 143 | (assoc response :body coerced)) 144 | response))) 145 | 146 | (defn- response-coercer [handler options] 147 | (let [responses (-> handler :meta :responses) 148 | coerce #(coerce-response % responses options)] 149 | {:leave (fn [ctx] 150 | (if (not= :invoke (::k/mode ctx)) 151 | (update ctx :response ok) 152 | (update ctx :response coerce)))})) 153 | 154 | ;; 155 | ;; Special endpoints 156 | ;; 157 | 158 | (def +kekkonen-handlers+ 159 | {:kekkonen 160 | [(k/handler 161 | {:name "handler" 162 | :type ::handler 163 | ::disable-mode true 164 | ::method :get 165 | :input {:request 166 | {:query-params 167 | {(s/optional-key :kekkonen.action) s/Keyword 168 | s/Keyword s/Any} 169 | s/Keyword s/Any} 170 | s/Keyword s/Any} 171 | :description "Returns a handler info or nil." 172 | :handle (fn [{{{action :kekkonen.action} :query-params} :request :as context}] 173 | (ok (k/public-handler 174 | (k/some-handler 175 | (k/get-dispatcher context) 176 | action))))}) 177 | (k/handler 178 | {:name "handlers" 179 | :type ::handler 180 | ::disable-mode true 181 | ::method :get 182 | :input {:request 183 | {:query-params 184 | {(s/optional-key :kekkonen.ns) s/Keyword 185 | s/Keyword s/Any} 186 | s/Keyword s/Any} 187 | s/Keyword s/Any} 188 | :description "Return a list of available handlers from kekkonen.ns namespace" 189 | :handle (fn [{{{ns :kekkonen.ns} :query-params} :request :as context}] 190 | (ok (-> context 191 | k/get-dispatcher 192 | (k/available-handlers ns (clean-context context)) 193 | (->> (filter (p/fn-> :ring)) 194 | (remove (p/fn-> :ns (= :kekkonen))) 195 | (remove (p/fn-> :meta :no-doc)) 196 | (map k/public-handler)))))}) 197 | (k/handler 198 | {:name "actions" 199 | :type ::handler 200 | ::disable-mode true 201 | ::method :post 202 | :input {:request 203 | {:body-params {s/Keyword s/Any} 204 | :query-params 205 | {(s/optional-key :kekkonen.ns) s/Keyword 206 | (s/optional-key :kekkonen.mode) (with-meta 207 | (s/enum :check :validate) 208 | {:json-schema {:default :check}}) 209 | s/Keyword s/Any} 210 | s/Keyword s/Any} 211 | s/Keyword s/Any} 212 | :description "Return a map of action -> error of all available handlers" 213 | :handle (fn [{{{mode :kekkonen.mode ns, :kekkonen.ns} :query-params} :request :as context}] 214 | (ok (-> context 215 | k/get-dispatcher 216 | (k/dispatch-handlers (or mode :check) ns (clean-context context)) 217 | (->> (filter (p/fn-> first :ring)) 218 | (remove (p/fn-> first :ns (= :kekkonen))) 219 | (remove (p/fn-> first :meta :no-doc)) 220 | (map (fn [[k v]] [(:action k) (k/stringify-schema v)])) 221 | (into {})))))})]}) 222 | 223 | ;; 224 | ;; Public api 225 | ;; 226 | 227 | (s/defn ring-handler 228 | "Creates a ring handler from Dispatcher and options." 229 | ([dispatcher :- Dispatcher] 230 | (ring-handler dispatcher {})) 231 | ([dispatcher :- Dispatcher, options :- k/KeywordMap] 232 | (let [options (-> (kc/deep-merge-map-like +default-options+ options) 233 | (update :interceptors (partial mapv k/interceptor))) 234 | dispatcher (k/transform-handlers dispatcher (partial attach-ring-meta options)) 235 | router (p/for-map [handler (k/all-handlers dispatcher nil) 236 | :let [interceptors (kc/join 237 | (prepare handler) 238 | (:interceptors options) 239 | (response-coercer handler options))]] 240 | (-> handler :ring :uri) [handler interceptors])] 241 | ;; the ring handler 242 | (fn [{:keys [request-method] :as request}] 243 | ;; match a handlers based on uri and context 244 | (if-let [[{:keys [action ring]} interceptors] (router (uri-without-context request))] 245 | ;; only allow calls to ring-mapped handlers with matching method 246 | (if ((:methods ring) request-method) 247 | (let [mode (request-mode request)] 248 | (-> {:request request} 249 | (interceptor/enqueue interceptors) 250 | (->> (k/dispatch dispatcher mode action)))))))))) 251 | 252 | ;; 253 | ;; Routing 254 | ;; 255 | 256 | (s/defn routes :- k/Function 257 | "Creates a ring handler of multiples handlers, matches in order." 258 | [ring-handlers :- [(s/maybe k/Function)]] 259 | (apply some-fn (keep identity ring-handlers))) 260 | 261 | (s/defn match 262 | "Creates a ring-handler for given uri & request-method" 263 | ([match-uri ring-handler] 264 | (match match-uri identity ring-handler)) 265 | ([match-uri match-request-method ring-handler] 266 | (fn [{:keys [uri request-method] :as request}] 267 | (if (and (= match-uri uri) 268 | (match-request-method request-method)) 269 | (ring-handler request))))) 270 | -------------------------------------------------------------------------------- /modules/kekkonen-core/src/kekkonen/swagger.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.swagger 2 | (:require [schema.core :as s] 3 | [ring.swagger.swagger2 :as rs2] 4 | [ring.util.http-response :refer [ok]] 5 | [ring.swagger.swagger-ui :as ui] 6 | [kekkonen.core :as k] 7 | [kekkonen.common :as kc] 8 | [plumbing.core :as p] 9 | [kekkonen.ring :as ring])) 10 | 11 | (s/defschema Options 12 | {(s/optional-key :ui) (s/maybe s/Str) 13 | (s/optional-key :spec) (s/maybe s/Str) 14 | (s/optional-key :data) k/KeywordMap 15 | (s/optional-key :options) {(s/optional-key :ui) k/KeywordMap 16 | (s/optional-key :spec) k/KeywordMap}}) 17 | 18 | (defn transform-handler 19 | "Transforms a handler into ring-swagger path->method->operation map." 20 | [handler] 21 | (let [{:keys [description ns ring] {:keys [summary responses ::ring/produces ::ring/consumes no-doc]} :meta} handler 22 | {:keys [parameters input methods uri]} ring 23 | ;; copy back the mappings to get right request requirements 24 | input (reduce kc/copy-from-to input parameters) 25 | {:keys [body-params query-params path-params header-params multipart-params]} (:request input)] 26 | 27 | ;; discard handlers with :no-doc or without :ring metadata 28 | (if (and (not no-doc) ring) 29 | {uri (p/for-map [method (sort methods)] 30 | method (merge 31 | (if ns {:tags [ns]}) 32 | (if description {:description description 33 | :summary description}) 34 | (if summary {:summary summary}) 35 | (if responses {:responses responses}) 36 | (if produces {:produces produces}) 37 | (if consumes {:consumes consumes}) 38 | {:parameters (kc/strip-nil-values 39 | {:body body-params 40 | :query query-params 41 | :path path-params 42 | :header header-params 43 | :formData multipart-params})}))}))) 44 | 45 | (s/defn ring-swagger :- rs2/Swagger 46 | "Creates a ring-swagger object out of handlers and extra info" 47 | [handlers info] 48 | (merge info {:paths (apply merge (map transform-handler handlers))})) 49 | 50 | (s/defn swagger-object 51 | "Creates a Swagger-spec object out of ring-swagger object and ring-swagger options." 52 | [ring-swagger :- rs2/Swagger, options :- k/KeywordMap] 53 | (rs2/swagger-json ring-swagger options)) 54 | 55 | (s/defn swagger-ui 56 | "Ring handler for the Swagger UI" 57 | [{:keys [ui spec] :as options}] 58 | (when ui 59 | (ui/swagger-ui (merge {:path ui 60 | :swagger-docs spec} 61 | (-> options :options :ui))))) 62 | 63 | (defn- add-base-path 64 | "Extracts the base path from the context and adds it to the swagger map as basePath" 65 | [{:keys [context]} swagger] 66 | (if context 67 | (assoc swagger :basePath context) 68 | swagger)) 69 | 70 | (defn swagger-handler 71 | "Creates a handler, that serves the swagger-spec" 72 | [swagger options] 73 | (if-let [spec (:spec options)] 74 | (k/handler 75 | {:type :kekkonen.ring/handler 76 | :kekkonen.ring/method :get 77 | :name spec 78 | :no-doc true 79 | :handle (fn [{:keys [request] :as context}] 80 | (let [dispatcher (k/get-dispatcher context) 81 | ns (some-> context :request :query-params :ns str keyword) 82 | handlers (k/available-handlers dispatcher ns (#'ring/clean-context context))] 83 | (ok (swagger-object 84 | (add-base-path request (ring-swagger handlers swagger)) 85 | (-> options :options :spec)))))}))) 86 | -------------------------------------------------------------------------------- /modules/kekkonen-core/src/kekkonen/upload.clj: -------------------------------------------------------------------------------- 1 | ;; Original: https://github.com/metosin/ring-swagger/blob/master/src/ring/swagger/upload.clj 2 | (ns kekkonen.upload 3 | (:require [schema.core :as s] 4 | [ring.swagger.json-schema :as js] 5 | [ring.middleware.multipart-params :as multipart-params] 6 | [clojure.walk :as walk]) 7 | (:import [java.io File ByteArrayInputStream])) 8 | 9 | (defn multipart-params 10 | ([] 11 | (multipart-params {})) 12 | ([options] 13 | {:enter (fn [ctx] 14 | (update 15 | ctx 16 | :request 17 | (fn [request] 18 | (-> request 19 | (multipart-params/multipart-params-request options) 20 | (update :multipart-params walk/keywordize-keys)))))})) 21 | 22 | (defrecord Upload [m] 23 | 24 | s/Schema 25 | (spec [_] 26 | (s/spec m)) 27 | (explain [_] 28 | (cons 'file m)) 29 | 30 | js/JsonSchema 31 | (convert [_ _] 32 | {:type "file"})) 33 | 34 | (def TempFileUpload 35 | "Schema for file param created by ring.middleware.multipart-params.temp-file store." 36 | (->Upload {:filename s/Str 37 | :content-type s/Str 38 | :size s/Int 39 | (s/optional-key :tempfile) File})) 40 | 41 | (def ByteArrayUpload 42 | "Schema for file param created by ring.middleware.multipart-params.byte-array store." 43 | (->Upload {:filename s/Str 44 | :content-type s/Str 45 | :bytes s/Any})) 46 | 47 | (defn response 48 | "Returns a file response out of File or byte[] content" 49 | ([content content-type] 50 | (response content content-type nil)) 51 | ([content content-type filename] 52 | (let [body (if (instance? File content) content (ByteArrayInputStream. content))] 53 | {:status 200 54 | :headers (merge 55 | {"Content-Type" content-type} 56 | (if filename 57 | {"Content-Disposition" (str "inline; filename=\"" filename "\"")})) 58 | :body body}))) 59 | -------------------------------------------------------------------------------- /modules/kekkonen/project.clj: -------------------------------------------------------------------------------- 1 | (defproject metosin/kekkonen "0.5.3-SNAPSHOT" 2 | :description "A lightweight, remote api library for Clojure." 3 | :url "https://github.com/metosin/kekkonen" 4 | :license {:name "Eclipse Public License" :url "http://www.eclipse.org/legal/epl-v10.html"} 5 | :scm {:name "git" 6 | :url "https://github.com/metosin/kekkonen" 7 | :dir "../.."} 8 | :plugins [[lein-parent "0.3.4"]] 9 | :parent-project {:path "../../project.clj" 10 | :inherit [:deploy-repositories :managed-dependencies]} 11 | :dependencies [[metosin/kekkonen-core]]) 12 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject metosin/kekkonen-parent "0.5.3-SNAPSHOT" 2 | :description "A lightweight, remote api library for Clojure." 3 | :url "https://github.com/metosin/kekkonen" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v20.html"} 6 | :scm {:name "git" 7 | :url "https://github.com/metosin/kekkonen"} 8 | 9 | :managed-dependencies [[metosin/kekkonen "0.5.3-SNAPSHOT"] 10 | [metosin/kekkonen-core "0.5.3-SNAPSHOT"] 11 | 12 | [prismatic/plumbing "0.5.4"] 13 | [prismatic/schema "1.1.6"] 14 | [frankiesardo/linked "1.2.9"] 15 | 16 | ;; http-stuff, separate module? 17 | [clj-commons/clj-yaml "0.7.0"] 18 | [metosin/ring-swagger "0.24.0"] 19 | [metosin/ring-swagger-ui "2.2.10"] 20 | [metosin/ring-http-response "0.9.0"] 21 | [metosin/muuntaja "0.3.1"] 22 | [ring/ring-defaults "0.3.0"] 23 | 24 | ;; client stuff, separate module? 25 | [clj-http "2.3.0"]] 26 | :profiles {:dev {:plugins [[lein-cloverage "1.0.10"] 27 | [lein-midje "3.2.1"]] 28 | :source-paths ["dev-src" 29 | "modules/kekkonen-core/src"] 30 | :dependencies [[org.clojure/clojure "1.10.1"] 31 | [criterium "0.4.4"] 32 | [http-kit "2.3.0"] 33 | [midje "1.9.9"] 34 | 35 | [prismatic/plumbing] 36 | [prismatic/schema] 37 | [frankiesardo/linked] 38 | 39 | [clj-commons/clj-yaml] 40 | [metosin/muuntaja] 41 | [metosin/ring-http-response] 42 | [metosin/ring-swagger] 43 | [metosin/ring-swagger-ui] 44 | 45 | [clj-http] 46 | 47 | ; uploads 48 | [javax.servlet/servlet-api "2.5"]]} 49 | :perf {:jvm-opts ^:replace ["-Dclojure.compiler.direct-linking=true"]} 50 | :1.9 {:dependencies [[org.clojure/clojure "1.9.0"]]} 51 | :1.8 {:dependencies [[org.clojure/clojure "1.8.0"]]}} 52 | :deploy-repositories [["releases" :clojars]] 53 | :aliases {"all" ["with-profile" "dev:dev,1.8:dev,1.9"] 54 | "perf" ["with-profile" "default,dev,perf"] 55 | "test-ancient" ["midje"] 56 | "coverage" ["cloverage" "--runner" ":midje"]}) 57 | -------------------------------------------------------------------------------- /scripts/lein-modules: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | set -e 4 | 5 | # Modules 6 | for ext in kekkonen-core kekkonen; do 7 | cd modules/$ext; lein "$@"; cd ../..; 8 | done 9 | -------------------------------------------------------------------------------- /scripts/set-version: -------------------------------------------------------------------------------- 1 | #!/bin/zsh 2 | 3 | ext="sedbak$$" 4 | 5 | find . -name project.clj -exec sed -i.$ext "s/\[metosin\/kekkonen\(.*\) \".*\"\]/[metosin\/kekkonen\1 \"$1\"\]/g" '{}' \; 6 | find . -name project.clj -exec sed -i.$ext "s/defproject metosin\/kekkonen\(.*\) \".*\"/defproject metosin\/kekkonen\1 \"$1\"/g" '{}' \; 7 | sed -i.$ext "s/\[metosin\/kekkonen\(.*\) \".*\"\]/[metosin\/kekkonen\1 \"$1\"\]/g" **/*.md 8 | find . -name "*.$ext" -exec rm '{}' \; 9 | -------------------------------------------------------------------------------- /test/kekkonen/api_test.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.api-test 2 | (:require [midje.sweet :refer :all] 3 | [kekkonen.midje :refer :all] 4 | [ring.util.http-response :refer [ok]] 5 | [ring.util.http-predicates :refer [ok? not-found? bad-request?]] 6 | [plumbing.core :as p] 7 | [kekkonen.core :as k] 8 | [kekkonen.api :refer [api]] 9 | [schema.core :as s])) 10 | 11 | (p/defnk ^:handler plus [[:data x :- s/Int]] 12 | (ok {:result (inc x)})) 13 | 14 | (p/defnk ^:handler nada [] (ok)) 15 | 16 | (def secret-ns (k/namespace {:name :secret ::role :admin})) 17 | 18 | (defn require-role [role] 19 | (fn [context] 20 | (if (= (-> context :request :query-params ::role) role) 21 | context))) 22 | 23 | (facts "api-test" 24 | (let [app (api {:swagger {:ui "/api-docs" 25 | :spec "/swagger.json"} 26 | :core {:handlers {:api {:public [#'plus #'nada] 27 | secret-ns #'plus}} 28 | :meta {::role require-role}}})] 29 | 30 | (facts "without required roles" 31 | 32 | (fact "invalid handler" 33 | (fact "can't be validated" 34 | (let [response (app {:uri "/INVALID" 35 | :request-method :post 36 | :headers {"kekkonen.mode" "validate"}})] 37 | response => not-found? 38 | (parse response) => nil)) 39 | 40 | (fact "can't be invoked" 41 | (let [response (app {:uri "/INVALID" 42 | :request-method :post})] 43 | response => not-found? 44 | (parse response) => nil))) 45 | 46 | (fact "public handler" 47 | (fact "can be validated" 48 | (fact "with valid parameers" 49 | (let [response (app {:uri "/api/public/plus" 50 | :request-method :post 51 | :headers {"kekkonen.mode" "validate"} 52 | :body-params {:x 1}})] 53 | response => ok? 54 | (parse response) => nil)) 55 | 56 | (fact "with invalid parameters" 57 | (let [response (app {:uri "/api/public/plus" 58 | :request-method :post 59 | :headers {"kekkonen.mode" "validate"}})] 60 | response => bad-request? 61 | (parse response) => {:error {:x "missing-required-key"} 62 | :in "body-params" 63 | :type "kekkonen.ring/request" 64 | :value {}}))) 65 | 66 | (fact "can be invoked" 67 | (fact "with valid parameers" 68 | (let [response (app {:uri "/api/public/plus" 69 | :request-method :post 70 | :body-params {:x 1}})] 71 | response => ok? 72 | (parse response) => {:result 2})) 73 | 74 | (fact "with invalid parameters" 75 | (let [response (app {:uri "/api/public/plus" 76 | :request-method :post})] 77 | response => bad-request? 78 | (parse response) => {:error {:x "missing-required-key"} 79 | :in "body-params" 80 | :type "kekkonen.ring/request" 81 | :value {}}))))) 82 | 83 | (fact "secret handler" 84 | (fact "without role" 85 | (fact "can't be validated" 86 | (let [response (app {:uri "/api/secret/plus" 87 | :request-method :post 88 | :headers {"kekkonen.mode" "validate"}})] 89 | response => not-found? 90 | (parse response) => nil)) 91 | 92 | (fact "can't be invoked" 93 | (let [response (app {:uri "/api/secret/plus" 94 | :request-method :post})] 95 | response => not-found? 96 | (parse response) => nil))) 97 | 98 | (fact "with role" 99 | (fact "can be validated" 100 | (fact "with valid parameers" 101 | (let [response (app {:uri "/api/secret/plus" 102 | :request-method :post 103 | :headers {"kekkonen.mode" "validate"} 104 | :query-params {::role :admin} 105 | :body-params {:x 1}})] 106 | response => ok? 107 | (parse response) => nil)) 108 | 109 | (fact "with invalid parameters" 110 | (let [response (app {:uri "/api/secret/plus" 111 | :request-method :post 112 | :headers {"kekkonen.mode" "validate"} 113 | :query-params {::role :admin}})] 114 | response => bad-request? 115 | (parse response) => {:error {:x "missing-required-key"} 116 | :in "body-params" 117 | :type "kekkonen.ring/request" 118 | :value {}}))) 119 | 120 | (fact "can be invoked" 121 | (fact "with valid parameers" 122 | (let [response (app {:uri "/api/secret/plus" 123 | :request-method :post 124 | :query-params {::role :admin} 125 | :body-params {:x 1}})] 126 | response => ok? 127 | (parse response) => {:result 2})) 128 | 129 | (fact "with invalid parameters" 130 | (let [response (app {:uri "/api/secret/plus" 131 | :request-method :post 132 | :query-params {::role :admin}})] 133 | response => bad-request? 134 | (parse response) => {:error {:x "missing-required-key"} 135 | :in "body-params" 136 | :type "kekkonen.ring/request" 137 | :value {}}))))) 138 | 139 | (fact "kekkonen endpoints" 140 | (fact "get-handler" 141 | (let [response (app {:uri "/kekkonen/handler" 142 | :request-method :get 143 | :query-params {:kekkonen.action "api.public/plus"}})] 144 | response => ok? 145 | (parse response) => (contains 146 | {:action "api.public/plus"}))) 147 | 148 | (fact "available-handlers" 149 | (fact "without role" 150 | (let [response (app {:uri "/kekkonen/handlers" 151 | :request-method :get})] 152 | response => ok? 153 | (parse response) => (just [(contains {:action "api.public/plus"}) 154 | (contains {:action "api.public/nada"})] :in-any-order))) 155 | 156 | (fact "with role" 157 | (let [response (app {:uri "/kekkonen/handlers" 158 | :query-params {::role :admin} 159 | :request-method :get})] 160 | response => ok? 161 | (parse response) => (just [(contains {:action "api.public/plus"}) 162 | (contains {:action "api.public/nada"}) 163 | (contains {:action "api.secret/plus"})] :in-any-order)))) 164 | 165 | (fact "actions" 166 | (fact "without role" 167 | (let [response (app {:uri "/kekkonen/actions" 168 | :request-method :post})] 169 | response => ok? 170 | (parse response) => {:api.public/plus nil 171 | :api.public/nada nil})) 172 | 173 | (fact "with role" 174 | (let [response (app {:uri "/kekkonen/actions" 175 | :query-params {::role :admin} 176 | :request-method :post})] 177 | response => ok? 178 | (parse response) => {:api.public/plus nil 179 | :api.public/nada nil 180 | :api.secret/plus nil}) 181 | 182 | (fact "mode = check" 183 | (let [response (app {:uri "/kekkonen/actions" 184 | :query-params {::role :admin} 185 | :body-params {:kekkonen.mode :check} 186 | :request-method :post})] 187 | response => ok? 188 | (parse response) => {:api.public/plus nil 189 | :api.public/nada nil 190 | :api.secret/plus nil})) 191 | 192 | (fact "mode = validate" 193 | (let [response (app {:uri "/kekkonen/actions" 194 | :query-params {::role :admin 195 | :kekkonen.mode :validate} 196 | :request-method :post})] 197 | response => ok? 198 | (parse response) => (just 199 | {:api.public/plus map? 200 | :api.public/nada nil 201 | :api.secret/plus map?}))) 202 | 203 | (fact "invalid mode" 204 | (let [response (app {:uri "/kekkonen/actions" 205 | :query-params {::role :admin 206 | :kekkonen.mode :INVALID} 207 | :request-method :post})] 208 | response => bad-request? 209 | (parse response) => map?))))) 210 | 211 | (fact "swagger-object" 212 | (fact "without role" 213 | (let [response (app {:uri "/swagger.json" :request-method :get}) 214 | body (parse-swagger response)] 215 | response => ok? 216 | body => (contains 217 | {:swagger "2.0" 218 | :info {:title "Kekkonen API" 219 | :version "0.0.1"} 220 | :consumes (just 221 | ["application/json" 222 | "application/edn" 223 | "application/transit+json" 224 | "application/transit+msgpack"] 225 | :in-any-order) 226 | :produces (just 227 | ["application/json" 228 | "application/edn" 229 | "application/transit+json" 230 | "application/transit+msgpack"] 231 | :in-any-order) 232 | :definitions anything 233 | :paths (contains 234 | {"/api/public/plus" 235 | (just 236 | {:post 237 | (just 238 | {:parameters 239 | (just 240 | [(just 241 | {:in "body" 242 | :name anything 243 | :description "" 244 | :required true 245 | :schema (just {:$ref anything})}) 246 | (just 247 | {:in "header" 248 | :name "kekkonen.mode" 249 | :description "mode" 250 | :type "string" 251 | :enum ["invoke" "validate"] 252 | :default "invoke" 253 | :required false})] :in-any-order) 254 | :responses {:default 255 | {:description ""}} 256 | :tags ["api.public"]})})})}) 257 | 258 | (fact "there are extra (kekkonen) endpoints" 259 | body => (contains 260 | {:paths 261 | (just 262 | {"/api/public/plus" anything 263 | "/api/public/nada" anything 264 | "/kekkonen/handler" anything 265 | "/kekkonen/handlers" anything 266 | "/kekkonen/actions" anything})})) 267 | 268 | (fact "secret endpoints are not documented" 269 | body =not=> (contains 270 | {:paths 271 | (contains 272 | {"/api/secret/plus" anything})}))) 273 | 274 | (fact "with ns-filter" 275 | (let [response (app {:uri "/swagger.json" 276 | :request-method :get 277 | :query-params {::role :admin 278 | :ns "api.public"}}) 279 | body (parse-swagger response)] 280 | response => ok? 281 | body => (contains 282 | {:paths 283 | (just 284 | {"/api/public/plus" anything 285 | "/api/public/nada" anything})}))))) 286 | 287 | (fact "with role" 288 | (let [response (app {:uri "/swagger.json" 289 | :request-method :get 290 | :query-params {::role :admin}}) 291 | body (parse-swagger response)] 292 | response => ok? 293 | 294 | (fact "secret endpoints are also documented" 295 | body => (contains 296 | {:paths 297 | (contains 298 | {"/api/secret/plus" anything})})))) 299 | 300 | (fact "swagger-ui" 301 | (let [response (app {:uri "/api-docs" :request-method :get})] 302 | response => (contains 303 | {:status 302 304 | :body "" 305 | :headers (contains 306 | {"Location" "/api-docs/index.html"})}))))) 307 | 308 | (facts "swagger-options" 309 | 310 | (fact "ui & spec are not set by default" 311 | (let [app (api {:core {:handlers {:api #'plus}}})] 312 | 313 | (app {:uri "/swagger.json", :request-method :get}) => not-found? 314 | (app {:uri "/", :request-method :get}) => not-found?)) 315 | 316 | (fact "with ui & spec" 317 | (let [app (api {:swagger {:spec "/swagger.json", :ui "/api-docs"} 318 | :core {:handlers {:api #'plus}}})] 319 | 320 | (app {:uri "/swagger.json", :request-method :get}) => ok? 321 | (app {:uri "/api-docs/index.html", :request-method :get}) => ok?))) 322 | 323 | (facts "api-meta" 324 | (fact "meta can be presented as maps or vector of tuples" 325 | (api {:core {:handlers {secret-ns [#'nada]}, :meta {::role require-role}}}) 326 | (api {:core {:handlers {secret-ns [#'nada]}, :meta [[::role require-role]]}})) 327 | (fact "invalid meta causes creation-time exception" 328 | (api {:core {:handlers {secret-ns [#'nada]}, :meta {}}}) => (throws? {:name :nada, :invalid-keys [::role]}))) 329 | 330 | (fact "vector schemas, #27" 331 | (let [app (api {:core {:handlers {:api (k/handler 332 | {:name :vectorz 333 | :handle (p/fnk [data :- [{:kikka s/Str}]] 334 | (ok data))})}}})] 335 | (let [response (app {:uri "/api/vectorz" 336 | :request-method :post 337 | :body-params [{:kikka "kukka"}, {:kikka "kakka"}]})] 338 | response => ok? 339 | (parse response) => [{:kikka "kukka"}, {:kikka "kakka"}]))) 340 | -------------------------------------------------------------------------------- /test/kekkonen/common_test.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.common-test 2 | (:require [midje.sweet :refer :all] 3 | [kekkonen.common :as kc] 4 | [schema.core :as s] 5 | [linked.core :as linked] 6 | [plumbing.core :as p])) 7 | 8 | (defrecord ARecord []) 9 | 10 | (fact "map-like?" 11 | (kc/map-like? {:a 1}) => true 12 | (kc/map-like? [[:a 1]]) => true 13 | (kc/map-like? [[:a 1] [:b 2]]) => true 14 | (kc/map-like? [[:a 1] [:b 2] [:c 3 3]]) => false 15 | (kc/map-like? (->ARecord)) => true) 16 | 17 | (fact "merge-map-like" 18 | (kc/merge-map-like {:a 1 :b 2} [[:c 3] [:d 4]] {:e 5 :f 6} [[:g 7] [:h 8]]) 19 | => (linked/map :a 1 :b 2 :c 3 :d 4 :e 5 :f 6 :g 7 :h 8) 20 | 21 | (kc/merge-map-like [[:a 1] [:b 2]] {:c 3 :d 4} [[:e 5] [:f 6]] {:g 7 :h 8}) 22 | => (linked/map :a 1 :b 2 :c 3 :d 4 :e 5 :f 6 :g 7 :h 8)) 23 | 24 | (fact "deep-merge-map-like" 25 | (kc/deep-merge-map-like {:a 1 :b {:c [1] :d 2}} {:b {:c [2] :d 3 :e 4}}) => {:a 1 :b {:c [2] :d 3 :e 4}} 26 | (fact "can merge map-like values, keeping order" 27 | (kc/deep-merge-map-like {:a {:b 1 :c 2}} {:a [[:b 2] [:d 2]]}) => {:a {:b 2 :c 2 :d 2}})) 28 | 29 | (fact "deep-merge" 30 | (kc/deep-merge {:a 1 :b {:c [1] :d 2}} {:b {:c [2] :d 3 :e 4}}) => {:a 1 :b {:c [2] :d 3 :e 4}} 31 | (fact "can't merge map-like values" 32 | (kc/deep-merge {:a {:b 1 :c 2}} {:a [[:b 2] [:d 2]]}) => {:a [[:b 2] [:d 2]]})) 33 | 34 | (fact "deep-merge-from-to" 35 | (kc/deep-merge-from-to 36 | {:data {:x String} :request {:body-params {:y String}}} 37 | [[:data] [:request :body-params]]) 38 | => {:data {:x String} :request {:body-params {:x String, :y String}}} 39 | (fact "with non maps, data is overridden, #27" 40 | (kc/deep-merge-from-to 41 | {:data {:x String} :request {:body-params [{:y String}]}} 42 | [[:data] [:request :body-params]]) 43 | => {:data {:x String} :request {:body-params {:x String}}})) 44 | 45 | (fact "deep-merge-to-from" 46 | (kc/deep-merge-to-from 47 | {:data {:x String} :request {:body-params {:y String}}} 48 | [[:request :body-params] [:data]]) 49 | => {:data {:x String} :request {:body-params {:x String, :y String}}}) 50 | 51 | (fact "strip-nil-values" 52 | (kc/strip-nil-values {:a {:b {:c {:e nil}}, :b2 true}}) => {:a {:b2 true}}) 53 | 54 | (fact "copy-from-to" 55 | (kc/copy-from-to 56 | {:request {:body-params {:x String, :y String}}} 57 | [[:request :body-params] [:data]]) 58 | => {:request {:body-params {:x String, :y String}} 59 | :data {:x String, :y String}}) 60 | 61 | (fact "copy-to-fom" 62 | (kc/copy-to-from 63 | {:request {:body-params {:x String, :y String}}} 64 | [[:data] [:request :body-params]]) 65 | => {:request {:body-params {:x String, :y String}} 66 | :data {:x String, :y String}}) 67 | 68 | (fact "move-from-to" 69 | (kc/move-from-to 70 | {:request {:body-params {:x String, :y String}}} 71 | [[:request :body-params] [:data]]) 72 | => {:data {:x String, :y String}}) 73 | 74 | (fact "move-to-from" 75 | (kc/move-to-from 76 | {:data {:x String, :y String}} 77 | [[:request :body-params] [:data]]) 78 | => {:request {:body-params {:x String, :y String}}} 79 | 80 | (fact "will not copy nil data" 81 | (kc/move-to-from 82 | {:request {:body-params {:x String, :y String}}} 83 | [[:request :body-params] [:data]]) 84 | => {:request {:body-params {:x String, :y String}}})) 85 | 86 | (fact "merge-map-schemas" 87 | (kc/merge-map-schemas s/Any {:a s/Str}) => {:a s/Str} 88 | (kc/merge-map-schemas s/Any s/Any) => {} 89 | (kc/merge-map-schemas {:a s/Str} {:a {:b s/Str}}) => {:a {:b s/Str}}) 90 | 91 | (fact "any-map-schema?" 92 | (kc/any-map-schema? nil) => false 93 | (kc/any-map-schema? {:a s/Str}) => false 94 | (kc/any-map-schema? s/Any) => true 95 | (kc/any-map-schema? {s/Keyword s/Any}) => true) 96 | 97 | (p/defnk handler [[:data x :- s/Int] y :- s/Bool]) 98 | 99 | (fact "extracting schemas" 100 | (kc/extract-schema handler) => {:input {:data {:x s/Int, s/Keyword s/Any} 101 | :y s/Bool, s/Keyword s/Any} 102 | :output s/Any}) 103 | -------------------------------------------------------------------------------- /test/kekkonen/cqrs_test.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.cqrs-test 2 | (:require [kekkonen.cqrs :refer :all] 3 | [kekkonen.midje :refer :all] 4 | [midje.sweet :refer :all] 5 | [ring.util.http-response :refer [ok]] 6 | [ring.util.http-predicates :as http-predicates] 7 | [plumbing.core :as p] 8 | [clojure.set :as set])) 9 | 10 | ;; 11 | ;; Role interceptor 12 | ;; 13 | 14 | (defn require-roles [required] 15 | (fn [context] 16 | (let [roles (-> context :meta :roles)] 17 | (if (seq (set/intersection roles required)) 18 | context)))) 19 | 20 | (p/defnk ^:query get-items 21 | "Retrieves all" 22 | [[:components db]] 23 | (success @db)) 24 | 25 | (p/defnk ^:command add-item! 26 | "Adds an item to database" 27 | [[:data item :- String] 28 | [:components db]] 29 | (success (swap! db conj item))) 30 | 31 | (p/defnk ^:command reset-items! 32 | "Resets the database" 33 | {::roles #{:admin}} 34 | [[:components db]] 35 | (success (swap! db empty))) 36 | 37 | (facts "response codes" 38 | (success) => http-predicates/ok? 39 | (failure) => http-predicates/bad-request? 40 | (error) => http-predicates/internal-server-error?) 41 | 42 | (facts "commands & queries" 43 | (meta (command {:name 'kikka} identity)) => (contains {:type :command}) 44 | (meta (query {:name 'kikka} identity)) => (contains {:type :query})) 45 | 46 | (facts "cqrs-api" 47 | (let [app (cqrs-api 48 | {:core 49 | {:context {:components {:db (atom #{})}} 50 | :handlers {:api {:items [#'get-items 51 | #'add-item!] 52 | :items2 #'reset-items!}} 53 | :meta {::roles require-roles}}})] 54 | 55 | (fact "get-items" 56 | (let [response (app {:uri "/api/items/get-items" 57 | :request-method :get})] 58 | response => success? 59 | (parse response) => [])) 60 | 61 | (fact "add-item!" 62 | (let [response (app {:uri "/api/items/add-item!" 63 | :request-method :post 64 | :body-params {:item "kikka"}})] 65 | response => success? 66 | (parse response) => ["kikka"])) 67 | 68 | (fact "kekkonen endpoints" 69 | 70 | (facts "handlers" 71 | (fact "returns all handlers with rules ok" 72 | (let [response (app {:uri "/kekkonen/handlers" 73 | :request-method :get})] 74 | response => success? 75 | (parse response) => (n-of map? 2))) 76 | 77 | (fact "with ns returns all handlers with rules ok" 78 | (let [response (app {:uri "/kekkonen/handlers" 79 | :request-method :get 80 | :query-params {:kekkonen.ns "api.items"}})] 81 | response => success? 82 | (parse response) => (n-of map? 2))) 83 | 84 | (fact "with invalid ns returns nothing" 85 | (let [response (app {:uri "/kekkonen/handlers" 86 | :request-method :get 87 | :query-params {:kekkonen.ns "api.item"}})] 88 | response => success? 89 | (parse response) => (n-of map? 0)))) 90 | 91 | (facts "handler" 92 | (fact "with valid handler action" 93 | (let [response (app {:uri "/kekkonen/handler" 94 | :request-method :get 95 | :query-params {:kekkonen.action "api.items/get-items"}})] 96 | response => success? 97 | (parse response) => map?)) 98 | 99 | (fact "with invalid handler action returns nil" 100 | (let [response (app {:uri "/kekkonen/handler" 101 | :request-method :get 102 | :query-params {:kekkonen.action "api.items/get-item"}})] 103 | response => success? 104 | (parse response) => nil)))))) 105 | 106 | (fact "statuses" 107 | 108 | success-status => 200 109 | failure-status => 400 110 | error-status => 500 111 | 112 | (success) => (contains {:status success-status}) 113 | (failure) => (contains {:status failure-status}) 114 | (error) => (contains {:status error-status}) 115 | 116 | (failure!) => (throws? {:type :ring.util.http-response/response}) 117 | (error!) => (throws? {:type :ring.util.http-response/response}) 118 | 119 | (success) => success? 120 | (failure) => failure? 121 | (error) => error?) 122 | -------------------------------------------------------------------------------- /test/kekkonen/http_test.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.http-test 2 | (:require [midje.sweet :refer :all] 3 | [ring.util.http-response :refer [ok]] 4 | [ring.util.http-predicates :refer [ok?]] 5 | [plumbing.core :as p] 6 | [kekkonen.http :as h])) 7 | 8 | (p/defnk ^:get get-it [] (ok)) 9 | (p/defnk ^:head head-it [] (ok)) 10 | (p/defnk ^:patch patch-it [] (ok)) 11 | (p/defnk ^:delete delete-it [] (ok)) 12 | (p/defnk ^:options options-it [] (ok)) 13 | (p/defnk ^:post post-it [] (ok)) 14 | (p/defnk ^:put put-it [] (ok)) 15 | (p/defnk ^:any any-it [] (ok)) 16 | 17 | (facts "web-options" 18 | (let [app (h/http-api {:core {:handlers {:api 'kekkonen.http-test}}})] 19 | 20 | (fact "get" (app {:uri "/api/get-it", :request-method :get}) => ok?) 21 | (fact "head" (app {:uri "/api/head-it", :request-method :head}) => ok?) 22 | (fact "patch" (app {:uri "/api/patch-it", :request-method :patch}) => ok?) 23 | (fact "delete" (app {:uri "/api/delete-it", :request-method :delete}) => ok?) 24 | (fact "options" (app {:uri "/api/options-it", :request-method :options}) => ok?) 25 | (fact "post" (app {:uri "/api/post-it", :request-method :post}) => ok?) 26 | (fact "put" (app {:uri "/api/put-it", :request-method :put}) => ok?) 27 | 28 | (fact "any" 29 | (app {:uri "/api/any-it", :request-method :get}) => ok? 30 | (app {:uri "/api/any-it", :request-method :head}) => ok? 31 | (app {:uri "/api/any-it", :request-method :patch}) => ok? 32 | (app {:uri "/api/any-it", :request-method :delete}) => ok? 33 | (app {:uri "/api/any-it", :request-method :options}) => ok? 34 | (app {:uri "/api/any-it", :request-method :post}) => ok? 35 | (app {:uri "/api/any-it", :request-method :put}) => ok?))) 36 | -------------------------------------------------------------------------------- /test/kekkonen/interceptor_test.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.interceptor-test 2 | (:require [midje.sweet :refer :all] 3 | [kekkonen.midje :refer :all] 4 | [kekkonen.interceptor :as i])) 5 | 6 | (defn not-executed [_] 7 | (throw (ex-info "not-run" {}))) 8 | 9 | (facts "interceptor?" 10 | (i/interceptor? {:enter identity}) => true 11 | (i/interceptor? {:leave identity}) => true 12 | (i/interceptor? {:error identity}) => true 13 | (i/interceptor? {}) => false) 14 | 15 | (facts "queues" 16 | (let [interceptor1 {:enter identity, :leave identity} 17 | interceptor2 {:enter identity, :leave identity}] 18 | (fact "enqueue" 19 | (i/enqueue {} [interceptor1]) => {::i/queue [interceptor1]} 20 | (i/enqueue {} [interceptor1 interceptor2]) => {::i/queue [interceptor1 interceptor2]}) 21 | (fact "terminate" 22 | (i/terminate (i/enqueue {} [interceptor1 interceptor2])) => {}))) 23 | 24 | (facts "execute" 25 | (facts "are executed in order" 26 | (-> {:x 2} 27 | (i/enqueue [{:enter #(update % :x inc)} 28 | {:enter #(update % :x (partial * 2)) 29 | :leave #(update % :x (partial * 2))} 30 | {:leave #(update % :x dec)}]) 31 | (i/execute)) => {:x 10}) 32 | 33 | (fact "with terminate, future steps are not executed" 34 | (-> {:x 2} 35 | (i/enqueue [{:enter #(update % :x inc) 36 | :leave #(update % :x inc)} 37 | {:enter i/terminate 38 | :leave #(update % :x (partial * 2))} 39 | {:leave not-executed}]) 40 | (i/execute)) => {:x 7}) 41 | 42 | (fact "setting context to nil, all execution is stopped" 43 | (-> {:x 2} 44 | (i/enqueue [{:enter #(update % :x inc) 45 | :error not-executed 46 | :leave not-executed} 47 | {:enter (constantly nil) 48 | :leave not-executed} 49 | {:leave not-executed}]) 50 | (i/execute)) => nil) 51 | 52 | (fact "on exception" 53 | (fact "can be caught" 54 | (-> {:x 2} 55 | (i/enqueue [{:enter #(update % :x inc) 56 | :error (fn [context e] 57 | (assoc context ::exception true)) 58 | :leave not-executed} 59 | {:enter (fn [_] (throw (ex-info "fail" {:reason "too many men"}))) 60 | :leave not-executed} 61 | {:leave not-executed}]) 62 | (i/execute)) => {:x 3 ::exception true}) 63 | 64 | (fact "if uncatched, is thrown in the end" 65 | (-> {:x 2} 66 | (i/enqueue [{:enter #(update % :x inc) 67 | :leave not-executed} 68 | {:enter (fn [_] (throw (ex-info "fail" {:reason "too many men"}))) 69 | :leave not-executed} 70 | {:leave not-executed}]) 71 | (i/execute)) => (throws? 72 | {:execution-id integer? 73 | :interceptor string? 74 | :exception (partial instance? Exception) 75 | :stage :enter 76 | :exception-type :clojure.lang.ExceptionInfo})))) 77 | -------------------------------------------------------------------------------- /test/kekkonen/middleware_test.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.middleware-test 2 | (:require [kekkonen.core :as k] 3 | [kekkonen.ring :as r] 4 | [kekkonen.middleware :as mw] 5 | [kekkonen.midje :refer :all] 6 | [midje.sweet :refer :all] 7 | [schema.core :as s] 8 | [ring.util.http-response :refer [ok]] 9 | [ring.util.http-predicates :as hp] 10 | [plumbing.core :as p] 11 | [kekkonen.common :as kc] 12 | [muuntaja.core :as muuntaja])) 13 | 14 | (p/defnk ^:handler plus 15 | [[:request [:query-params x :- s/Int, y :- s/Int]]] 16 | (ok (+ x y))) 17 | 18 | (p/defnk ^:handler responsez 19 | {:responses {200 {:schema {:value s/Str}}}} 20 | [[:request body-params :- {:value (s/either s/Str s/Int)}]] 21 | (ok body-params)) 22 | 23 | (facts "wrap-exceptions" 24 | (let [app (mw/wrap-exceptions 25 | (r/ring-handler 26 | (k/dispatcher 27 | (kc/merge-map-like 28 | r/+ring-dispatcher-options+ 29 | {:handlers {:api [#'plus #'responsez]}}))) 30 | (:exceptions mw/+default-options+))] 31 | 32 | (fact "request coercion errors" 33 | (let [response (app {:uri "/api/plus" 34 | :request-method :post 35 | :query-params {:x "1"}})] 36 | 37 | response => hp/bad-request? 38 | (:body response) => {:error {:y "missing-required-key"} 39 | :in :query-params 40 | :type :kekkonen.ring/request 41 | :value {:x "1"}})) 42 | 43 | (fact "response coercion errors" 44 | (let [response (app {:uri "/api/responsez" 45 | :request-method :post 46 | :body-params {:value 1}})] 47 | 48 | response => hp/internal-server-error? 49 | (:body response) => {:error {:value "(not (instance? java.lang.String 1))"} 50 | :in :response 51 | :type :kekkonen.ring/response 52 | :value {:value 1}})))) 53 | 54 | (facts "api-info" 55 | (let [options {:formats (muuntaja/create 56 | (muuntaja/select-formats 57 | muuntaja/default-options 58 | ["application/json" 59 | "application/transit+json" 60 | "application/edn"]))}] 61 | (mw/api-info options) => {:consumes #{"application/json" 62 | "application/transit+json" 63 | "application/edn"} 64 | :produces #{"application/json" 65 | "application/transit+json" 66 | "application/edn"}})) 67 | 68 | (facts "wrap-keyword-keys" 69 | ((mw/wrap-keyword-keys identity [:a :b]) {:a {:b {"kissa" "koira", "banaani" "valas"}}}) 70 | => {:a {:b {:kissa "koira", :banaani "valas"}}}) 71 | -------------------------------------------------------------------------------- /test/kekkonen/midje.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.midje 2 | (:require [midje.util.exceptions :as e] 3 | [kekkonen.core :as k] 4 | [schema.core :as s] 5 | [cheshire.core :as c] 6 | [plumbing.core :as p])) 7 | 8 | (defn throws? 9 | ([] 10 | (throws? {})) 11 | ([m] 12 | (fn [x] 13 | (let [data (ex-data (e/throwable x)) 14 | mdata (if data (select-keys data (vec (keys m))))] 15 | (and 16 | (not (nil? x)) 17 | (every? 18 | (fn [[k v]] 19 | (let [v' (get mdata k)] 20 | (if (fn? v) 21 | (v v') 22 | (= v v')))) 23 | m)))))) 24 | 25 | (defn throws-interceptor-exception? [m] 26 | (throws? 27 | (merge 28 | {:execution-id integer? 29 | :stage :enter 30 | :interceptor string? 31 | :exception (partial instance? Exception)} 32 | m))) 33 | 34 | (def schema-error? (throws? {:type ::s/error})) 35 | (def missing-route? (throws? {:type ::k/dispatch})) 36 | (def input-coercion-error? (throws? {:type ::k/request})) 37 | (def output-coercion-error? (throws? {:type ::k/response})) 38 | 39 | (defn parse [x] 40 | (if (and x (:body x)) 41 | (c/parse-string (slurp (:body x)) true))) 42 | 43 | (defn parse-swagger [response] 44 | (-> response 45 | parse 46 | (update :paths (fn [paths] 47 | (p/map-keys 48 | (fn [x] 49 | (-> x str (subs 1))) 50 | paths))))) 51 | -------------------------------------------------------------------------------- /test/kekkonen/perf.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.perf 2 | (:require [criterium.core :as cc] 3 | [kekkonen.core :as k] 4 | [plumbing.core :as p] 5 | [kekkonen.cqrs :refer :all] 6 | [schema.core :as s])) 7 | 8 | (defn title [s] 9 | (println (str "\u001B[35m" (apply str (repeat (count s) "#")) "\u001B[0m")) 10 | (println (str "\u001B[35m" s "\u001B[0m")) 11 | (println (str "\u001B[35m" (apply str (repeat (count s) "#")) "\u001B[0m"))) 12 | 13 | ;; 14 | ;; handlers & dispatcher 15 | ;; 16 | 17 | (p/defnk ^:handler plus1 :- {:body {:result s/Int}, s/Keyword s/Any} 18 | "adds numbers together" 19 | [[:data x :- s/Int, y :- s/Int]] 20 | (success {:result (+ x y)})) 21 | 22 | (def d1 (k/dispatcher {:handlers {:api {:math #'plus1}}})) 23 | (def d2 (k/dispatcher {:handlers {:api {:math #'plus1}} 24 | :coercion {:input nil, :output nil}})) 25 | 26 | ;; 27 | ;; clojure multimethod 28 | ;; 29 | 30 | (defmulti multi-method-invoke (fn [key _] key)) 31 | (defmethod multi-method-invoke :api.math/plus1 [_ data] (plus1 data)) 32 | 33 | ;; 34 | ;; benchmarks 35 | ;; 36 | 37 | (defn core-bench [] 38 | 39 | (title "with coercion") 40 | (cc/quick-bench (k/invoke d1 :api.math/plus1 {:data {:x 10, :y 20}})) 41 | ; 28.0µs 42 | ; 8.2µs (memoized) 43 | ; 7.0µs (lookup) 44 | ; 7.2µs (leave) 45 | ; 10.0µs (pedestal) 46 | ; 9.6µs (precompiled) 47 | ; 9.0µs (records) 48 | 49 | (title "without coercion") 50 | (cc/quick-bench (k/invoke d2 :api.math/plus1 {:data {:x 10, :y 20}})) 51 | ; 3.7µs 52 | ; 3.7µs (memoized) 53 | ; 2.0µs (lookup) 54 | ; 2.1µs (leave) 55 | ; 4.2µs (pedestal) 56 | ; 3.9µs (precompiled) 57 | ; 3.7µs (records) 58 | 59 | (title "clojure multimethod") 60 | (cc/quick-bench (multi-method-invoke :api.math/plus1 {:data {:x 10, :y 20}})) 61 | ; 0.3µs 62 | 63 | (println)) 64 | 65 | ;; 66 | ;; ring-handlers 67 | ;; 68 | 69 | (require '[kekkonen.ring :as kr]) 70 | 71 | (def r1 (kr/ring-handler d1)) 72 | (def r2 (kr/ring-handler d2)) 73 | (def r3 (kr/ring-handler d2 {:coercion nil})) 74 | 75 | (def data {:uri "/api/math/plus1" 76 | :request-method :post 77 | :body-params {:x 10, :y 20}}) 78 | 79 | (defn ring-bench [] 80 | 81 | (title "ring & dispatcher coercion") 82 | (assert (= 30 (-> data r1 :body :result))) 83 | (cc/quick-bench (r1 data)) 84 | ; 20.7µs 85 | ; 17.1µs 86 | ; 11.3µs 87 | ; 14.7µs (leave) 88 | ; 19.2µs (pedestal) 89 | ; 19.0µs (precompiled) 90 | ; 18.3µs (records) 91 | ; 16.4µs (cleanup) 92 | 93 | (title "ring coercion") 94 | (assert (= 30 (-> data r2 :body :result))) 95 | (cc/quick-bench (r2 data)) 96 | ; 15.7µs 97 | ; 12.2µs 98 | ; 7.6µs 99 | ; 10.4µs (leave) 100 | ; 13.3µs (pedestal) 101 | ; 13.1µs (precompiled) 102 | ; 12.9µs (records) 103 | ; 10.1µs (cleanup) 104 | 105 | (title "no coercion") 106 | (assert (= 30 (-> data r3 :body :result))) 107 | (cc/quick-bench (r3 data)) 108 | ; 3.5µs 109 | ; 3.9µs (leave) 110 | ; 9.5µs (pedestal) 111 | ; 9.1µs (precompiled) 112 | ; 8.6µs (records) 113 | ; 6.2µs (cleanup) 114 | 115 | (println)) 116 | 117 | (comment 118 | (core-bench) 119 | (ring-bench)) 120 | -------------------------------------------------------------------------------- /test/kekkonen/ring_test.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.ring-test 2 | (:require [kekkonen.core :as k] 3 | [kekkonen.ring :as r] 4 | [kekkonen.midje :refer :all] 5 | [midje.sweet :refer :all] 6 | [schema.core :as s] 7 | [ring.util.http-response :refer [ok]] 8 | [plumbing.core :as p] 9 | [kekkonen.common :as kc])) 10 | 11 | (fact "handler-uri" 12 | (#'r/handler-uri {:ns :api.user, :name :add-user!}) => "/api/user/add-user!" 13 | (#'r/handler-uri {:ns :api.user, :name :swagger.json}) => "/api/user/swagger.json" 14 | (#'r/handler-uri {:ns nil, :name :swagger.json}) => "/swagger.json") 15 | 16 | (fact "ring-input-schema" 17 | (#'r/ring-input-schema 18 | {:data {:d s/Str} 19 | :request {:query-params {:q s/Str} 20 | :body-params {:b s/Str}}} 21 | {[:data] [:request :query-params]}) 22 | => {:request {:query-params {:d s/Str} 23 | :body-params {:b s/Str}}}) 24 | 25 | (p/defnk ^:handler ping [] "pong") 26 | 27 | (p/defnk ^:handler snoop [request] (ok request)) 28 | 29 | (facts "request routing" 30 | (let [app (r/ring-handler 31 | (k/dispatcher 32 | (kc/merge-map-like 33 | r/+ring-dispatcher-options+ 34 | {:handlers {:api [#'ping #'snoop]}})))] 35 | 36 | (fact "non matching route returns nil" 37 | (app {:uri "/" :request-method :post}) => nil) 38 | 39 | (fact "matching route" 40 | (app {:uri "/api/ping" :request-method :post}) 41 | => "pong") 42 | 43 | (fact "request can be read as-is" 44 | (let [request {:uri "/api/snoop" :request-method :post}] 45 | (app request) => (ok request))) 46 | 47 | (fact "handles request within context" 48 | (let [request {:uri "/somecontext/api/ping" :request-method :post :context "/somecontext"}] 49 | (app request) => "pong")))) 50 | 51 | (p/defnk ^:handler plus 52 | [[:request [:query-params x :- s/Int, y :- s/Int]]] 53 | (ok (+ x y))) 54 | 55 | (p/defnk ^:handler divide 56 | [[:request [:form-params x :- s/Int, y :- s/Int]]] 57 | (ok (/ x y))) 58 | 59 | (p/defnk ^:handler power 60 | [[:request [:header-params x :- s/Int, y :- s/Int]]] 61 | (ok (long (Math/pow x y)))) 62 | 63 | (s/defschema Body {:name s/Str, :size (s/enum :S :M :L :XL)}) 64 | 65 | (p/defnk ^:handler echo 66 | [[:request body-params :- Body]] 67 | (ok body-params)) 68 | 69 | (p/defnk ^:handler response 70 | {:responses {200 {:schema {:value s/Str}}}} 71 | [[:request body-params :- {:value (s/either s/Str s/Int)}]] 72 | (ok body-params)) 73 | 74 | (p/defnk ^:handler response-default 75 | {:responses {:default {:schema {:value s/Str}}}} 76 | [[:request body-params :- {:value (s/either s/Str s/Int)}]] 77 | (ok body-params)) 78 | 79 | (fact "internal schemas" 80 | (s/with-fn-validation 81 | (r/ring-handler 82 | (k/dispatcher {:handlers {:api #'plus}})))) 83 | 84 | (facts "coercion" 85 | (let [app (r/ring-handler 86 | (k/dispatcher 87 | (kc/merge-map-like 88 | r/+ring-dispatcher-options+ 89 | {:handlers {:api [#'plus #'divide #'power #'echo #'response #'response-default]}})))] 90 | 91 | (fact "query-params" 92 | 93 | (fact "missing parameters" 94 | (app {:uri "/api/plus" 95 | :request-method :post 96 | :query-params {:x "1"}}) 97 | 98 | => (throws? 99 | {:type :kekkonen.ring/request 100 | :in :query-params 101 | :value {:x "1"} 102 | :schema {:x s/Int, :y s/Int s/Keyword s/Any}})) 103 | 104 | (fact "wrong parameter types" 105 | (app {:uri "/api/plus" 106 | :request-method :post 107 | :query-params {:x "invalid" :y "2"}}) 108 | 109 | => (throws? 110 | {:type :kekkonen.ring/request 111 | :in :query-params 112 | :value {:x "invalid" :y "2"} 113 | :schema {:x s/Int, :y s/Int s/Keyword s/Any}})) 114 | 115 | (fact "all good" 116 | (app {:uri "/api/plus" 117 | :request-method :post 118 | :query-params {:x "1" :y "2"}}) => (ok 3))) 119 | 120 | (fact "form-params" 121 | (app {:uri "/api/divide" 122 | :request-method :post 123 | :form-params {:x "10" :y "2"}}) => (ok 5)) 124 | 125 | (fact "header-params" 126 | (app {:uri "/api/power" 127 | :request-method :post 128 | :header-params {:x "2" :y "3"}}) => (ok 8)) 129 | 130 | (fact "body-params" 131 | (app {:uri "/api/echo" 132 | :request-method :post 133 | :body-params {:name "Pizza" :size "L"}}) => (ok {:name "Pizza" :size :L})) 134 | 135 | (fact "response coercion" 136 | (fact "with status code" 137 | (app {:uri "/api/response" 138 | :request-method :post 139 | :body-params {:value "Pizza"}}) => (ok {:value "Pizza"}) 140 | 141 | (app {:uri "/api/response" 142 | :request-method :post 143 | :body-params {:value 1}}) 144 | 145 | => (throws? 146 | {:type :kekkonen.ring/response 147 | :in :response 148 | :value {:value 1} 149 | :schema {:value s/Str}})) 150 | 151 | (fact "with :default" 152 | (app {:uri "/api/response-default" 153 | :request-method :post 154 | :body-params {:value "Pizza"}}) => (ok {:value "Pizza"}) 155 | 156 | (app {:uri "/api/response-default" 157 | :request-method :post 158 | :body-params {:value 1}}) 159 | 160 | => (throws? 161 | {:type :kekkonen.ring/response 162 | :in :response 163 | :value {:value 1} 164 | :schema {:value s/Str}}))) 165 | 166 | (fact "validation" 167 | 168 | (fact "missing parameters throws errors as expected" 169 | (app {:uri "/api/plus" 170 | :request-method :post 171 | :query-params {:x "1"} 172 | :headers {"kekkonen.mode" "validate"}}) 173 | 174 | => (throws? 175 | {:type :kekkonen.ring/request 176 | :in :query-params 177 | :value {:x "1"} 178 | :schema {:x s/Int, :y s/Int s/Keyword s/Any}})) 179 | 180 | (fact "all good returns ok nil" 181 | (app {:uri "/api/plus" 182 | :request-method :post 183 | :query-params {:x "1" :y "2"} 184 | :headers {"kekkonen.mode" "validate"}}) => (ok nil))))) 185 | 186 | (facts "no coercion" 187 | 188 | (fact "any ring coercion can be changed" 189 | (let [app (r/ring-handler 190 | (k/dispatcher {:handlers {:api [#'plus]}}) 191 | {:coercion {:query-params (get-in r/+default-options+ [:coercion :body-params])}})] 192 | 193 | (app {:uri "/api/plus" 194 | :request-method :post 195 | :query-params {:x "1", :y "2"}}) => (throws? {:type :kekkonen.ring/request}))) 196 | 197 | (fact "any ring coercion can be disabled" 198 | (fact "if handler is dependent on :request-input, no coercion is done" 199 | (let [app (r/ring-handler 200 | (k/dispatcher {:handlers {:api [#'plus]}}) 201 | {:coercion {:query-params nil}})] 202 | 203 | (app {:uri "/api/plus" 204 | :request-method :post 205 | :query-params {:x "1", :y "2"}}) => (throws-interceptor-exception? 206 | {:exception-type :java.lang.ClassCastException}))) 207 | (fact "if handler is dependent on :data-input, default coercion is applies" 208 | (let [app (r/ring-handler 209 | (k/dispatcher {:handlers {:api (k/handler 210 | {:name :plus 211 | :handle (p/fnk [[:data x :- s/Int, y :- s/Int]] 212 | (ok (+ x y)))})}}) 213 | {:coercion {:body-params nil}})] 214 | 215 | (app {:uri "/api/plus" 216 | :request-method :post 217 | :body-params {:x "1", :y "2"}}) => (throws? {:type :kekkonen.core/request})))) 218 | 219 | (fact "all ring coercions can be disabled" 220 | (let [app (r/ring-handler 221 | (k/dispatcher {:handlers {:api [#'plus]}}) 222 | {:coercion nil})] 223 | 224 | (app {:uri "/api/plus" 225 | :request-method :post 226 | :query-params {:x "1", :y "2"}}) => (throws-interceptor-exception? 227 | {:exception-type :java.lang.ClassCastException}))) 228 | 229 | (fact "all ring & core coercions can be disabled" 230 | (let [app (r/ring-handler 231 | (k/dispatcher {:handlers {:api [#'plus]}, :coercion nil}) 232 | {:coercion nil})] 233 | 234 | (app {:uri "/api/plus" 235 | :request-method :post 236 | :query-params {:x "1", :y "2"}}) => (throws-interceptor-exception? 237 | {:exception-type :java.lang.ClassCastException})))) 238 | 239 | (facts "mapping" 240 | (facts "default body-params -> data" 241 | (let [app (r/ring-handler 242 | (k/dispatcher {:handlers {:api (k/handler {:name :test, :handle identity})}}))] 243 | 244 | (app {:uri "/api/test" 245 | :request-method :post 246 | :body-params {:kikka "kukka"}}) => (contains {:data {:kikka "kukka"}}))) 247 | 248 | (fact "custom query-params -> query via interceptor" 249 | (let [app (r/ring-handler 250 | (k/dispatcher {:handlers {:api (k/handler {:name :test, :handle identity})}}) 251 | {:interceptors [(k/context-copy [:request :query-params] [:query])]})] 252 | 253 | (app {:uri "/api/test" 254 | :request-method :post 255 | :query-params {:kikka "kukka"}}) => (contains {:query {:kikka "kukka"}}))) 256 | 257 | (fact "custom query-params -> query via parameters" 258 | (let [app (r/ring-handler 259 | (k/dispatcher {:handlers {:api (k/handler {:name :test, :handle identity})}}) 260 | {:types {:handler {:parameters {[:query] [:request :query-params]}}}})] 261 | 262 | (app {:uri "/api/test" 263 | :request-method :post 264 | :query-params {:kikka "kukka"}}) => (contains {:query {:kikka "kukka"}})))) 265 | 266 | (facts "routing" 267 | (let [app (r/routes [(r/match "/swagger.json" #{:get} (constantly :swagger)) 268 | (r/match "/api-docs" (constantly :api-docs))])] 269 | 270 | (app {:uri "/swagger.json" :request-method :get}) => :swagger 271 | (app {:uri "/swagger.json" :request-method :post}) => nil 272 | (app {:uri "/api-docs" :request-method :head}) => :api-docs 273 | (app {:uri "/favicon.ico" :request-method :get}) => nil)) 274 | 275 | (fact "enriched handlers" 276 | (let [app (r/ring-handler 277 | (k/dispatcher 278 | {:handlers 279 | {:api 280 | (k/handler 281 | {:name :test 282 | :handle (partial k/get-handler)})}}))] 283 | 284 | (app {:uri "/api/test" :request-method :post}) => (contains 285 | {:ring 286 | (contains 287 | {:type-config 288 | (contains 289 | {:methods #{:post}})})}))) 290 | 291 | (fact "interceptors" 292 | (let [app (r/ring-handler 293 | (k/dispatcher 294 | {:handlers 295 | {:api 296 | (k/handler 297 | {:name :test 298 | :handle (fn [context] 299 | {:user (-> context ::user)})})}}) 300 | {:interceptors [{:enter (fn [ctx] 301 | (let [user (get-in ctx [:request :header-params "user"])] 302 | (assoc ctx ::user user))) 303 | :leave (fn [ctx] 304 | (assoc-in ctx [:response :leave1] true))} 305 | {:enter (fn [context] 306 | (if (::user context) 307 | (update context ::user #(str % "!")) 308 | context)) 309 | :leave (fn [ctx] 310 | (assoc-in ctx [:response :leave2] true))}]})] 311 | 312 | (app {:uri "/api/test" 313 | :request-method :post}) => {:user nil, :leave1 true, :leave2 true} 314 | 315 | (app {:uri "/api/test" 316 | :request-method :post 317 | :header-params {"user" "tommi"}}) => {:user "tommi!", :leave1 true, :leave2 true})) 318 | 319 | (fact "dispatcher context is available for ring interceptors, fixes #26" 320 | (let [app (r/ring-handler 321 | (k/dispatcher 322 | {:context {:secret 42} 323 | :handlers {:api (k/handler {:name :ipa, :handle (fn [ctx] (::value ctx))})}}) 324 | {:interceptors [(fn [ctx] (assoc ctx ::value (:secret ctx)))]})] 325 | (app {:uri "/api/ipa" :request-method :post}) => 42)) 326 | -------------------------------------------------------------------------------- /test/kekkonen/swagger_test.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.swagger-test 2 | (:require [kekkonen.core :as k] 3 | [kekkonen.swagger :as ks] 4 | [midje.sweet :refer :all] 5 | [schema.core :as s] 6 | [ring.util.http-response :refer [ok]] 7 | [plumbing.core :as p] 8 | [kekkonen.ring :as ring] 9 | [kekkonen.common :as kc])) 10 | 11 | (p/defnk ^:handler echo 12 | {:summary "summary" 13 | :responses {200 {:schema {:x [s/Str] 14 | :y s/Int 15 | :z s/Bool}}} 16 | ::ring/consumes ["application/json"] 17 | ::ring/produces ["application/json"]} 18 | [[:request 19 | body-params :- {:country (s/enum :FI :CA)} 20 | [:query-params x :- [s/Str]] 21 | [:path-params y :- s/Int] 22 | [:header-params z :- s/Bool]]] 23 | (ok [x y z body-params])) 24 | 25 | (fact "swagger-docs" 26 | (let [dispatcher (k/transform-handlers 27 | (k/dispatcher 28 | (kc/merge-map-like 29 | ring/+ring-dispatcher-options+ 30 | {:handlers {:api {:admin #'echo}}})) 31 | (partial #'ring/attach-ring-meta ring/+default-options+)) 32 | handlers (k/available-handlers dispatcher nil {}) 33 | 34 | swagger (ks/ring-swagger 35 | handlers 36 | {:info {:version "1.0.0" 37 | :title "Kekkonen" 38 | :description "Kekkonen Swagger API"}})] 39 | 40 | (fact "swagger-object is created" 41 | 42 | swagger => {:info {:version "1.0.0" 43 | :title "Kekkonen" 44 | :description "Kekkonen Swagger API"} 45 | :paths {"/api/admin/echo" 46 | {:post 47 | {:parameters {:body {:country (s/enum :CA :FI)} 48 | :header {:z s/Bool, s/Keyword s/Any 49 | (s/optional-key "kekkonen.mode") (s/enum "invoke" "validate")} 50 | :path {:y s/Int, s/Keyword s/Any} 51 | :query {:x [s/Str], s/Keyword s/Any}} 52 | :responses {200 {:schema {:x [s/Str] 53 | :y s/Int 54 | :z s/Bool}}} 55 | :consumes ["application/json"] 56 | :produces ["application/json"] 57 | :summary "summary" 58 | :tags [:api.admin]}}}}) 59 | 60 | (fact "swagger-json can be generated" 61 | (s/with-fn-validation 62 | (ks/swagger-object swagger {}) => some?)))) 63 | 64 | (facts "swagger-handler" 65 | (let [dispatcher (k/transform-handlers 66 | (k/dispatcher 67 | (kc/merge-map-like 68 | ring/+ring-dispatcher-options+ 69 | {:handlers {:api {:admin #'echo}}})) 70 | (partial #'ring/attach-ring-meta ring/+default-options+)) 71 | swagger-handler (ks/swagger-handler {} {:spec "swagger.json", :info {:version "1.2.3"}})] 72 | 73 | (against-background [(k/get-dispatcher anything) => dispatcher] 74 | (fact "generates swagger json" 75 | (swagger-handler {}) => (contains {:body (contains {:paths seq})}))) 76 | 77 | (fact "extracts swagger basePath from request context" 78 | (let [context-path "/testpath"] 79 | (:body (swagger-handler {:request {:context context-path}})) => (contains {:basePath context-path}))) 80 | 81 | (fact "does not add basePath if no context" 82 | (-> (swagger-handler {:request {}}) :body :basePath) => nil))) 83 | -------------------------------------------------------------------------------- /test/kekkonen/upload_test.clj: -------------------------------------------------------------------------------- 1 | (ns kekkonen.upload-test 2 | (:require [midje.sweet :refer :all] 3 | [kekkonen.upload :as upload] 4 | [ring.core.protocols :refer [StreamableResponseBody]])) 5 | 6 | (defn- response-body? [x] (satisfies? StreamableResponseBody x)) 7 | 8 | (facts "response" 9 | (upload/response (.getBytes "hello" "UTF-8") "text/plain") 10 | => (just {:status 200, 11 | :body response-body?, 12 | :headers {"Content-Type" "text/plain"}})) 13 | --------------------------------------------------------------------------------