├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── SPEC.md ├── doc └── porting_middleware.md ├── project.clj ├── src └── spiral │ ├── adapters │ ├── http_kit.clj │ ├── immutant.clj │ └── jetty.clj │ ├── beauty.clj │ ├── core.clj │ ├── experimental.clj │ └── middleware.clj └── test ├── ring ├── assets │ ├── bars │ │ ├── backlink │ │ └── foo.html │ ├── foo.html │ ├── hello world.txt │ ├── index.html │ ├── plain.txt │ └── random.xyz └── backlink └── spiral ├── core_test.clj └── middleware_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 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | lein: lein2 3 | branches: 4 | only: 5 | master 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor tocontrol, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of Washington and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.org/dgrnbrg/spiral.svg?branch=master)](https://travis-ci.org/dgrnbrg/spiral) 2 | 3 | # spiral 4 | 5 | A Ring that doesn't block. 6 | 7 | Spiral integrates Ring and core.async. 8 | 9 | To use in your Leiningen project, add the following 10 | 11 | ```clojure 12 | ;; For http-kit support 13 | [spiral "0.1.0"] 14 | [http-kit "2.1.19"] 15 | 16 | ;; For Immutant support 17 | [spiral "0.?.0"] 18 | [org.immutant/web "2.0.0"] 19 | 20 | ;; For jetty support 21 | [spiral "0.1.0"] 22 | [ring/ring-jetty-adapter "1.3.1"] 23 | ``` 24 | 25 | ## Motivation 26 | 27 | Ring is a great foundation for building HTTP servers in Clojure. However, Ring 28 | fails to solve many problems that high-performance and transactional HTTP 29 | servers must solve: 30 | 31 | - What does the server do when it can't handle the request rate? 32 | - How can the server dedicate more or fewer resources to different requests? 33 | - How can long-running HTTP requests be easily developed, without blocking threads? 34 | 35 | Spiral attempts to solve these problems by introducing a core.async based API 36 | that is backwards compatible with Ring and popular Ring servers, so that you don't 37 | need to rewrite your app to take advantage of these techniques. 38 | 39 | ## Features 40 | 41 | ### Beauty 42 | 43 | Note: Beauty is currently the primary reason to use this library. 44 | 45 | Have you ever wanted to prioritize routes that serve static data over routes 46 | that serve DB queries? What about reserving dedicated capacity for your 47 | administrator accounts, to ensure responsiveness under heavy load? Maybe 48 | you want to give dedicated capacity to your paid tier over free. 49 | 50 | Beauty is a simple concurrent router that lets you reuse your existing Ring routes 51 | and handlers, be they Clout or Compojure, Hiccup or Selmer. You just pass 52 | your existing app to the `beauty-router` middleware, and then annotate any handlers 53 | that you want to run concurrently with prioritization. There is an example 54 | of how to do this further down in the README. 55 | 56 | ### core.async based 57 | 58 | With Spiral, you can leverage the power of core.async in your Ring handlers. 59 | Now, you can park on your database and REST requests using ``! Soon, 60 | there will be syntax sugar for making this trivial. 61 | 62 | ### Forwards and Backwards compatible with Ring 63 | 64 | Spiral is 100% compatible with normal Ring. Want to use your Ring handler 65 | in an Spiral app? Just use `sync->async-handler`. What about mounting an 66 | Spiral handler into a normal Ring add? `async->sync-handler`. Maybe you'd 67 | like to use the huge body of existing Ring middleware in your Spiral app: 68 | try `sync->async-middleware`. Or maybe you'd like to use async middleware with 69 | your synchronous Ring app: just use `async->sync-middleware`. 70 | 71 | Spiral also includes a complete set of optimized ports of Ring middleware. 72 | These ports include a ported test suite, so you can feel comfortable in the logic 73 | being executed. 74 | 75 | ### Integration with standard servers 76 | 77 | Spiral comes with adapters for Jetty 7, Immutant 2, and http-kit, so that you 78 | don't even need to change your server code. Just use `to-jetty`, `to-immutant`, or 79 | `to-httpkit` to mount an async handler onto your existing routing hierarchy. 80 | 81 | ### Ports of many Ring middleware 82 | 83 | `spiral.middleware` contains ports of all the middleware found in Ring core. 84 | Just post an issue to get your favorite middleware ported! 85 | 86 | ## Usage 87 | 88 | See `SPEC.md` for a specific treatment of how the format works. 89 | 90 | ### Getting Started 91 | 92 | Let's first take a look at how to write "Hello World" in Spiral with http-kit: 93 | 94 | ```clojure 95 | (require '[org.http-kit.server :as http-kit]) 96 | (require 'spiral.adapters.http-kit) 97 | (require 'spiral.core) 98 | 99 | (def spiral-app 100 | (spiral.core/constant-response 101 | {:body "all ok" :status 200 :headers {"Content-Type" "text/plain"}})) 102 | 103 | (def server (http-kit/run-server (spiral.adapters.http-kit/to-httpkit spiral-app) 104 | {:port 8080})) 105 | ``` 106 | 107 | In this example, we see how to use the `constant-response` handler, which is 108 | the simplest Spiral handler available. It always returns the same response. 109 | 110 | After we create the app, we use `to-httpkit` to make it http-kit compatible, 111 | and then we pass it to the http-kit server to start the application. 112 | 113 | ### Running traditional Ring apps on Spiral 114 | 115 | Now, we'll look at how we can run an existing traditional Ring app on 116 | Spiral with Jetty. 117 | 118 | ```clojure 119 | (require '[compojure.core :refer (defroutes GET)]) 120 | (require '[spiral.adapters.jetty :as jetty]) 121 | (require 'spiral.core) 122 | 123 | (defroutes traditional-ring-app 124 | (GET "/" [] 125 | {:body "all ok" :status 200 :headers {"Content-Type" "text/plain"}})) 126 | 127 | (def spiral-app 128 | (spiral.core/sync->async-adapter traditional-ring-app 129 | {:parallelism 10 130 | :buffer-size 5})) 131 | 132 | (def server (jetty/run-jetty-async (jetty/to-jetty spiral-app) 133 | {:port 8080 134 | :join? false})) 135 | ``` 136 | 137 | Here, we first create a traditional Ring app. Then, we add an adapter to make it 138 | asynchronous, allowing up to 10 requests to be simultaneously routed and processed, 139 | and up to 5 requests to be buffered. Finally, we start the Spiral app on Jetty. 140 | 141 | And here is the same app again, but using Immutant: 142 | 143 | ```clojure 144 | (require '[compojure.core :refer (defroutes GET)]) 145 | (require 'immutant.web) 146 | (require 'spiral.adapters.immutant) 147 | (require 'spiral.core) 148 | 149 | (defroutes traditional-ring-app 150 | (GET "/" [] 151 | {:body "all ok" :status 200 :headers {"Content-Type" "text/plain"}})) 152 | 153 | (def spiral-app 154 | (spiral.core/sync->async-adapter traditional-ring-app 155 | {:parallelism 10 156 | :buffer-size 5})) 157 | 158 | (def server (immutant.web/run (spiral.adapters.immutant/to-immutant spiral-app) 159 | :port 8080)) 160 | ``` 161 | 162 | ### Using Ring middleware 163 | 164 | Spiral has a small but growing library of native ports of Ring middleware. By using 165 | a native port of the Ring middleware, you're able to get the best performance. 166 | 167 | ```clojure 168 | (require '[compojure.core :refer (defroutes GET)]) 169 | (require '[spiral.middleware :refer (wrap-params)]) 170 | (require '[org.http-kit.server :as http-kit]) 171 | (require 'spiral.adapters.http-kit) 172 | (require 'spiral.core) 173 | 174 | (defroutes traditional-ring-app 175 | (GET "/" [q] 176 | {:body (str "got " q) :status 200 :headers {"Content-Type" "text/plain"}})) 177 | 178 | (def spiral-app 179 | (-> (spiral.core/sync->async-adapter traditional-ring-app 180 | {:parallelism 5 181 | :buffer-size 5})) 182 | (wrap-params {:parallelism 10 183 | :buffer-size 100})) 184 | 185 | (def server (http-kit/run-server (spiral.adapters.to-httpkit spiral-app) 186 | {:port 8080})) 187 | ``` 188 | 189 | Here, we can see a few things. First of all, it's easy to compose Spiral 190 | handlers using `->`, just like regular Ring. Secondly, we can see that it's 191 | possible to control the buffering and parallelism at each stage in the async 192 | pipeline--this allows you to make decisions such as devoting extra CPU cores 193 | to encoding/decoding middleware, and limiting the concurrent number of requests 194 | to a database-backed session store. 195 | 196 | Ported middleware lives in `spiral.middleware`. The 197 | second argument to the async-ported middleware is always the async options, such 198 | as parallelism and the buffer size. 199 | 200 | If you'd like to see your middlewares ported to Spiral, just file an issue 201 | and I'll do that quickly. 202 | 203 | ### Using Beauty 204 | 205 | Beauty is a concurrent routing API that adds quality of server (QoS) features to Ring. 206 | Quality of service allows you separate routes that access independent databases to 207 | ensure that slowness in one backend doesn't slow down other requests. QoS also allows 208 | you to dynamically decide to prioritize some requests over others, to ensure that 209 | high-priority requests are completed first, regardless of arrival order. 210 | 211 | Let's first look at a simple example of using Beauty: 212 | 213 | ```clojure 214 | (require '[compojure.core :refer (defroutes GET ANY)]) 215 | (require '[org.http-kit.server :as http-kit]) 216 | (require 'spiral.adapters.http-kit) 217 | (require 'spiral.core) 218 | 219 | (defroutes beautified-traditional-ring-app 220 | (GET "/" [] 221 | (beauty-route :main (handle-root))) 222 | (GET "/health" [] 223 | (handle-health-check)) 224 | (ANY "/rest/endpoint" [] 225 | (beauty-route :endpoint (handle-endpoint))) 226 | (ANY "/rest/endpoint/:id" [id] 227 | (beauty-route :endpoint 8 (handle-endpoint-id id)))) 228 | 229 | (def server (http-kit/run-server (spiral.adapters.to-httpkit 230 | (beauty-router 231 | beautified-traditional-ring-app 232 | {:main {:parallelism 1} 233 | :endpoint {:parallelism 5 234 | :buffer-size 100}})) 235 | {:port 8080})) 236 | ``` 237 | 238 | The first thing we added is the `beauty-route` annotations to each route that 239 | we want to run on a prioritized concurrent pool. Note that you can choose to 240 | freely mix which routes are Beauty routes, and which routes are executed 241 | single-threaded (`/health` isn't executed on a Beauty pool). 242 | 243 | Next, notice that `beauty-route` takes an argument: the name of the pool that you want to execute 244 | the request on. `beauty-router` handles creating pools with bounded concurrency 245 | and a bounded buffer of pending requests. In this example, we are using 2 pools: 246 | `:main`, which has a single worker and only services requests to `/`, and `:endpoint`, 247 | which services all of the routes under `/rest`. The `:endpoint` pool has 5 248 | concurrent workers, and it can queue up to 100 requests before it exhibits 249 | backpressure. 250 | 251 | Finally, notice that the final route (`/rest/endpoint/:id`) uses the priority form of 252 | `beauty-route`: normally, all requests are handled at the standard priority, `5`. 253 | In some cases, you may know that certain routes are usually faster to execute, 254 | or that certain clients may have have a cookie that indicates they need better 255 | service. In that case, you can specify the priority for a `beauty-route`d task. 256 | These priorities are used to determine which request will be handled from the 257 | pool's buffer. 258 | 259 | The Beauty Router should be flexible enough to solve most QoS problems; nevertheless, Pull Requests are welcome to improve the functionality! 260 | 261 | ## Implementation 262 | 263 | What follows is a brief note on the fundamental implementation of Spiral. 264 | 265 | In Spiral, an async handler is simply a channel, the fundamental composable 266 | unit of core async. Ring request maps are simply passed into that channel. Clearly, 267 | it's easy to flow the data through the handlers, but how can we flow it back 268 | out to the client? Each request contains 2 extra keys, `:async-response` and 269 | `:async-error`: if you'd like to send a response, put it onto the channel 270 | `:async-response`. If you'd like to send an error, put it onto the channel 271 | `:async-error`. Middleware can intercept responses by inserting their own 272 | channels into those keys. 273 | 274 | ## Comparison with Pedestal 275 | 276 | At first glance, Spiral and Pedestal seem very similar--they're both frameworks 277 | for building asynchronous HTTP applications using a slightly modified Ring API. In 278 | this section, we'll look at some of the differences between Pedestal and Spiral. 279 | 280 | 1. Concurrency mechanism: in Pedestal, you write pure functions for each request lifecycle state transition, and the Pedestal server schedules these function for you. In 281 | Spiral, you write core.async code, so the control flow of your handler is exactly 282 | how you write it. In other words, you can using `!` to block wherever you 283 | want. 284 | 1. Performance: Pedestal and Spiral both allow for many more connections than 285 | threads, thus enabling many more concurrenct connections that Ring. 286 | 1. Composition: in Pedestal, interceptors are placed in a queue for executor. This 287 | allows for interceptions to know the entire queue of execution as it stands, at 288 | the expense of always encoding the request processing as a queue. In Spiral, 289 | handlers are only identified by their input channel. Thus, Spiral handlers cannot 290 | automatically know what other executors are in the execution pipeline. On the other 291 | hand, Spiral handlers allow for async middleware to be written using `!` 292 | when delegating to a subhandler, rather than needing to explicitly implement 293 | the state machine. 294 | 1. Chaining behavior: in Pedestal, the interceptor framework handles chaining 295 | behavior, which allows for greater programmatic insight and control. In Spiral, 296 | function composition handles chaining behavior, just like in regular Ring. 297 | 1. Compatibility with Ring: in Pedestal, you must either port your Ring middlewares, or deal with the fact that they cannot be paused or migrate threads. In Spiral, all existing Ring middleware is supported; however, you will get better performance by porting middlewares. 298 | 299 | ## Performance 300 | 301 | Performance numbers are currently only preliminary. 302 | 303 | I benchmarked returning the "constant" body via Spiral, Traditional Ring, and using a callback. All tests were done on http-kit. 304 | 305 | | | Traditional Ring | httpkit async | Spiral | 306 | |------------|------------------|---------------|------------| 307 | | Mean | 1.45 ms | 1.542 ms | 1.953 ms | 308 | | 90th %ile | 2 ms | 2 ms | 2 ms | 309 | 310 | Thus Spiral adds 500 microseconds to each call, but doesn't impact 311 | outliers significantly. This is something 312 | I'd like to try to to improve; however, the latency cost is worth it 313 | if you need these other concurrency features. 314 | 315 | ## License 316 | 317 | Copyright © 2014 David Greenberg 318 | 319 | Distributed under the Eclipse Public License either version 1.0 320 | -------------------------------------------------------------------------------- /SPEC.md: -------------------------------------------------------------------------------- 1 | ### Spiral Spec 2 | 3 | Spiral allows you to use core.async to build more sophisticated HTTP servers in Clojure. It is designed to allow the implementation of custom quality-of-service middleware, improved multi-core utilization, and graceful work-shedding. 4 | 5 | Spiral is designed to be compatible with existing standard ring handlers and middleware. 6 | 7 | Spiral is defined in terms of handlers, middleware, adapters, request maps, and response maps, as defined below. Spiral's request map and response map are identical to 8 | [Ring](https://github.com/ring-clojure/ring/blob/1.3/SPEC), except for the exceptions below. 9 | 10 | ## Handlers 11 | 12 | Spiral handlers constitute the core logic of the web application. Handlers are implemented as channels with at least one worker that will process requests that are placed on the channel. To process a request, the worker must put either a response map or an error onto the request's callback channels. 13 | 14 | ## Middleware 15 | 16 | Spiral middleware augments the functionality of handlers by invoking them in the process of generating responses. Typically middleware will accept requests on its own channel, and decide whether to delegate to one or more other handlers. Most middleware takes the sub-handler's channel as the first argument, and other options as subsequent arguments. 17 | 18 | Most handlers and middleware take at least two options: `:parallelism` and `:buffer-size`. These options control how many tasks the middleware/handler will compute simultaneously, and how many tasks will be buffered before backpressure will slow down upstream requests. 19 | 20 | ## Adapters 21 | 22 | Spiral adapters connect spiral handlers and middleware to existing HTTP servers. The adapter is implemented as a function that takes 2 arguments: the initial handler/middleware's request channel, and an options map. Each adapter integrates with its host server differently, in order to expose as many other features of the underlying host platform as possible. 23 | 24 | ## Request Map 25 | 26 | Spiral request maps are the same as regular ring request maps, with the following extra keys: 27 | 28 | - `:async-response`: (Required, core.async channel) When a handler or middleware is done processing a request successfully, the response map should be put onto this channel. Only one response map should be put onto each `:async-response` channel. 29 | 30 | - `:async-error`: (Required, core.async channel) When a handler or middleware is done processing a request and there was an error, the exception should be put onto this channel. Only one exception should be put onto each `:async-error` channel. 31 | 32 | ## Response Map 33 | 34 | Aysnc ring response maps are exactly the same as regular ring response maps. 35 | -------------------------------------------------------------------------------- /doc/porting_middleware.md: -------------------------------------------------------------------------------- 1 | This guide explains more about how to port Ring middleware to be Async 2 | 3 | 4 | # Using unported Ring middleware with Spiral 5 | 6 | ## Simple Case 7 | 8 | If you're lucky, then this middleware's effect is strictly before OR after 9 | the inner handler. 10 | 11 | ### Middleware modifies request 12 | 13 | If the middleware only modifies the request before passing 14 | it to the inner handler, and returns the inner handler's result 15 | unmodified, then you've got the easiest case! You can use 16 | `spiral.core/sync->async-preprocess-middleware` to do this. 17 | For example, if you wanted to port `wrap-file`, you could write: 18 | 19 | ```clojure 20 | (-> spiral-app 21 | (sync->async-preprocess-middleware wrap-file {:buffer 5})) 22 | ``` 23 | 24 | ### Middleware modifies response 25 | 26 | If the middleware only modifies the response, and doesn't ever 27 | modify or *read* the request, then you can use this technique. 28 | Remember, if your response modifier function takes the request 29 | as an argument, this function won't work. Let's look at `wrap-file-info` 30 | for example: 31 | 32 | ```clojure 33 | (-> spiral-app 34 | (sync->async-postprocess-middleware wrap-file-info {:buffer 5})) 35 | ``` 36 | 37 | ## Hard Care 38 | 39 | ### Don't port 40 | 41 | So you don't want to port your middleware over. It's still very 42 | easy to port this middleware; however, it comes at a cost: the parallelism 43 | is the maximum number of concurrent requests at this middleware AND 44 | all subsequent middleware. Furthermore, the parallelism has the 45 | potential to create too many threads! (although there are still easy 46 | optimizations to implement that will help this). 47 | 48 | Let's look at how we can use the `wrap-params` middleware, supporting 100 49 | concurrent connections (and using 100 threads): 50 | 51 | ```clojure 52 | (require '[compojure.core :refer (defroutes GET)]) 53 | (require '[ring.middleware.params :refer (wrap-params)]) 54 | (require '[org.http-kit.server :as http-kit]) 55 | (require 'spiral.adapters.http-kit) 56 | (require 'spiral.core) 57 | 58 | (defroutes traditional-ring-app 59 | (GET "/" [q] 60 | {:body (str "got " q) :status 200 :headers {"Content-Type" "text/plain"}})) 61 | 62 | (def spiral-app 63 | (-> (spiral.core/sync->async-adapter traditional-ring-app 64 | {})) 65 | (spiral.core/sync->async-middleware wrap-session 66 | {:parallelism 100})) 67 | 68 | (def server (http-kit/run-server (spiral.adapters.to-httpkit spiral-app) 69 | {:port 8080})) 70 | ``` 71 | 72 | ### Port 73 | 74 | Now is where I say that actually you want to make this middlewares 75 | feel first-class when you invoke them. For this, in `spiral.middleware`, 76 | I have a macro, `provide-process-middleware`, that can do all of these 77 | types of ports in only a few charactors and maintain docstrings. If you 78 | want to get a full performance native port, then look at the port of 79 | `ring.middleware.session` to 80 | `(provide-process-middleware session/wrap-session :both ...)`. I think that's 81 | the easiest port to understand of the full ports. 82 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject spiral "0.1.2-SNAPSHOT" 2 | :description "core.async based http server library" 3 | :url "http://github.com/dgrnbrg/spiral" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :jvm-opts ^:replace ["-Xmx4g" "-server"] 7 | :dependencies [[org.clojure/clojure "1.5.1"] 8 | [org.clojure/tools.logging "0.2.6"] 9 | [org.clojure/data.priority-map "0.0.5"] 10 | [ring "1.2.2"] 11 | [org.clojure/core.async "0.1.303.0-886421-alpha"]] 12 | :profiles {:dev {:dependencies [[ring/ring-jetty-adapter "1.3.1"] 13 | [hiccup "1.0.5"] 14 | [compojure "1.1.7"] 15 | [clj-time "0.4.4"] 16 | [http-kit "2.1.19"] 17 | [org.immutant/web "2.0.0"]] 18 | :deploy-repositories [["releases" :clojars]]}}) 19 | -------------------------------------------------------------------------------- /src/spiral/adapters/http_kit.clj: -------------------------------------------------------------------------------- 1 | (ns spiral.adapters.http-kit 2 | "This namespace provides a spiral compatible http-kit adapter. In order to use it, simple pass your spiral handler to the function to-httpkit, and have the return value of that function be the http-kit handler. 3 | 4 | For example, to run my-async-handler on http-kit, just do: 5 | 6 | (http-kit/run-server (to-httpkit my-async-handler) {:port 8080})" 7 | (:require [org.httpkit.server :as http-kit] 8 | [clojure.tools.logging :as log] 9 | [clojure.stacktrace] 10 | [ring.util.response :refer (response status)] 11 | [clojure.core.async :as async])) 12 | 13 | (defn to-httpkit 14 | "Allows the given async handler to be used on http-kit" 15 | [req-chan] 16 | (fn httpkit-adapter [req] 17 | (http-kit/with-channel req http-kit-chan 18 | (let [resp-chan (async/chan) 19 | error-chan (async/chan)] 20 | (async/>!! req-chan (assoc req 21 | :async-response resp-chan 22 | :async-error error-chan)) 23 | (async/go 24 | (async/alt! 25 | resp-chan ([resp] 26 | (if resp 27 | (http-kit/send! http-kit-chan resp) 28 | (http-kit/send! http-kit-chan (-> (response "nil response body in spiral.core/to-httpkit") 29 | (status 500))))) 30 | error-chan ([e] 31 | (clojure.stacktrace/print-cause-trace e) 32 | (http-kit/send! http-kit-chan (-> (response (str "Encountered error! See log.")) 33 | (status 500))) 34 | (log/error e "Encountered unhandled error from spiral httpkit adapapter.")))))))) 35 | 36 | -------------------------------------------------------------------------------- /src/spiral/adapters/immutant.clj: -------------------------------------------------------------------------------- 1 | (ns spiral.adapters.immutant 2 | "This namespace provides a spiral compatible immutant adapter. In order to use it, simple pass your spiral handler to the function to-immutant, and have the return value of that function be the immutant handler. 3 | 4 | For example, to run my-async-handler on immutant, just do: 5 | 6 | (immutant.web/run (to-immutant my-async-handler) :port 8080)" 7 | (:require [immutant.web.async :as immutant] 8 | [clojure.tools.logging :as log] 9 | [clojure.stacktrace] 10 | [ring.util.response :refer (response status)] 11 | [clojure.core.async :as async])) 12 | 13 | (defn to-immutant 14 | "Allows the given async handler to be used on immutant" 15 | [req-chan] 16 | (fn immutant-adapter [req] 17 | (let [resp-chan (async/chan) 18 | error-chan (async/chan)] 19 | (immutant/as-channel req 20 | :on-open 21 | (fn [ch] 22 | (async/>!! req-chan (assoc req 23 | :async-response resp-chan 24 | :async-error error-chan)) 25 | (async/go 26 | (async/alt! 27 | resp-chan ([resp] 28 | (if resp 29 | (immutant/send! ch resp 30 | :close? (not (:websocket? req))) 31 | (immutant/send! ch 32 | (-> (response "nil response body in spiral.core/to-immutant") 33 | (status 500)) 34 | :close? true))) 35 | error-chan ([e] 36 | (clojure.stacktrace/print-cause-trace e) 37 | (immutant/send! ch 38 | (-> (response (str "Encountered error! See log.")) 39 | (status 500)) 40 | :close? true) 41 | (log/error e "Encountered unhandled error from spiral error channel"))))))))) 42 | -------------------------------------------------------------------------------- /src/spiral/adapters/jetty.clj: -------------------------------------------------------------------------------- 1 | (ns spiral.adapters.jetty 2 | "This namespace provides a spiral compatible Jetty adapter. This Jetty adapter supports normal ring and spiral handlers. If you want to pass a spiral handler to the adapter, then you must use the function to-jetty to convert the ring middleware to the async-jetty-adapter. 3 | 4 | For example, to run my-async-handler on jetty, just do: 5 | 6 | (async-jetty-adapter (to-jetty my-async-handler) {:port 8080})" 7 | (:require [clojure.core.async :as async] 8 | [clojure.stacktrace] 9 | [clojure.core.async.impl.protocols] 10 | [ring.adapter.jetty] 11 | [ring.util.response :refer (response status)] 12 | [clojure.tools.logging :as log] 13 | [ring.util.servlet :as servlet])) 14 | 15 | ;; This code is adapted from https://github.com/ninjudd/ring-async 16 | 17 | (defn to-jetty 18 | [async-handler] 19 | (fn [request] 20 | async-handler)) 21 | 22 | (defn async-jetty-adapter 23 | [handler] 24 | (proxy [org.eclipse.jetty.server.handler.AbstractHandler] [] 25 | (handle [_ ^org.eclipse.jetty.server.Request base-request servlet-request servlet-response] 26 | (let [request (servlet/build-request-map servlet-request) 27 | resp (handler request)] 28 | (if (satisfies? clojure.core.async.impl.protocols/Channel resp) 29 | (let [cont (org.eclipse.jetty.continuation.ContinuationSupport/getContinuation servlet-request) 30 | resp-chan (async/chan) 31 | error-chan (async/chan)] 32 | (async/go 33 | (let [response 34 | (async/alt! 35 | resp-chan ([resp] 36 | (if resp 37 | resp 38 | (-> (response "nil response body in spiral.core/to-httpkit") 39 | (status 500)))) 40 | error-chan ([e] 41 | (clojure.stacktrace/print-cause-trace e) 42 | (log/error e) 43 | (-> (response (str "Encountered error! See log.")) 44 | (status 500))))] 45 | (servlet/update-servlet-response (.getServletResponse cont) response) 46 | (.complete cont))) 47 | (async/>!! resp (assoc request 48 | :async-response resp-chan 49 | :async-error error-chan)) 50 | (.suspend cont)) 51 | (when resp 52 | (servlet/update-servlet-response servlet-response resp) 53 | (.setHandled base-request true))))))) 54 | 55 | (defn async-jetty-configurator 56 | [configurator handler] 57 | (fn [^org.eclipse.jetty.server.Server server] 58 | (.setHandler server (async-jetty-adapter handler)) 59 | (when configurator 60 | (configurator server)))) 61 | 62 | (defn ^org.eclipse.jetty.server.Server run-jetty-async 63 | "Start a Jetty webserver to serve the given async handler. For a list 64 | of available options, see ring.adapter.jetty/run-jetty. Unlike 65 | run-jetty, this supports spiral handlers." 66 | [handler options] 67 | (ring.adapter.jetty/run-jetty nil (update-in options [:configurator] 68 | async-jetty-configurator 69 | handler))) 70 | 71 | -------------------------------------------------------------------------------- /src/spiral/beauty.clj: -------------------------------------------------------------------------------- 1 | (ns spiral.beauty 2 | "This namespace contains the Beauty concurrent quality of service routing middleware. See README.md for details on how to use Beauty in your application." 3 | (:require [clojure.data.priority-map :refer (priority-map)] 4 | [clojure.core.async :as async] 5 | [clojure.tools.logging :as log])) 6 | 7 | (defmacro beauty-route 8 | "This defers its body to run on the specied pool, with the optionally specified 9 | priority. If you want to execute side-effects in the body, you'll want to wrap it 10 | in a do." 11 | ;; Note that we prioritize so that a higher user-provided priority runs sooner, 12 | ;; and the oldest requests run sooner 13 | ([pool body] 14 | `{::beauty true 15 | :thunk (fn [] ~body) 16 | :pool ~pool 17 | :priority [5 (- (System/currentTimeMillis))]}) 18 | ([pool priority body] 19 | `{::beauty true 20 | :thunk (fn [] ~body) 21 | :pool ~pool 22 | :priority [~priority (- (System/currentTimeMillis))]})) 23 | 24 | (defn beauty-router 25 | "Creates a beauty-router pool. The pools-config should be a map, where the keys 26 | are the pool names, and the values are maps with 2 keys: :parallelism, which 27 | defines how many requests the pool can process concurrently, and :buffer-size, 28 | which defines how many requests can be queued on the pool before it starts to 29 | exhibit backpressure. Those keys have default values of 5 and 10, respectively." 30 | [handler pools-config] 31 | (let [pools (->> pools-config 32 | (map (fn [[k]] 33 | [k (async/chan)])) 34 | (into {})) 35 | req-chan (async/chan)] 36 | (doseq [[pool {:keys [parallelism buffer-size] 37 | :or {parallelism 5 buffer-size 10}}] pools-config 38 | :let [c (get pools pool) 39 | work-chan (async/chan)]] 40 | (log/debug "Creating beauty router pool" pool 41 | "with parallelism" parallelism 42 | "and buffer size" buffer-size) 43 | ;;Execution workers mustn't block the goroutine scheduler 44 | (dotimes [i parallelism] 45 | (async/thread 46 | (while true 47 | (let [{:keys [thunk request] :as task} (async/!! (:async-response request) (thunk)) 50 | (catch Throwable t 51 | (async/>!! (:async-error request) t))))))) 52 | ;;This manages the priority queue 53 | (async/go 54 | (loop [buf (priority-map)] 55 | (let [cur-buf-size (count buf) 56 | request-op (when (<= cur-buf-size buffer-size) 57 | [c]) 58 | next-work-item (ffirst (rseq buf)) 59 | work-op (when (pos? cur-buf-size) 60 | [[work-chan next-work-item]]) 61 | ops (vec (concat request-op work-op)) 62 | [val port] (async/alts! ops)] 63 | (if (= port work-chan) 64 | (recur (dissoc buf next-work-item)) 65 | (recur (assoc buf val (:priority val)))))))) 66 | ;;TODO: can add extra copies of the following router worker 67 | ;;to improve routing performance 68 | (async/go 69 | (while true 70 | (let [req (async/! (get pools (:pool resp)) (assoc resp :request req)) 80 | ;; It's an error 81 | (::error resp) 82 | (async/>! (:async-error req) (::error resp)) 83 | ;; It's a normal response 84 | :else 85 | (async/>! (:async-response req) resp))))) 86 | req-chan)) 87 | -------------------------------------------------------------------------------- /src/spiral/core.clj: -------------------------------------------------------------------------------- 1 | (ns spiral.core 2 | "This namespace provides a core.async API for Ring. It allows you define and nest synchronous 3 | and spiral handlers to create efficient, async http servers. 4 | 5 | Async handlers are just core.async channels! To use them, put ring request maps into them. 6 | Each request map must contain 2 additional keys, :async-response and :async-error, which must 7 | both be channels. For each ring request map you put into the input channel, you will recieve 8 | either a response map via the :async-response channel or a Throwable via the :async-error 9 | channel." 10 | (:require [clojure.core.async :as async])) 11 | 12 | ;;; The fundamental unit is a channel. It expects to recieve Ring request maps, which each contain 13 | ;;; 2 extra keys: `:async-response` and `:async-error`, which contain channels onto which you can 14 | ;;; put Ring response maps or Exceptions, respectively. 15 | ;;; 16 | 17 | (defn async->sync-adapter 18 | "Takes a spiral handler and converts into a normal ring handler. 19 | 20 | This uses blocking async operations, so the spiral handler shouldn't block." 21 | [async-middleware] 22 | (fn async->sync-handler-adapter-helper [req] 23 | (let [resp-chan (async/chan) 24 | error-chan (async/chan)] 25 | (async/go (async/>! async-middleware 26 | (assoc req 27 | :async-response resp-chan 28 | :async-error error-chan))) 29 | (async/alt!! 30 | resp-chan ([resp] resp) 31 | error-chan ([e] (throw e)))))) 32 | 33 | (defn sync->async-adapter 34 | "This takes a normal ring handler and converts it into a spiral 35 | handler. It runs the ring handler on up to :parallelism goroutines, 36 | and it will queue up to :buffer-size requests before exhibiting 37 | back-pressure." 38 | [handler {:keys [parallelism buffer-size] 39 | :or {parallelism 5 40 | buffer-size 10} 41 | :as options}] 42 | (let [req-chan (async/chan buffer-size)] 43 | (dotimes [i parallelism] 44 | (async/thread 45 | (while true 46 | (let [req (async/!! (:async-response req) resp) 51 | (async/>!! (:async-error req) 52 | (ex-info "Handler returned null" 53 | {:req req :handler handler})))) 54 | (catch Throwable e 55 | (async/>!! (:async-error req) e))))))) 56 | req-chan)) 57 | 58 | (defn sync->async-middleware 59 | "This lets you use normal ring middleware in a spiral app. You must 60 | provide the async-handler that will be wrapped with the middleware, 61 | an options map (nil means use defaults) to configure the concurrent 62 | properties of the synchronous middleware, and you can optionally provide 63 | additional args for the ring middleware. 64 | 65 | For example, suppose that ah is an sync ring handler. To combine it 66 | with ring.middleware.json/wrap-json-body, we can write: 67 | 68 | (sync->async-middleware ah wrap-json-body {:parallelism 2} {:keywords? true}) 69 | 70 | Thus you can see how extra arguments (i.e. {:keyswords? true}) are passed to 71 | wrap-json-body. 72 | 73 | See async->sync-middleware for the dual. 74 | " 75 | [async-handler middleware options & args] 76 | (let [handler (async->sync-adapter async-handler)] 77 | (sync->async-adapter (apply middleware handler args) options))) 78 | 79 | (defn async->sync-middleware 80 | "This lets you use spiral middleware in a normal ring app. You 81 | simply provide the normal ring handler as well as the constructor 82 | function for the async-middlware, along with any args that the 83 | async-middleware might take. 84 | 85 | Options configures the concurrency properties of the given 86 | normal ring handler; this will affect performance of the async 87 | middleware. 88 | 89 | See sync->async-middleware for the dual. 90 | " 91 | [handler options async-middleware & args] 92 | (let [async-handler (sync->async-adapter handler options)] 93 | (async->sync-adapter (apply async-middleware async-handler args)))) 94 | 95 | (defn sync->async-preprocess-middleware 96 | "This is like sync->async-middleware, except it skips the processing **after** 97 | it calls the child function." 98 | [async-handler sync-preprocess-middleware 99 | {:keys [parallelism buffer-size] 100 | :or {parallelism 5 101 | buffer-size 10} 102 | :as options} 103 | & args] 104 | (let [req-chan (async/chan buffer-size) 105 | forward-handler (apply sync-preprocess-middleware 106 | (fn fwd [req] 107 | {::fwd req}) 108 | args)] 109 | (dotimes [i parallelism] 110 | (async/go 111 | (while true 112 | (let [req (async/! async-handler to-fwd) 117 | (async/>! (:async-response req) resp))) 118 | (catch Throwable e 119 | (async/>! (:async-error req) e))))))) 120 | req-chan)) 121 | 122 | (defn sync->async-postprocess-middleware 123 | "This is like sync->async-middleware, except it skips the processing **before** 124 | it calls the child function." 125 | [async-handler sync-postprocess-middleware 126 | {:keys [parallelism buffer-size] 127 | :or {parallelism 5 128 | buffer-size 10} 129 | :as options} 130 | & args] 131 | (let [req-chan (async/chan buffer-size) 132 | post-process (apply sync-postprocess-middleware 133 | (fn fwd [resp] 134 | (if-let [e (::error resp)] 135 | (throw e) 136 | resp)) args)] 137 | (dotimes [i parallelism] 138 | (async/go 139 | (while true 140 | (let [req (async/! async-handler 144 | (assoc req 145 | :async-response resp-chan 146 | :async-error error-chan)) 147 | (try 148 | (let [value (async/alt! 149 | resp-chan ([resp] resp) 150 | error-chan ([e] {::error e})) 151 | result (post-process value)] 152 | (if result 153 | (async/>! (:async-response req) result) 154 | (async/>! (:async-error req) 155 | (ex-info "post-process handler returned nil" 156 | {:req req :middleware sync-postprocess-middleware :value-before-postprocess value})))) 157 | (catch Throwable e 158 | (async/>! (:async-error req) e))))))) 159 | req-chan)) 160 | 161 | (defn constant-response 162 | "Returns an async-handler that always returns the given response." 163 | [response] 164 | (let [req-chan (async/chan)] 165 | (async/go 166 | (while true 167 | (async/>! (:async-response (async/! (:async-response req) resp)) 26 | error-chan ([e] (swap! outstanding dec) (async/>! (:async-error req) e)))) 27 | (async/>! async-middleware 28 | (assoc req 29 | :async-response resp-chan 30 | :async-error error-chan))) 31 | (async/>! (:async-response req) shed-response))))) 32 | req-chan)) 33 | 34 | (defn- strip-guard-prefix 35 | "Strips the guard string from the front of the path, returning the 36 | suffix string or nil if the path is nil or the resulting suffix is 37 | \"\"." 38 | [path guard] 39 | (when path 40 | (let [suffix (.substring ^String path (count guard))] 41 | (when-not (empty? suffix) suffix)))) 42 | 43 | (defn route-concurrently- 44 | [pairs] 45 | (let [req-chan (async/chan)] 46 | (async/go 47 | (while true 48 | (let [req (async/! fwd (assoc req 54 | :uri (or (strip-guard-prefix (:uri req) guard) "/") 55 | :path-info (strip-guard-prefix (:path-info req) guard)))))) 56 | req-chan)) 57 | 58 | (defmacro route-concurrently 59 | "TODO: We must consider whether we should route and pass along the prefix or not, 60 | and whether we should force the inclusion of the trailing slash (because the 61 | standalone / is the start and the end, so what's up with that?)" 62 | [& args] 63 | (let [pairs (partition 2 args) 64 | compiled (mapv (fn [[guard fwd]] 65 | (when-not (string? guard) 66 | (throw (ex-info "guard must be a string" {:guard guard}))) 67 | [guard fwd]) 68 | pairs)] 69 | `(route-concurrently- ~compiled))) 70 | 71 | ;; Wow, you read this far into the code! 72 | ;; This async-middleware section is an experiment designed to make 73 | ;; it easier to write new async middleware. It's not clear to me 74 | ;; whether the complexity of making a pluggable middleware is enough 75 | ;; of an advantage over just writing the middleware yourself 76 | 77 | #_(defn async-middleware 78 | [h & {request-transform :req 79 | response-tranform :resp 80 | error-transform :error 81 | parallelism :parallism 82 | :or {parallelism 5}}] 83 | (let [req-chan (async/chan)] 84 | (dotimes [i parallelism] 85 | (async/go 86 | (while true 87 | (let [request-map (async/! (:async-response request-map) resp))) 94 | error-chan ([e] ((or error-transform identity) 95 | (async/>! (:async-error request-map) e))))) 96 | ;; nil = short circuit 97 | (when tranformed-request 98 | (async/>! h 99 | (assoc tranformed-request 100 | :async-response resp-chan 101 | :async-error error-chan))))))) 102 | req-chan)) 103 | 104 | #_(defn work-shed 105 | [h threshold-concurrency] 106 | (let [outstanding (atom 0) 107 | bouncer (constant-response [:status 503 :body "overload"])] 108 | (async-middleware 109 | h 110 | :req (fn [req next-chan] 111 | (swap! outstanding inc) 112 | (if (< @outstanding threshold-concurrency) 113 | req 114 | (do 115 | (async/>!! bouncer) 116 | nil))) 117 | :resp (fn [resp] (swap! outstanding dec) resp) 118 | :error (fn [e] (swap! outstanding dec) e)))) 119 | -------------------------------------------------------------------------------- /src/spiral/middleware.clj: -------------------------------------------------------------------------------- 1 | (ns spiral.middleware 2 | (:require [spiral.core :refer (sync->async-preprocess-middleware sync->async-postprocess-middleware)] 3 | [clojure.core.async :as async] 4 | [ring.middleware.file-info :as file-info] 5 | [ring.middleware.params :as params] 6 | [ring.middleware.content-type :as content-type] 7 | [ring.middleware.file :as file] 8 | [ring.middleware.keyword-params :as keyword-params] 9 | [ring.middleware.flash :as flash] 10 | [ring.middleware.head :as head] 11 | [ring.middleware.multipart-params :as multipart-params] 12 | [ring.middleware.nested-params :as nested-params] 13 | [ring.middleware.resource :as resource] 14 | [ring.middleware.session :as session] 15 | [ring.middleware.cookies :as cookies])) 16 | 17 | (defn change-arg-to-async-handler 18 | [arglist] 19 | (if (#{'handler 'h 'app} (first arglist)) 20 | (vec (concat ['async-handler 'async-options] (next arglist))) 21 | (throw (ex-info "Don't recognize arglist" {:arglist arglist})))) 22 | 23 | (defn both-side-process-middleware 24 | [async-handler init-side preprocess-side postprocess-side 25 | {:keys [parallelism buffer-size] 26 | :or {parallelism 5 27 | buffer-size 10} 28 | :as options} 29 | & args] 30 | (let [req-chan (async/chan buffer-size) 31 | state (apply init-side args)] 32 | (dotimes [i parallelism] 33 | (async/go 34 | (while true 35 | (let [req (async/! async-handler 41 | (assoc preprocessed-req 42 | :async-response resp-chan 43 | :async-error error-chan)) 44 | (let [value (async/alt! 45 | resp-chan ([resp] resp) 46 | error-chan ([e] (throw e))) 47 | result (apply postprocess-side state' value args)] 48 | (if result 49 | (async/>! (:async-response req) result) 50 | (async/>! (:async-error req) 51 | (ex-info "post-process handler returned nil" 52 | {:req req :value-before-postprocess value}))))) 53 | (catch Throwable e 54 | (async/>! (:async-error req) e))))))) 55 | req-chan)) 56 | 57 | (defmacro provide-process-middleware 58 | [f pre-or-post & [initpro prepro postpro :as impls]] 59 | (let [v (resolve f) 60 | details (-> (meta v) 61 | (update-in [:arglists] #(map change-arg-to-async-handler %)) 62 | (assoc :ns *ns*) 63 | (update-in [:doc] #(str "This is the spiral version of " (:ns (meta v)) \/ (:name (meta v)) \newline \newline %))) 64 | standard-case `(apply ~(case pre-or-post 65 | :post `sync->async-postprocess-middleware 66 | :pre `sync->async-preprocess-middleware 67 | :both nil 68 | (throw (ex-info "Must use :pre or :post for pre-or-post arg" 69 | {:pre-or-post pre-or-post}))) 70 | ~'async-handler 71 | ~f 72 | ~'opts 73 | ~'args) 74 | special-case `(apply both-side-process-middleware 75 | ~'async-handler 76 | ~initpro ~prepro ~postpro 77 | ~'opts ~'args)] 78 | `(defn ~(:name (meta v)) 79 | ~(:doc details) 80 | {:arglists '~(:arglists details)} 81 | [~'async-handler ~'opts & ~'args] 82 | ~(if (and (= :both pre-or-post) impls) special-case standard-case)))) 83 | 84 | 85 | (provide-process-middleware params/wrap-params :pre) 86 | (provide-process-middleware file-info/wrap-file-info :post) 87 | (provide-process-middleware 88 | file-info/wrap-file-info :both 89 | (fn wrap-init [& args]) 90 | (fn wrap-pre 91 | [state request & args] 92 | [request request]) 93 | (fn wrap-post 94 | [state response & [mime-types]] 95 | (file-info/file-info-response response state mime-types))) 96 | (provide-process-middleware file/wrap-file :pre) 97 | (provide-process-middleware keyword-params/wrap-keyword-params :pre) 98 | (provide-process-middleware multipart-params/wrap-multipart-params :pre) 99 | (provide-process-middleware nested-params/wrap-nested-params :pre) 100 | (provide-process-middleware resource/wrap-resource :pre) 101 | 102 | (provide-process-middleware 103 | content-type/wrap-content-type :both 104 | (fn wrap-init [& args]) 105 | (fn wrap-pre 106 | [state request & args] 107 | [request request]) 108 | (fn wrap-post 109 | [state response & [opts]] 110 | (content-type/content-type-response response state opts))) 111 | 112 | 113 | (provide-process-middleware 114 | cookies/wrap-cookies :both 115 | (fn wrap-init [& args]) 116 | (fn wrap-pre 117 | [state request] 118 | (let [request (if (request :cookies) 119 | request 120 | (assoc request :cookies (#'cookies/parse-cookies request)))] 121 | [nil request])) 122 | (fn wrap-post 123 | [state response] 124 | (-> response 125 | (#'cookies/set-cookies) 126 | (dissoc :cookies)))) 127 | 128 | (provide-process-middleware 129 | flash/wrap-flash :both 130 | (fn wrap-init [& args]) 131 | (fn wrap-pre [state request] 132 | (let [session (:session request) 133 | flash (:_flash session) 134 | session (dissoc session :_flash) 135 | request (assoc request :session session, :flash flash)] 136 | [{:session session 137 | :flash flash} request])) 138 | (fn wrap-post [state response] 139 | (if-let [response response] 140 | (let [session (if (contains? response :session) 141 | (response :session) 142 | (:session state)) 143 | session (if-let [flash (response :flash)] 144 | (assoc (response :session session) :_flash flash) 145 | session)] 146 | (if (or (:flash state) (response :flash) (contains? response :session)) 147 | (assoc response :session session) 148 | response))))) 149 | 150 | (provide-process-middleware 151 | head/wrap-head :both 152 | (fn wrap-init [& args]) 153 | (fn wrap-pre [state request] 154 | (if (= :head (:request-method request)) 155 | [true (-> request 156 | (assoc :request-method :get))] 157 | [false request])) 158 | (fn wrap-post [state response] 159 | (if state 160 | (assoc response :body nil) 161 | response))) 162 | 163 | (provide-process-middleware 164 | session/wrap-session :both 165 | (fn wrap-init 166 | ([] (wrap-init {})) 167 | ([options] 168 | (session/session-options options))) 169 | (fn wrap-pre 170 | ([opts request] 171 | (wrap-pre opts request {})) 172 | ([opts request _] 173 | (let [req (session/session-request request opts)] 174 | [[opts req] req]))) 175 | (fn wrap-post 176 | ([state response] 177 | (wrap-post state response {})) 178 | ([[opts req] response _] 179 | (session/session-response response req opts)))) 180 | -------------------------------------------------------------------------------- /test/ring/assets/bars/backlink: -------------------------------------------------------------------------------- 1 | . -------------------------------------------------------------------------------- /test/ring/assets/bars/foo.html: -------------------------------------------------------------------------------- 1 | foo -------------------------------------------------------------------------------- /test/ring/assets/foo.html: -------------------------------------------------------------------------------- 1 | foo -------------------------------------------------------------------------------- /test/ring/assets/hello world.txt: -------------------------------------------------------------------------------- 1 | Hello World 2 | -------------------------------------------------------------------------------- /test/ring/assets/index.html: -------------------------------------------------------------------------------- 1 | index -------------------------------------------------------------------------------- /test/ring/assets/plain.txt: -------------------------------------------------------------------------------- 1 | plain 2 | -------------------------------------------------------------------------------- /test/ring/assets/random.xyz: -------------------------------------------------------------------------------- 1 | random 2 | -------------------------------------------------------------------------------- /test/ring/backlink: -------------------------------------------------------------------------------- 1 | backlink -------------------------------------------------------------------------------- /test/spiral/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns spiral.core-test 2 | "Isn't testing fun? This is just one big inbred testing file, because it's 3 | much easier to start each server and run the full test battery against them. 4 | Eventually, this could be split into several test files." 5 | (:require [clojure.test :refer :all] 6 | [compojure.core :refer (ANY GET defroutes routes)] 7 | [org.httpkit.server :as http-kit] 8 | [org.httpkit.client :as http] 9 | [immutant.web :as immutant] 10 | [hiccup.core :refer (html)] 11 | [ring.middleware.params :refer (wrap-params)] 12 | [ring.middleware.file-info :refer (wrap-file-info)] 13 | [ring.util.response :refer (response content-type)] 14 | [spiral.beauty :refer :all] 15 | [spiral.adapters.http-kit :refer :all] 16 | [spiral.adapters.jetty :refer :all] 17 | [spiral.adapters.immutant :refer :all] 18 | [spiral.experimental :refer :all] 19 | [spiral.core :refer :all])) 20 | 21 | (defroutes ring-app 22 | (GET "/" [] 23 | (-> (response "all ok") 24 | (content-type "text/plain"))) 25 | (GET "/magicfile" [] 26 | (-> (response (java.io.File. "project.clj")) 27 | (content-type "text/plain"))) 28 | (GET "/param" [q] 29 | (-> (html [:html 30 | [:body 31 | (concat 32 | (when q 33 | [[:p (str "To " q)]]) 34 | [[:p 35 | "Hello world, from Ring"]])]]) 36 | (response) 37 | (content-type "text/html")))) 38 | 39 | (defn request 40 | [method url] 41 | (deref (http/request {:url url :method method} identity) 1000 nil)) 42 | 43 | (defmacro scaffold-servers 44 | [app & body] 45 | `(do 46 | (testing "http-kit" 47 | (let [server# (http-kit/run-server (to-httpkit ~app) {:port 12438})] 48 | (try 49 | ~@body 50 | (finally 51 | (server#))))) 52 | (testing "jetty" 53 | (let [server# (run-jetty-async (to-jetty ~app) {:port 12438 :join? false})] 54 | (try 55 | ~@body 56 | (finally 57 | (.stop server#))))) 58 | (testing "immutant" 59 | (let [server# (immutant/run (to-immutant ~app) :port 12438)] 60 | (try 61 | ~@body 62 | (finally 63 | (immutant/stop server#))))))) 64 | 65 | (deftest jetty-sync-mode 66 | (let [server (run-jetty-async (fn [req] {:status 200 :body "sync-hi" :headers {"Content-Type" "text/plain"}}) {:port 12438 :join? false})] 67 | (try 68 | (is (= (:body (deref (http/request {:url "http://localhost:12438" :method :get}))) "sync-hi")) 69 | (finally 70 | (.stop server))))) 71 | 72 | (comment 73 | (def srv (http-kit/run-server 74 | (to-httpkit 75 | (-> (route-concurrently 76 | "/app" (sync->async-adapter #'ring-app {}) 77 | "/" (constant-response {:status 404 :body "invalid"})) 78 | (sync->async-middleware wrap-params {}))) {:port 12438})) 79 | (srv) 80 | ) 81 | 82 | (deftest serve-constant-response 83 | (scaffold-servers (constant-response {:status 200 :body "success" :headers {"Content-Type" "text/plain"}}) 84 | (is (= (:body (request :get "http://localhost:12438/")) "success")) 85 | (is (= (:body (request :put "http://localhost:12438/")) "success")) 86 | (is (= (:body (request :post "http://localhost:12438/foo")) "success")))) 87 | 88 | (deftest serve-ring-app 89 | (scaffold-servers (sync->async-adapter #'ring-app {}) 90 | (is (= (:body (request :get "http://localhost:12438/")) "all ok")) 91 | (println "Expect to see an exception next--nothing to worry about") 92 | (is (= (:status (request :post "http://localhost:12438/")) 500)))) 93 | 94 | (deftest serve-ring-middleware 95 | (scaffold-servers (-> (sync->async-adapter #'ring-app {}) 96 | (sync->async-middleware wrap-params {})) 97 | (is (= (:body (request :get "http://localhost:12438/")) "all ok")) 98 | (let [body ^String (:body (request :get "http://localhost:12438/param?q=clojure"))] 99 | (is (.contains body "To clojure")) 100 | (is (.startsWith body ""))))) 101 | 102 | (deftest serve-ring-preprocess-middleware 103 | (scaffold-servers (-> (sync->async-adapter #'ring-app {}) 104 | (sync->async-preprocess-middleware wrap-params {})) 105 | (is (= (:body (request :get "http://localhost:12438/")) "all ok")) 106 | (let [body ^String (:body (request :get "http://localhost:12438/param?q=clojure"))] 107 | (is (.contains body "To clojure")) 108 | (is (.startsWith body ""))))) 109 | 110 | (deftest serve-ring-postprocess-middleware 111 | (scaffold-servers (-> (sync->async-adapter #'ring-app {}) 112 | (sync->async-postprocess-middleware wrap-file-info {})) 113 | (is (= (:body (request :get "http://localhost:12438/")) "all ok")) 114 | (let [{:as foo :keys [headers body]} (request :get "http://localhost:12438/magicfile")] 115 | (is (= org.httpkit.BytesInputStream (class body))) 116 | (is (contains? headers :content-length))))) 117 | 118 | (deftest serve-route-concurrently 119 | (scaffold-servers (-> (route-concurrently 120 | "/app" (sync->async-adapter #'ring-app {}) 121 | "/" (constant-response {:status 404 :body "invalid"})) 122 | (sync->async-middleware wrap-params {})) 123 | (is (= (:body (request :get "http://localhost:12438/")) "invalid")) 124 | (is (= (:body (request :put "http://localhost:12438/")) "invalid")) 125 | (is (= (:body (request :post "http://localhost:12438/foo")) "invalid")) 126 | ;;TODO figure out what the correct behavior for this case is 127 | ;(is (= (:body (request :post "http://localhost:12438/app")) "invalid")) 128 | (is (= (:body (request :get "http://localhost:12438/app/")) "all ok")))) 129 | 130 | (defn string-response 131 | [msg] 132 | {:status 200 :body msg :headers {"Content-Type" "text-plain"}}) 133 | 134 | (deftest beauty-router-test 135 | (scaffold-servers (beauty-router 136 | (routes 137 | (GET "/" [] 138 | (beauty-route :normal 139 | (string-response "root resp"))) 140 | (GET "/boring" [] 141 | (string-response "boring")) 142 | (GET "/test/:code" [code] 143 | (beauty-route :test 144 | (string-response (str "test " code))))) 145 | {:normal {:parallelism 1} 146 | :test {:parallelism 10}}) 147 | (is (= (:body (request :get "http://localhost:12438/")) "root resp")) 148 | (is (= (:body (request :get "http://localhost:12438/boring")) "boring")) 149 | (is (= (:body (request :get "http://localhost:12438/test/blah")) "test blah")))) 150 | 151 | ;; TODO: test work shedder 152 | -------------------------------------------------------------------------------- /test/spiral/middleware_test.clj: -------------------------------------------------------------------------------- 1 | (ns spiral.middleware-test 2 | (:use clojure.test 3 | spiral.core 4 | [ring.middleware.session :only [session-request session-response]] 5 | ring.middleware.session.store 6 | [clojure.string :only (split)] 7 | [ring.util.io :only (string-input-stream)] 8 | [clj-time.core :only (interval date-time)] 9 | spiral.middleware) 10 | (:require ring.middleware.session.memory) 11 | (:import java.io.File)) 12 | 13 | (defmacro patch-test 14 | "I'm bored of refactoring tests. This refacts the middleware tests automatically, 15 | usually." 16 | [middleware constant-handler & args] 17 | `(async->sync-adapter (~middleware (sync->async-adapter ~constant-handler {}) {} ~@args))) 18 | 19 | (deftest wrap-content-type-test 20 | (testing "response without content-type" 21 | (let [response {:headers {}} 22 | handler (async->sync-adapter (wrap-content-type (constant-response response) {}))] 23 | (is (= (handler {:uri "/foo/bar.png"}) 24 | {:headers {"Content-Type" "image/png"}})) 25 | (is (= (handler {:uri "/foo/bar.txt"}) 26 | {:headers {"Content-Type" "text/plain"}})))) 27 | 28 | (testing "response with content-type" 29 | (let [response {:headers {"Content-Type" "application/x-foo"}} 30 | handler (async->sync-adapter (wrap-content-type (constant-response response) {}))] 31 | (is (= (handler {:uri "/foo/bar.png"}) 32 | {:headers {"Content-Type" "application/x-foo"}})))) 33 | 34 | (testing "unknown file extension" 35 | (let [response {:headers {}} 36 | handler (async->sync-adapter (wrap-content-type (constant-response response) {}))] 37 | (is (= (handler {:uri "/foo/bar.xxxaaa"}) 38 | {:headers {"Content-Type" "application/octet-stream"}})) 39 | (is (= (handler {:uri "/foo/bar"}) 40 | {:headers {"Content-Type" "application/octet-stream"}}))))) 41 | 42 | (deftest wrap-cookies-set-basic-cookie 43 | (let [handler (constant-response {:cookies {"a" "b"}}) 44 | resp ((async->sync-adapter (wrap-cookies handler {})) {})] 45 | (is (= {"Set-Cookie" (list "a=b")} 46 | (:headers resp))))) 47 | 48 | (deftest wrap-cookies-set-multiple-cookies 49 | (let [handler (constant-response {:cookies {"a" "b", "c" "d"}}) 50 | resp ((async->sync-adapter (wrap-cookies handler {})) {})] 51 | (is (= {"Set-Cookie" (list "a=b" "c=d")} 52 | (:headers resp))))) 53 | 54 | (deftest wrap-cookies-set-keyword-cookie 55 | (let [handler (constant-response {:cookies {:a "b"}}) 56 | resp ((async->sync-adapter (wrap-cookies handler {})) {})] 57 | (is (= {"Set-Cookie" (list "a=b")} 58 | (:headers resp))))) 59 | 60 | (defn =cookie 61 | [l r] 62 | (let [lc (get l "Set-Cookie") 63 | rc (get r "Set-Cookie")] 64 | (->> (map vector lc rc) 65 | (map (fn [[l r]] 66 | (= (set (split l #";")) 67 | (set (split r #";"))))) 68 | (every? true?)))) 69 | 70 | (deftest wrap-cookies-set-extra-attrs 71 | (let [cookies {"a" {:value "b", :path "/", :secure true, :http-only true }} 72 | handler (constant-response {:cookies cookies}) 73 | resp ((async->sync-adapter (wrap-cookies handler {})) {})] 74 | (is (=cookie {"Set-Cookie" (list "a=b;Path=/;HttpOnly;Secure")} 75 | (:headers resp))))) 76 | 77 | (deftest wrap-cookies-set-urlencoded-cookie 78 | (let [handler (constant-response {:cookies {"a" "hello world"}}) 79 | resp ((async->sync-adapter (wrap-cookies handler {})) {})] 80 | (is (= {"Set-Cookie" (list "a=hello+world")} 81 | (:headers resp))))) 82 | 83 | (deftest wrap-cookies-keep-set-cookies-intact 84 | (let [handler (constant-response {:headers {"Set-Cookie" (list "a=b")} 85 | :cookies {:c "d"}}) 86 | resp ((async->sync-adapter (wrap-cookies handler {})) {})] 87 | (is (= {"Set-Cookie" (list "a=b" "c=d")} 88 | (:headers resp))))) 89 | 90 | (deftest wrap-cookies-invalid-attrs 91 | (let [response {:cookies {"a" {:value "foo" :invalid true}}} 92 | handler (async->sync-adapter (wrap-cookies (constant-response response) {}))] 93 | (is (thrown? AssertionError (handler {}))))) 94 | 95 | (deftest wrap-cookies-accepts-max-age 96 | (let [cookies {"a" {:value "b", :path "/", 97 | :secure true, :http-only true, 98 | :max-age 123}} 99 | handler (constant-response {:cookies cookies}) 100 | resp ((async->sync-adapter (wrap-cookies handler {})) {})] 101 | (is (=cookie {"Set-Cookie" (list "a=b;Path=/;Secure;HttpOnly;Max-Age=123")} 102 | (:headers resp))))) 103 | 104 | (deftest wrap-cookies-accepts-expires 105 | (let [cookies {"a" {:value "b", :path "/", 106 | :secure true, :http-only true, 107 | :expires "123"}} 108 | handler (constant-response {:cookies cookies}) 109 | resp ((async->sync-adapter (wrap-cookies handler {})) {})] 110 | (is (=cookie {"Set-Cookie" (list "a=b;Path=/;Secure;HttpOnly;Expires=123")} 111 | (:headers resp))))) 112 | 113 | (deftest wrap-cookies-accepts-max-age-from-clj-time 114 | (let [cookies {"a" {:value "b", :path "/", 115 | :secure true, :http-only true, 116 | :max-age (interval (date-time 2012) 117 | (date-time 2015))}} 118 | handler (constant-response {:cookies cookies}) 119 | resp ((async->sync-adapter (wrap-cookies handler {})) {}) 120 | max-age 94694400] 121 | (is (= {"Set-Cookie" (list (str "a=b;Path=/;Secure;HttpOnly;Max-Age=" max-age))} 122 | (:headers resp))))) 123 | 124 | (deftest wrap-cookies-accepts-expires-from-clj-time 125 | (let [cookies {"a" {:value "b", :path "/", 126 | :secure true, :http-only true, 127 | :expires (date-time 2015 12 31)}} 128 | handler (constant-response {:cookies cookies}) 129 | resp ((async->sync-adapter (wrap-cookies handler {})) {}) 130 | expires "Thu, 31 Dec 2015 00:00:00 +0000"] 131 | (is (= {"Set-Cookie" (list (str "a=b;Path=/;Secure;HttpOnly;Expires=" expires))} 132 | (:headers resp))))) 133 | 134 | (deftest wrap-cookies-throws-exception-when-not-using-intervals-correctly 135 | (let [cookies {"a" {:value "b", :path "/", 136 | :secure true, :http-only true, 137 | :expires (interval (date-time 2012) 138 | (date-time 2015))}} 139 | handler (constant-response {:cookies cookies})] 140 | 141 | (is (thrown? AssertionError ((async->sync-adapter (wrap-cookies handler {})) {}))))) 142 | 143 | (deftest wrap-cookies-throws-exception-when-not-using-datetime-correctly 144 | (let [cookies {"a" {:value "b", :path "/", 145 | :secure true, :http-only true, 146 | :max-age (date-time 2015 12 31)}} 147 | handler (constant-response {:cookies cookies})] 148 | (is (thrown? AssertionError ((async->sync-adapter (wrap-cookies handler {})) {}))))) 149 | 150 | (deftest wrap-file-no-directory 151 | (is (thrown-with-msg? Exception #".*Directory does not exist.*" 152 | (wrap-file (constant-response {::response true}) {} "not_here")))) 153 | 154 | (def public-dir "test/ring/assets") 155 | (def index-html (File. ^String public-dir "index.html")) 156 | (def foo-html (File. ^String public-dir "foo.html")) 157 | 158 | (def app (async->sync-adapter (wrap-file (constant-response {::response true}) {} public-dir))) 159 | 160 | (deftest test-wrap-file-unsafe-method 161 | (is (::response (app {:request-method :post :uri "/foo"})))) 162 | 163 | (deftest test-wrap-file-forbidden-url 164 | (is (::response (app {:request-method :get :uri "/../foo"})))) 165 | 166 | (deftest test-wrap-file-no-file 167 | (is (::response (app {:request-method :get :uri "/dynamic"})))) 168 | 169 | (deftest test-wrap-file-directory 170 | (let [{:keys [status headers body]} (app {:request-method :get :uri "/"})] 171 | (is (= 200 status)) 172 | (is (= index-html body)))) 173 | 174 | (deftest test-wrap-file-with-extension 175 | (let [{:keys [status headers body]} (app {:request-method :get :uri "/foo.html"})] 176 | (is (= 200 status)) 177 | (is (= foo-html body)))) 178 | 179 | (deftest test-wrap-file-no-index 180 | (let [app (async->sync-adapter (wrap-file (constant-response {::response true}) {} public-dir {:index-files? false})) 181 | resp (app {:request-method :get :uri "/"})] 182 | (is (::response resp)))) 183 | 184 | (def non-file-app (async->sync-adapter (wrap-file-info (constant-response {:headers {} :body "body"}) {}))) 185 | 186 | (def known-file (File. "test/ring/assets/plain.txt")) 187 | (def known-file-app (async->sync-adapter (wrap-file-info (constant-response {:headers {} :body known-file}) {}))) 188 | 189 | (def unknown-file (File. "test/ring/assets/random.xyz")) 190 | (def unknown-file-app (async->sync-adapter (wrap-file-info (constant-response {:headers {} :body unknown-file}) {}))) 191 | 192 | (defmacro with-last-modified 193 | "Lets us use a known file modification time for tests, without permanently changing 194 | the file's modification time." 195 | [[file new-time] form] 196 | `(let [old-time# (.lastModified ~file)] 197 | (.setLastModified ~file ~(* new-time 1000)) 198 | (try ~form 199 | (finally (.setLastModified ~file old-time#))))) 200 | 201 | (def custom-type-app 202 | (async->sync-adapter (wrap-file-info 203 | (constant-response {:headers {} :body known-file}) {} 204 | {"txt" "custom/type"}))) 205 | 206 | (deftest wrap-file-info-non-file-response 207 | (is (= {:headers {} :body "body"} (non-file-app {})))) 208 | 209 | (deftest wrap-file-info-known-file-response 210 | (with-last-modified [known-file 1263506400] 211 | (is (= {:headers {"Content-Type" "text/plain" 212 | "Content-Length" "6" 213 | "Last-Modified" "Thu, 14 Jan 2010 22:00:00 +0000"} 214 | :body known-file} 215 | (known-file-app {:headers {}}))))) 216 | 217 | (deftest wrap-file-info-unknown-file-response 218 | (with-last-modified [unknown-file 1263506400] 219 | (is (= {:headers {"Content-Type" "application/octet-stream" 220 | "Content-Length" "7" 221 | "Last-Modified" "Thu, 14 Jan 2010 22:00:00 +0000"} 222 | :body unknown-file} 223 | (unknown-file-app {:headers {}}))))) 224 | 225 | (deftest wrap-file-info-custom-mime-types 226 | (with-last-modified [known-file 0] 227 | (is (= {:headers {"Content-Type" "custom/type" 228 | "Content-Length" "6" 229 | "Last-Modified" "Thu, 01 Jan 1970 00:00:00 +0000"} 230 | :body known-file} 231 | (custom-type-app {:headers {}}))))) 232 | 233 | (deftest wrap-file-info-if-modified-since-hit 234 | (with-last-modified [known-file 1263506400] 235 | (is (= {:status 304 236 | :headers {"Content-Type" "text/plain" 237 | "Content-Length" "0" 238 | "Last-Modified" "Thu, 14 Jan 2010 22:00:00 +0000"} 239 | :body ""} 240 | (known-file-app 241 | {:headers {"if-modified-since" "Thu, 14 Jan 2010 22:00:00 +0000" }}))))) 242 | 243 | (deftest wrap-file-info-if-modified-miss 244 | (with-last-modified [known-file 1263506400] 245 | (is (= {:headers {"Content-Type" "text/plain" 246 | "Content-Length" "6" 247 | "Last-Modified" "Thu, 14 Jan 2010 22:00:00 +0000"} 248 | :body known-file} 249 | (known-file-app 250 | {:headers {"if-modified-since" "Wed, 13 Jan 2010 22:00:00 +0000"}}))))) 251 | 252 | (deftest flash-is-added-to-session 253 | (let [message {:error "Could not save"} 254 | handler (patch-test wrap-flash (constantly {:flash message})) 255 | response (handler {:session {}})] 256 | (is (= (:session response) {:_flash message})))) 257 | 258 | (deftest flash-is-retrieved-from-session 259 | (let [message {:error "Could not save"} 260 | handler (async->sync-adapter 261 | (wrap-flash 262 | (sync->async-adapter (fn [request] 263 | (is (= (:flash request) message)) 264 | {}) 265 | {}) {}))] 266 | (handler {:session {:_flash message}}))) 267 | 268 | (deftest flash-is-removed-after-read 269 | (let [message {:error "Could not save"} 270 | handler (patch-test wrap-flash (constantly {:session {:foo "bar"}})) 271 | response (handler {:session {:_flash message}})] 272 | (is (nil? (:flash response))) 273 | (is (= (:session response) {:foo "bar"})))) 274 | 275 | (deftest flash-doesnt-wipe-session 276 | (let [message {:error "Could not save"} 277 | handler (patch-test wrap-flash (constantly {:flash message})) 278 | response (handler {:session {:foo "bar"}})] 279 | (is (= (:session response) {:foo "bar", :_flash message})))) 280 | 281 | (deftest flash-overwrites-nil-session 282 | (let [message {:error "Could not save"} 283 | handler (patch-test wrap-flash (constantly {:flash message, :session nil})) 284 | response (handler {:session {:foo "bar"}})] 285 | (is (= (:session response) {:_flash message})))) 286 | 287 | (deftest test-wrap-head 288 | (let [handler (sync->async-adapter 289 | (fn [req] 290 | {:status 200 291 | :headers {"X-method" (name (:request-method req))} 292 | :body "Foobar"}) {})] 293 | (let [resp ((async->sync-adapter (wrap-head handler {})) {:request-method :head})] 294 | (is (nil? (:body resp))) 295 | (is (= "get" (get-in resp [:headers "X-method"])))) 296 | (let [resp ((async->sync-adapter (wrap-head handler {})) {:request-method :post})] 297 | (is (= (:body resp) "Foobar")) 298 | (is (= "post" (get-in resp [:headers "X-method"])))))) 299 | 300 | (deftest test-wrap-keyword-params 301 | (let [wrapped-echo (async->sync-adapter (wrap-keyword-params (sync->async-adapter (fn [h] h) {}) {}))] 302 | (are [in out] (= out (:params (wrapped-echo {:params in}))) 303 | {"foo" "bar" "biz" "bat"} 304 | {:foo "bar" :biz "bat"} 305 | {"foo" "bar" "biz" [{"bat" "one"} {"bat" "two"}]} 306 | {:foo "bar" :biz [{:bat "one"} {:bat "two"}]} 307 | {"foo" 1} 308 | {:foo 1} 309 | {"foo" 1 "1bar" 2 "baz*" 3 "quz-buz" 4 "biz.bang" 5} 310 | {:foo 1 "1bar" 2 :baz* 3 :quz-buz 4 "biz.bang" 5} 311 | {:foo "bar"} 312 | {:foo "bar"} 313 | {"foo" {:bar "baz"}} 314 | {:foo {:bar "baz"}}))) 315 | 316 | ;;TODO continue with multipart params 317 | (defn string-store [item] 318 | (-> (select-keys item [:filename :content-type]) 319 | (assoc :content (slurp (:stream item))))) 320 | 321 | (deftest test-wrap-multipart-params 322 | (let [form-body (str "--XXXX\r\n" 323 | "Content-Disposition: form-data;" 324 | "name=\"upload\"; filename=\"test.txt\"\r\n" 325 | "Content-Type: text/plain\r\n\r\n" 326 | "foo\r\n" 327 | "--XXXX\r\n" 328 | "Content-Disposition: form-data;" 329 | "name=\"baz\"\r\n\r\n" 330 | "qux\r\n" 331 | "--XXXX--") 332 | handler (patch-test wrap-multipart-params identity {:store string-store}) 333 | request {:content-type "multipart/form-data; boundary=XXXX" 334 | :content-length (count form-body) 335 | :params {"foo" "bar"} 336 | :body (string-input-stream form-body)} 337 | response (handler request)] 338 | (is (= (get-in response [:params "foo"]) "bar")) 339 | (is (= (get-in response [:params "baz"]) "qux")) 340 | (let [upload (get-in response [:params "upload"])] 341 | (is (= (:filename upload) "test.txt")) 342 | (is (= (:content-type upload) "text/plain")) 343 | (is (= (:content upload) "foo"))))) 344 | 345 | (deftest test-multiple-params 346 | (let [form-body (str "--XXXX\r\n" 347 | "Content-Disposition: form-data;" 348 | "name=\"foo\"\r\n\r\n" 349 | "bar\r\n" 350 | "--XXXX\r\n" 351 | "Content-Disposition: form-data;" 352 | "name=\"foo\"\r\n\r\n" 353 | "baz\r\n" 354 | "--XXXX--") 355 | handler (patch-test wrap-multipart-params identity {:store string-store}) 356 | request {:content-type "multipart/form-data; boundary=XXXX" 357 | :content-length (count form-body) 358 | :body (string-input-stream form-body)} 359 | response (handler request)] 360 | (is (= (get-in response [:params "foo"]) 361 | ["bar" "baz"])))) 362 | 363 | (deftest nested-params-test 364 | (let [handler (patch-test wrap-nested-params :params)] 365 | (testing "nested parameter maps" 366 | (are [p r] (= (handler {:params p}) r) 367 | {"foo" "bar"} {"foo" "bar"} 368 | {"x[y]" "z"} {"x" {"y" "z"}} 369 | {"a[b][c]" "d"} {"a" {"b" {"c" "d"}}} 370 | {"a" "b", "c" "d"} {"a" "b", "c" "d"})) 371 | (testing "nested parameter lists" 372 | (are [p r] (= (handler {:params p}) r) 373 | {"foo[]" "bar"} {"foo" ["bar"]} 374 | {"foo[]" ["bar" "baz"]} {"foo" ["bar" "baz"]} 375 | {"a[x][]" ["b"], "a[x][][y]" "c"} {"a" {"x" ["b" {"y" "c"}]}} 376 | {"a[][x]" "c", "a[][y]" "d"} {"a" [{"y" "d"} {"x" "c"}]})))) 377 | 378 | (def wrapped-echo (patch-test wrap-params identity)) 379 | 380 | (deftest wrap-params-query-params-only 381 | (let [req {:query-string "foo=bar&biz=bat%25"} 382 | resp (wrapped-echo req)] 383 | (is (= {"foo" "bar" "biz" "bat%"} (:query-params resp))) 384 | (is (empty? (:form-params resp))) 385 | (is (= {"foo" "bar" "biz" "bat%"} (:params resp))))) 386 | 387 | (deftest wrap-params-query-and-form-params 388 | (let [req {:query-string "foo=bar" 389 | :content-type "application/x-www-form-urlencoded" 390 | :body (string-input-stream "biz=bat%25")} 391 | resp (wrapped-echo req)] 392 | (is (= {"foo" "bar"} (:query-params resp))) 393 | (is (= {"biz" "bat%"} (:form-params resp))) 394 | (is (= {"foo" "bar" "biz" "bat%"} (:params resp))))) 395 | 396 | (deftest wrap-params-not-form-encoded 397 | (let [req {:content-type "application/json" 398 | :body (string-input-stream "{foo: \"bar\"}")} 399 | resp (wrapped-echo req)] 400 | (is (empty? (:form-params resp))) 401 | (is (empty? (:params resp))))) 402 | 403 | (deftest wrap-params-always-assocs-maps 404 | (let [req {:query-string "" 405 | :content-type "application/x-www-form-urlencoded" 406 | :body (string-input-stream "")} 407 | resp (wrapped-echo req)] 408 | (is (= {} (:query-params resp))) 409 | (is (= {} (:form-params resp))) 410 | (is (= {} (:params resp))))) 411 | 412 | (deftest wrap-params-encoding 413 | (let [req {:character-encoding "UTF-16" 414 | :content-type "application/x-www-form-urlencoded" 415 | :body (string-input-stream "hello=world" "UTF-16")} 416 | resp (wrapped-echo req)] 417 | (is (= (:params resp) {"hello" "world"})) 418 | (is (= (:form-params resp) {"hello" "world"})))) 419 | 420 | (defn test-handler [request] 421 | {:status 200 422 | :headers {} 423 | :body (string-input-stream "handler")}) 424 | 425 | (deftest resource-test 426 | (let [handler (patch-test wrap-resource test-handler "/ring/assets")] 427 | (are [request body] (= (slurp (:body (handler request))) body) 428 | {:request-method :get, :uri "/foo.html"} "foo" 429 | {:request-method :get, :uri "/index.html"} "index" 430 | {:request-method :get, :uri "/bars/foo.html"} "foo" 431 | {:request-method :get, :uri "/handler"} "handler" 432 | {:request-method :post, :uri "/foo.html"} "handler"))) 433 | 434 | (defn- make-store [reader writer deleter] 435 | (reify SessionStore 436 | (read-session [_ k] (reader k)) 437 | (write-session [_ k s] (writer k s)) 438 | (delete-session [_ k] (deleter k)))) 439 | 440 | (defn trace-fn [f] 441 | (let [trace (atom [])] 442 | (with-meta 443 | (fn [& args] 444 | (swap! trace conj args) 445 | (apply f args)) 446 | {:trace trace}))) 447 | 448 | (defn trace [f] 449 | (-> f meta :trace deref)) 450 | 451 | (deftest session-is-read 452 | (let [reader (trace-fn (constantly {:bar "foo"})) 453 | writer (trace-fn (constantly nil)) 454 | deleter (trace-fn (constantly nil)) 455 | store (make-store reader writer deleter) 456 | handler (trace-fn (constantly {})) 457 | handler* (patch-test wrap-session handler {:store store})] 458 | (handler* {:cookies {"ring-session" {:value "test"}}}) 459 | (is (= (trace reader) [["test"]])) 460 | (is (= (trace writer) [])) 461 | (is (= (trace deleter) [])) 462 | (is (= (-> handler trace first first :session) 463 | {:bar "foo"})))) 464 | 465 | (deftest session-is-written 466 | (let [reader (trace-fn (constantly {})) 467 | writer (trace-fn (constantly nil)) 468 | deleter (trace-fn (constantly nil)) 469 | store (make-store reader writer deleter) 470 | handler (constantly {:session {:foo "bar"}}) 471 | handler (patch-test wrap-session handler {:store store})] 472 | (handler {:cookies {}}) 473 | (is (= (trace reader) [[nil]])) 474 | (is (= (trace writer) [[nil {:foo "bar"}]])) 475 | (is (= (trace deleter) [])))) 476 | 477 | (deftest session-is-deleted 478 | (let [reader (trace-fn (constantly {})) 479 | writer (trace-fn (constantly nil)) 480 | deleter (trace-fn (constantly nil)) 481 | store (make-store reader writer deleter) 482 | handler (constantly {:session nil}) 483 | handler (patch-test wrap-session handler {:store store})] 484 | (handler {:cookies {"ring-session" {:value "test"}}}) 485 | (is (= (trace reader) [["test"]])) 486 | (is (= (trace writer) [])) 487 | (is (= (trace deleter) [["test"]])))) 488 | 489 | (deftest session-write-outputs-cookie 490 | (let [store (make-store (constantly {}) 491 | (constantly "foo:bar") 492 | (constantly nil)) 493 | handler (constantly {:session {:foo "bar"}}) 494 | handler (patch-test wrap-session handler {:store store}) 495 | response (handler {:cookies {}})] 496 | (is (=cookie (get response :headers) 497 | {:headers ["ring-session=foo%3Abar;Path=/"]})))) 498 | 499 | (deftest session-delete-outputs-cookie 500 | (let [store (make-store (constantly {:foo "bar"}) 501 | (constantly nil) 502 | (constantly "deleted")) 503 | handler (constantly {:session nil}) 504 | handler (patch-test wrap-session handler {:store store}) 505 | response (handler {:cookies {"ring-session" {:value "foo:bar"}}})] 506 | (is (=cookie (get response :headers) 507 | {:headers ["ring-session=deleted;Path=/"]})))) 508 | 509 | (deftest session-cookie-has-attributes 510 | (let [store (make-store (constantly {}) 511 | (constantly "foo:bar") 512 | (constantly nil)) 513 | handler (constantly {:session {:foo "bar"}}) 514 | handler (patch-test wrap-session handler {:store store 515 | :cookie-attrs {:max-age 5 :path "/foo"}}) 516 | response (handler {:cookies {}})] 517 | (is (=cookie (get response :headers) 518 | {:headers ["ring-session=foo%3Abar;Max-Age=5;Path=/foo"]})))) 519 | 520 | (deftest session-does-not-clobber-response-cookies 521 | (let [store (make-store (constantly {}) 522 | (constantly "foo:bar") 523 | (constantly nil)) 524 | handler (constantly {:session {:foo "bar"} 525 | :cookies {"cookie2" "value2"}}) 526 | handler (patch-test wrap-session handler {:store store :cookie-attrs {:max-age 5}}) 527 | response (handler {:cookies {}})] 528 | (is (=cookie (get response :headers) 529 | {:headers ["ring-session=foo%3Abar;Max-Age=5;Path=/" "cookie2=value2"]})))) 530 | 531 | (deftest session-root-can-be-set 532 | (let [store (make-store (constantly {}) 533 | (constantly "foo:bar") 534 | (constantly nil)) 535 | handler (constantly {:session {:foo "bar"}}) 536 | handler (patch-test wrap-session handler {:store store, :root "/foo"}) 537 | response (handler {:cookies {}})] 538 | (is (=cookie (get response :headers) 539 | {:headers ["ring-session=foo%3Abar;Path=/foo"]})))) 540 | 541 | (deftest session-attrs-can-be-set-per-request 542 | (let [store (make-store (constantly {}) 543 | (constantly "foo:bar") 544 | (constantly nil)) 545 | handler (constantly {:session {:foo "bar"} 546 | :session-cookie-attrs {:max-age 5}}) 547 | handler (patch-test wrap-session handler {:store store}) 548 | response (handler {:cookies {}})] 549 | (is (=cookie (get response :headers) 550 | {:headers ["ring-session=foo%3Abar;Max-Age=5;Path=/"]})))) 551 | 552 | (deftest session-made-up-key 553 | (let [store-ref (atom {}) 554 | store (make-store 555 | #(@store-ref %) 556 | #(do (swap! store-ref assoc %1 %2) %1) 557 | #(do (swap! store-ref dissoc %) nil)) 558 | handler (patch-test wrap-session 559 | (constantly {:session {:foo "bar"}}) 560 | {:store store})] 561 | (handler {:cookies {"ring-session" {:value "faked-key"}}}) 562 | (is (not (contains? @store-ref "faked-key"))))) 563 | 564 | (deftest session-request-test 565 | (is (fn? session-request))) 566 | 567 | (deftest session-response-test 568 | (is (fn? session-response))) 569 | 570 | (deftest session-cookie-attrs-change 571 | (let [a-resp (atom {:session {:foo "bar"}}) 572 | handler (patch-test wrap-session (fn [req] @a-resp)) 573 | response (handler {}) 574 | sess-key (->> (get-in response [:headers "Set-Cookie"]) 575 | (first) 576 | (re-find #"(?<==)[^;]+"))] 577 | (is (not (nil? sess-key))) 578 | (reset! a-resp {:session-cookie-attrs {:max-age 3600}}) 579 | 580 | (testing "Session cookie attrs with no active session" 581 | (is (= (handler {}) {}))) 582 | 583 | (testing "Session cookie attrs with active session" 584 | (let [response (handler {:foo "bar" :cookies {"ring-session" {:value sess-key}}})] 585 | (is (get-in response [:headers "Set-Cookie"])))))) 586 | 587 | 588 | --------------------------------------------------------------------------------