├── .gitignore ├── .hgignore ├── .tool-versions ├── CHANGELOG.md ├── LICENSE ├── Makefile ├── README.md ├── build.clj ├── deps.edn ├── dev └── user.clj ├── doc └── intro.md ├── examples └── lambda_toolshed │ └── papillon │ └── examples │ ├── condition_system.cljc │ ├── distributed_transaction.cljc │ ├── dynamic_tracing.cljc │ └── example.cljc ├── papillon-sandwich.png ├── papillon.png ├── resources └── .keep ├── src └── lambda_toolshed │ ├── papillon.cljc │ └── papillon │ ├── channel.cljc │ ├── completeable_future.clj │ └── protocols.cljc └── test └── lambda_toolshed ├── papillon └── channel_test.cljc ├── papillon_test.cljc └── test_utils.cljc /.gitignore: -------------------------------------------------------------------------------- 1 | .clj-kondo 2 | .log 3 | .lsp 4 | .shadow-cljs 5 | node_modules 6 | target 7 | .cpcache 8 | .nrepl-port 9 | .terraform 10 | .idea 11 | .nvimrc 12 | .vimrc 13 | *.iml 14 | docker 15 | /.calva 16 | /.clj-kondo 17 | client/dist 18 | .DS_Store 19 | .env 20 | .env.local 21 | test-resources/ 22 | cljs-test-runner-out 23 | .cljs_node_repl 24 | .make.* 25 | -------------------------------------------------------------------------------- /.hgignore: -------------------------------------------------------------------------------- 1 | syntax: glob 2 | *.jar 3 | *.class 4 | .cpcache/** 5 | .gitignore 6 | .git/** 7 | .lsp/.cache 8 | .lsp/sqlite.db 9 | 10 | syntax: regexp 11 | ^.calva/output-window/ 12 | ^.lein-.* 13 | ^.nrepl-history 14 | ^.nrepl-port 15 | ^.rebel_readline_history 16 | ^.socket-repl-port 17 | ^target/ 18 | ^classes/ 19 | ^checkouts/ 20 | -------------------------------------------------------------------------------- /.tool-versions: -------------------------------------------------------------------------------- 1 | clojure 1.11.1.1347 2 | nodejs 16.4.0 3 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/). 3 | 4 | ## [Unreleased] 5 | ### Changed 6 | - The auto-naming of unnamed interceptors has changed to use the hash of the interceptor instead of its ordinal position in the initial queue. Position is not easily defined for interceptors queued after the initial execution. 7 | - Transitions from the leave stage to the error stage will first consider the offending interceptor's `:error` stage before consuming the stack. 8 | - The state of the stack used by papillon when working back out of the chain is now only updated when popping off the top of the stack to execute the `:final` stage. 9 | ### Added 10 | - The Chrysalis protocol is used by papillon to realize deferred contexts between interceptor transitions. 11 | - The execution of the interceptor chain can now be run asynchronously or synchronously. 12 | - If a var is queued (instead of an actual map interceptor), it will be dereferenced before being queued. 13 | - The optional `:final` stage has been added. 14 | 15 | [Unreleased]: https://github.com/lambda-toolshed/papillon/compare/0.1.1...HEAD 16 | [0.1.1]: https://github.com/lambda-toolshed/papillon/compare/0.1.0...0.1.1 17 | -------------------------------------------------------------------------------- /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 to control, 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 New York 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 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Some inspiration: https://github.com/git/git/blob/master/Makefile 2 | # More inspiration: https://clarkgrubb.com/makefile-style-guide 3 | SHELL = /bin/bash 4 | 5 | src-clj = $(shell find src/ -type f -name '*.clj' -or -name '*.cljc' -or -name '*.edn') 6 | src-cljs = $(shell find src/ -type f -name '*.cljs' -or -name '*.cljc' -or -name '*.clj' -or -name '*.edn') 7 | srcfiles = $(src-clj) $(src-cljs) 8 | 9 | test-clj = $(shell find test/ -type f -name '*.clj' -or -name '*.cljc' -or -name '*.edn') 10 | test-cljs = $(shell find test/ -type f -name '*.cljs' -or -name '*.cljc' -or -name '*.clj' -or -name '*.edn') 11 | testfiles = $(test-clj) $(test-cljs) 12 | 13 | target = ./target 14 | 15 | # This is the default target because it is the first real target in this Makefile 16 | .PHONY: default # Same as "make ci" 17 | default: ci 18 | 19 | .PHONY: assert-clean # Fail if the git repo is dirty (untracked files, modified files, or files are in the index) 20 | assert-clean: 21 | ifeq ($(DRO),true) 22 | @echo "Skipping dirty repo check" 23 | else 24 | @test -z "$$(git status --porcelain)" 25 | endif 26 | 27 | .PHONY: ci 28 | ci: assert-clean 29 | clojure -T:build ci 30 | 31 | .PHONY: test # Run the Clojure and ClojureScript test suites 32 | test: test-clj test-cljs 33 | 34 | .PHONY: test-clj 35 | test-clj: .make.test-clj 36 | 37 | .PHONY: test-cljs 38 | test-cljs: .make.test-cljs 39 | 40 | .make.test-clj: deps.edn $(testfiles) $(srcfiles) 41 | clojure -X:test:project/test-clj 42 | touch .make.test-clj 43 | 44 | .make.test-cljs: deps.edn $(testfiles) $(srcfiles) 45 | clojure -M:test:project/test-cljs 46 | touch .make.test-cljs 47 | 48 | lint: $(testfiles) $(srcfiles) 49 | clojure -T:build lint 50 | 51 | format: $(testfiles) $(srcfiles) 52 | clojure -T:build ensure-format 53 | 54 | $(target)/: 55 | mkdir -p $@ 56 | 57 | install: ci 58 | clojure -T:build install 59 | 60 | deploy: ci 61 | clojure -T:build deploy 62 | 63 | clean: 64 | rm -f $(jar-file) $(pom-file) 65 | rm -rf target/* 66 | rm -rf cljs-test-runner-out 67 | rm -f .make.* 68 | 69 | # Copied from: https://github.com/jeffsp/makefile_help/blob/master/Makefile 70 | # Tab nonesense resolved with help from StackOverflow... need a literal instead of the \t escape on MacOS 71 | help: # Generate list of targets with descriptions 72 | @grep '^.PHONY: .* #' Makefile | sed 's/\.PHONY: \(.*\) # \(.*\)/\1 \2/' | expand -t20 73 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Papillon 2 | 3 | An interceptor library for Clojure. 4 | 5 | Butterfly with Lisp Lambdas for the dots on the wings 6 | 7 | 8 | ## About 9 | 10 | This library was inspired by the mix of Interceptor patterns from: 11 | 12 | - Pedestal's [Interceptors](http://pedestal.io/reference/interceptors), 13 | - Metosin's [Sieppari](https://github.com/metosin/sieppari), 14 | - Eric Normand's [A Model of Interceptors](https://lispcast.com/a-model-of-interceptors/), 15 | - and LambdaIsland's [Interceptors, part 1, concepts](https://lambdaisland.com/episodes/interceptors-concepts). 16 | 17 | ### Why this library? 18 | 19 | Amongst other applications, we use Clojure(Script) on AWS Lambdas where a number of them are triggered asynchronously without a HTTP request. The goal of this library is to advocate for the idea of interceptors, while providing a way to use them that are independent from HTTP and applicable in a broader range of scenarios. We feel that interceptors have a compelling story when used in conjunction with inherently source-sink type operations -whether the source is an inbound http request or an inbound lambda event in AWS or even an outbound network request. 20 | 21 | A side goal of this is to provide the core of the execution of an interceptor queue, while keeping it open enough that it can be composed with other complimentary libraries without locking the consumer into using specific libraries required for other aspects, such as picking a logging library. 22 | 23 | ### Goals 24 | 25 | #### Clojure Common 26 | 27 | As mentioned above, we run ClojureScript on Node runtime for our AWS Lambdas, so we needed a solution that covers both Clojure and ClojureScript. 28 | 29 | In addition, we want papillon to be unencumbered with additional dependencies regardless of the host environment -be it Babashka, Clojure, ClojureScript, Clojure.NET, ClojurErl, ClojureDart, etc. Since the introduction of the Chrysalis protocol papillon supports synchronous and asynchronous operation with no dependencies beyond the core language itself. 30 | 31 | #### Interceptor focused 32 | 33 | There are multiple libraries that include support for interceptors and even a few that focus on interceptors alone. In keeping with our goal of broad platform support and zero external depedencies, papillon is an interceptor-only library. We focus on keeping it slim and broadly applicable to many tasks. 34 | 35 | #### Decouple the interceptors from HTTP requests. 36 | 37 | Sieppari was more focused on Interceptors only, but was based on the idea of a Request/Response model. Same for babashka's http client. 38 | 39 | With our goal to have interceptors be the prevalent pattern in our AWS Lambdas, we needed something that would fit with both the HTTP style of synchronous AWS Lambdas, as well as the asynchronous AWS Lambdas that consume their items from SQS queues, the idea of contorting a SQS message into a HTTP Request/Response was something we wanted to avoid. We have found papillon is well suited to many source-to-sink-to-source type operations: HTTP request handling and issuing HTTP requests are but two examples. 40 | 41 | #### Minimal 42 | 43 | We focused on what seemed to be the core of interceptors which is having an execution chain of interceptors to run, and running a context map through that chain and back out. 44 | 45 | We have tried to leave out most everything else, as we found the interceptor chains can easily be modified to include many orthogonal concerns, allowing us to decomplect the interceptor execution from other useful but separate concerns. 46 | 47 | One example of something we have left out is logging. While it is useful to log the path through the interceptor chain, and modifications to the execution chain, we didn’t want to pick a logging library that consuming applications would inherit our decision on. It is, however, 48 | possible to have papillon record a trace of all executed operations. 49 | 50 | #### Data First 51 | 52 | We also found that given the concept of the interceptor chain being just data, we could get logging (and various other concerns, e.g. benchmarking, tracing, etc.), included by manipulating the interceptor chain using interleave with a repeated sequence of a logging specific interceptor. 53 | 54 | This ability to treat both the context as data and the control flow as data, allowed us to keep the core flow of domain logic as interceptors, distinct from logging and other developer related concerns, allowing us to highlight the core context. 55 | 56 | Given that the control flow is data, and available on the context, it allowed us to play with ideas like setting up support for a Common Lisp style Condition System as seen in the examples folder. 57 | 58 | #### Clojure Core Libraries Based 59 | 60 | As noted above, papillon does not expose you to transitive dependencies. The core of papillon has zero dependencies other than core Clojure language constructs. Even async support is expressed with callbacks so as to limit the imposed requirement for something like clojure.core.async. Nevertheless, papillon provides opt-in support for core.async and extending papillon to support other async libs (e.g. manifold or promesa or Java CompletableFuture) is a simple matter of extending the Chrysalis protocol's emerge function. 61 | 62 | We also would love to see some more abuses of interceptors as well, because it helps find the edges of what can(not) or should (not) be done with them. 63 | 64 | #### Async and Sync support 65 | We want papillon to support synchronous and asynchronous use cases and we find different interpretations of what that could mean, roughly divided into two arenas. 66 | 1. Papillon allows interceptors to return deferred computations of the updated context. An interceptor chain can contain a mix of interceptors that produce deferred results and interceptors that produce realized results; a given interceptor can even vary its return type conditionally. We call an interceptor that returns a deferred type (more on that later) an "async interceptor." By necessity, papillon always realizes the deferred result of an async interceptor before invoking the next interceptor in the chain. 67 | 2. Papillon allows the result of executing the entire interceptor chain to be deferred, invoking a user-supplied callback function upon completion. We call this an "async chain." 68 | 69 | These two approaches can be mixed and matched: 70 | 71 | * Sync chain and sync interceptors: the baseline. Appropriate for computation-focused chains or situations where the chain execution context has been managed by the developer prior to invocation. 72 | * Sync chain and async interceptors: useful for testing async interceptors and for reusing (possibly) async interceptors transparently in sync chains. 73 | * Async chain and sync interceptors: useful for reusing sync interceptors transparently in async chains. 74 | * Async chain and async interceptors: essential for single-threaded environments like ClojureScript where otherwise blocking operations must yield to the event loop. 75 | 76 | By using a callback, papillon does not impose an async solution on developers. It works equally well with promises (in Clojure or ClojureScript), core.async channels (in Clojure and ClojureScript), futures, etc. 77 | 78 | The Chrysalis protocol is central to papillon's async support. It is used by papillon to realize the deferred result of an async interceptor. Realizing a deferred value in a sync chain using the single-arity `emerge` function of Chrysalis, while realizing a deferered value in an async chain uses the two-arity version. Here's an example extending support in Clojure and ClojureScript to core.async channels: 79 | 80 | ``` clojure 81 | (extend-protocol Chrysalis 82 | #?(:clj clojure.core.async.impl.protocols.Channel :cljs cljs.core.async.impl.channels/ManyToManyChannel) 83 | (emerge ([this] (async/ 111 | 112 | ### The Spec 113 | 114 | Interceptors are represented as a map with the optional keys of `:enter`, `:leave`, `:error` and `:final`. None of the keys are required to be on an interceptor map; if no function value for the current stage is found in the interceptor map, the chain executor will move to the next interceptor. A `:name` can also provided, in which case there are some affordances for tracing the interceptor execution by name. 115 | 116 | The idea of sticking to a map instead of a record is that if the interceptor is a map, consumers can attach any other data to the interceptor, which the executor will ignored instead of actively discarding when converting to a record, allowing the extra keys and values on the interceptor map to be accessible while it exists on the queue or the stack in the context. 117 | 118 | #### The IN phase 119 | Execution of the chain starts in the IN phase. During the IN phase, interceptors are removed from the queue and placed on the stack. They are executed by invoking their `:enter` stage. 120 | 121 | ##### The :enter Stage 122 | The `:enter` stage is the initial stage of the chain. While in the `:enter` stage the chain is executed by invoking interceptors as they are removed the queue and placed on the stack. 123 | 124 | There are three ways to transition from the `:enter` stage: 125 | 1. When the queue of remaining interceptors is empty, execution transitions to the `:leave` stage. 126 | 2. When the interceptor returns a `reduced?` value, the queue is cleared and execution transitions to the `:leave` stage. 127 | 3. When the interceptor throws (sync mode) or returns (async mode) an exception, execution transitions to the `:error` stage. 128 | 129 | #### The OUT phase 130 | During the OUT phase, interceptors are consumed from the stack after execution of their `:leave` and/or `:error` stages followed by their `:final` stage. Invocation follows the `try...catch...finally` logic 131 | of Clojure itself. The possible stage orderings are thus as follows: 132 | 133 | A. `:leave`-`:final`: baseline; the ordering in the absence of any errors. 134 | B. `:leave`-`:error`-`:final`: when the `:leave` stage encounters an error. 135 | C. `:error`-`:final`: when an unhandled error from an inner interceptor has "bubbled" up. 136 | 137 | After the`:final` stage completes (regardless of outcome), the current interceptor is popped off the stack and execution continues. When the stack is empty, the chain itself has been completely executed. 138 | 139 | ##### The :leave Stage 140 | The `:leave` stage is executed from the interceptor at the top of the stack. When the `:leave` stage of the interceptor throws (sync mode) or returns (async mode) an exception, chain execution transitions to the `:error` stage _starting with the current interceptor_. If the `:leave` stage completes normally, the `:final` stage of the current interceptor is executed and the next interceptor from the stack is started in the `:leave` stage. 141 | 142 | ##### The :error Stage 143 | The `:error` stage is executed from the interceptor at the top of the stack. If the error at the `:lambda-toolshed.papillon/error` key is not cleared, the `:final` stage of the current interceptor is executed and the next interceptor from the stack is stared in the `:error` stage. If it the error is cleared, the `:final` stage of the current interceptor is still executed, but the next interceptor from the stack is started in the `:leave` stage. 144 | 145 | ##### The :final Stage 146 | The `:final` stage is executed from the interceptor popped off the top of the stack. The `:final` stage will be executed for every interceptor. Idiomatically the `:final` stage should not alter the value at the `:lambda-toolshed.papillon/error` key of the context -behavior is undefined in this case. 147 | 148 | ##### Notes on Raising, or Returning, an Error 149 | 150 | When an interceptor function throws or returns an error, e.g. ExceptionInfo, Throwable in Clojure, js/Error in Clojurescript, the queue, the error is added under the `:lambda-toolshed.papillon/error` key, and papillon begins processing the `:error` stage of the accumulated/remaining stack. When papillon is processing the `:enter` stage of the queue, the accumulated stack will have the "current" interceptor at the head and exceptions will cause the `:error` stage of the same interceptor to be invoked. However, when papillon is processing the `:leave` stage the current interceptor is removed from the stack prior to invoking the function and exceptions will thus advance to the next ("outward") interceptor. 151 | 152 | The interceptor stack will continue to be consumed through the `:error` stage until the error is resolved by removing the `:lambda-toolshed.papillon/error` key from the context map. Once there is no error in the context, processing will return to the `:leave` stage of the stack. 153 | 154 | #### The Context map 155 | 156 | ##### Keys 157 | 158 | | key | description | 159 | | ------ | -------------- | 160 | | `:lambda-toolshed.papillon/queue` | The queue of interceptors. This gets initialized with the interceptors passed to `execute`, but can be managed if you know what you are doing. | 161 | | `:lambda-toolshed.papillon/stack` | The stack of interceptors for traversing back through the chain of interceptors encountered. | 162 | | `:lambda-toolshed.papillon/error` | This key should have the error information associated with it. This key signifies we are in an error state, and interceptors with `:error` key will be processed, either for them to clean up some state (open connections, etc.) or attempt to handle and resolve the error and return nicely. A few examples might be: turn the error into 500 HTTP response; put original message and error onto an error queue; etc. | 163 | | `:lambda-toolshed.papillon/trace` | A vector at this key signals that interceptor chain execution should be traced by conj'ing tuples of the form `[itx-name stage]` onto the vector at every step. | 164 | 165 | ### Asynchronous Interceptors 166 | 167 | Papillon always uses the `emerge` function of the Chrysalis protocol to realize deferred results *before* calling the next interceptor in the chain. When the chain is being executed asynchronously (implicit when a callback function is provided to `execute`) and an interceptor returns a deferred value (a _chrysalis_), the two-arity `emerge` is used to asynchronously resolve the _chrysalis_ and resume the chain execution. When the chain is being executed synchronously (implicit when no callback function is provided to `execute`) and an interceptor returns a chrysalis, the single arity `emerge` is used to synchronously resolve the chrysalis (likely blocking) and return it so that papillon can continue executing the chain. Because synchronous chain execution with even one asynchronous interceptor requires blocking, this combination is inherently not possible _in ClojureScript_. 168 | 169 | #### Errors in asynchronous interceptors 170 | 171 | To signal an error in an asynchronous interceptor, the executor cannot just catch an exception, as the error occurs in a different timeline from where the code that started the process lives, so any catch for an exception has fallen out of scope. 172 | 173 | Because of this, the Interceptor library expects the asynchronous interceptors to catch any errors themselves and return the error as its return value. 174 | 175 | If the result of "emerging" the chrysalis (deferred result) yields an exception, papillon will add the error to the context under `:lambda-toolshed.papillon/error` key, as if it had been caught from a synchronous interceptor. 176 | 177 | ## Examples and Other ways to extend usage 178 | 179 | ### Interceptor Tricks 180 | 181 | Because the interceptor executor takes a sequence of interceptors to build the processing queue, we can manipulate it before and even during execution. In the example below, if we have tracing enabled, we interleave a tracing interceptor, could be a timing capture interceptor, with the standard interceptors we are expecting to process as part of the interceptor chain. 182 | 183 | And example of this is found in [examples/example.cljc](./examples/example.cljc), and the `with-tracing` function that interleaves a tracing interceptor with a sequence of interceptors when in "debug" mode. 184 | 185 | There is also an example of another tracing system that is a bit more advanced in [examples/dynamic_tracing.cljc](examples/dynamic_tracing.cljc), which wraps every following interceptor in the queue with tracing/timing functions, if the interceptor map is marked with meta-data. 186 | 187 | ### Nesting Interceptor Executions 188 | 189 | By decoupling interceptors and keeping them generic, it opens up the possibility that you could nest interceptor chains within a larger context. 190 | 191 | ```clojure 192 | 193 | (def some-nested-ixs 194 | [ ;;; some interceptor chain goes here 195 | ]) 196 | 197 | (def other-nested-ixs 198 | [ ;;; some other interceptor chain goes here 199 | ]) 200 | 201 | (defn fork 202 | [starting-ctx & ix-chains] 203 | ;; fork things off 204 | (let [successes-chan (chan) 205 | errors-chan (chan)] 206 | (doseq [ixs ix-chains] 207 | (evaluate starting-ctx 208 | ixs 209 | (fn (ctx) (put! successes-chan ctx)) 210 | (fn (ctx) (put! errors-chan ctx)))) 211 | [successes-chan errors-chan])) 212 | 213 | (defn join 214 | "Join the results of calling fork to split off the channel 215 | and stitch them back up as needed" 216 | [& args] 217 | ;; join things back up (channels, etc.) 218 | ) 219 | 220 | (defn fork-join 221 | "Spin up mulitple interceptor executions (in channels) 222 | to give concurrency/asynchornicity and then join them 223 | back up together" 224 | [ctx] 225 | (join (fork (sub-context) some-nested-ixs other-nested-ixs))) 226 | 227 | (def fork-join-ix 228 | {:enter fork-join}) 229 | 230 | ``` 231 | 232 | While this is not a recommendation to do such nesting, it is meant to highlight additional possibilities of using the interceptor pattern decoupled from the HTTP Request/Response concept. 233 | 234 | The decoupling allows the interceptor pattern to be used in a similar way that the Either monad type in ML family of languages can be used in functions where it becomes useful, instead of only at the outer most entry points of your application. 235 | 236 | ### A Possible Condition system 237 | 238 | As interceptors themselves are maps, one could have any other sets of keys on the map used in the Interceptor queue, and in keeping with Clojure style, we only care about those keys we want. 239 | 240 | By giving a contract for the interceptor and interceptor execution one could implement something similar in spirit to Common Lisp's Condition System by being able to look at the Interceptor Stack of calls, and walk back up the Stack without consuming it the way raising an error does. 241 | 242 | Because you have visibility to the stack and the queue, as they are keys in the context map, you could walk up the stack looking for interceptors that have the key that was received as a "signal", and invoke a function associated with that key to attempt to handle the signal. This allows you to unwind the stack, without unwinding the stack, because, as long as you don't return the modified context, you are working on a persistent data structure, and any modifications to the stack are a copy of the stack scoped to your usage. Persistent Data Structures FOR THE WIN!! 243 | 244 | A basic example of this can be found in [examples/condition_system.cljc](./examples/condition_system.cljc), along with and advanced condition system that uses derived keywords, and the derivation hierarchy of a keyword signal. 245 | -------------------------------------------------------------------------------- /build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:refer-clojure :exclude [test]) 3 | (:require [clojure.string :as str] 4 | [clojure.tools.build.api :as b] ; for b/git-process 5 | [org.corfield.build :as bb])) 6 | 7 | (def lib 'com.github.lambda-toolshed/papillon) 8 | 9 | (def version 10 | (-> (b/git-process {:git-args "describe --abbrev=4 --dirty"}) 11 | (or "0.0.0") 12 | (str/replace #"^v" ""))) 13 | 14 | (defn test-clj "Run the Clojure tests." [opts] 15 | (-> opts 16 | (bb/run-tests))) 17 | 18 | (defn test-cljs "Run the ClojureScript tests." [opts] 19 | (-> opts 20 | (bb/run-task [:test :project/test-cljs]))) 21 | 22 | (defn test-all "Run all the tests." [opts] 23 | (-> opts 24 | (test-clj) 25 | (test-cljs))) 26 | 27 | (defn lint "Run the linter." [opts] 28 | (-> opts 29 | (bb/run-task [:lint/kondo]))) 30 | 31 | (defn ensure-format "Run the formatter." [opts] 32 | (-> opts 33 | (bb/run-task [:project/format]))) 34 | 35 | (defn format-check "Run the formatter for validation." [opts] 36 | (-> opts 37 | (bb/run-task [:project/format-check]))) 38 | 39 | (defn ci "Run the CI pipeline of tests (and build the JAR)." [opts] 40 | (-> opts 41 | (assoc :lib lib :version version) 42 | (format-check) 43 | (lint) 44 | (test-all) 45 | (bb/clean) 46 | (bb/jar))) 47 | 48 | (defn install "Install the JAR locally." [opts] 49 | (-> opts 50 | (assoc :lib lib :version version) 51 | (bb/install))) 52 | 53 | (defn deploy "Deploy the JAR to Clojars." [opts] 54 | (-> opts 55 | (assoc :lib lib :version version) 56 | (bb/deploy))) 57 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "resources"] 2 | :deps {org.clojure/clojure {:mvn/version "1.12.0"} 3 | org.clojure/clojurescript {:mvn/version "1.11.132"}} 4 | :aliases {:build {:deps {io.github.seancorfield/build-clj 5 | {:git/tag "v0.9.2" :git/sha "9c9f078"}} 6 | :ns-default build} 7 | :dev {:extra-paths ["dev"] 8 | :jvm-opts ["-DENVIRONMENT=development"]} 9 | :test {:extra-paths ["test"] 10 | :extra-deps {org.clojure/core.async {:mvn/version "1.6.681"} 11 | org.clojure/test.check {:mvn/version "1.1.1"}}} 12 | :project/test-cljs {:main-opts ["-m" "cljs-test-runner.main"] 13 | :extra-deps {olical/cljs-test-runner {:mvn/version "3.8.1"}} 14 | :jvm-opts ["-DENVIRONMENT=test"]} 15 | :project/test-clj {:extra-deps {io.github.cognitect-labs/test-runner 16 | {:git/tag "v0.5.1" :git/sha "dfb30dd"}} 17 | :main-opts ["-m" "cognitect.test-runner"] 18 | :exec-fn cognitect.test-runner.api/test 19 | :jvm-opts ["-DENVIRONMENT=test"]} 20 | 21 | ;; for interactive test running 22 | :project/watch-test {:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}} 23 | :exec-fn kaocha.runner/exec-fn 24 | :exec-args {:watch? true 25 | :skip-meta :slow 26 | :fail-fast? true}} 27 | ;; --------------------------- Build/Deploy Tasks ---------------------------- 28 | ;; Bump the version by a patch and generate a corresponding pom file with the groupId "lambda-toolshed" 29 | ;; $ clojure -M:project/pom patch -t IncrementType 30 | :project/pom {:main-opts ["-m" "garamond.main" "--group-id" "lambda-toolshed" 31 | "--scm-url" "https://github.com/lambda-toolshed/papillon" "-p"] 32 | ;; because we don't need the project's dependencies loaded -graph parses the deps.edn "out-of-band": 33 | :replace-deps {com.workframe/garamond {:mvn/version "0.4.0"}}} 34 | 35 | :lint/kondo {:extra-deps {clj-kondo/clj-kondo {:mvn/version "RELEASE"}} 36 | :main-opts ["-m" "clj-kondo.main" "--lint" "src" "--lint" "test" "--lint" "examples"]} 37 | 38 | :project/format {:extra-deps {cljfmt/cljfmt {:mvn/version "0.9.2"}} 39 | :main-opts ["-m" "cljfmt.main" "fix"]} 40 | 41 | ;; Reference: https://github.com/liquidz/antq 42 | ;; Example Usage: clj -M:outdated 43 | :outdated {:deps {com.github.liquidz/antq {:mvn/version "RELEASE"} 44 | org.slf4j/slf4j-nop {:mvn/version "RELEASE"}} 45 | :main-opts ["-m" "antq.core" "--skip=github-action"]} 46 | 47 | :project/format-check {:extra-deps {cljfmt/cljfmt {:mvn/version "0.9.2"}} 48 | :main-opts ["-m" "cljfmt.main" "check"]} 49 | 50 | :project/cljs-nrepl {:main-opts ["-m" "nrepl.cmdline" "--middleware" "[\"cider.piggieback/wrap-cljs-repl\"]"] 51 | :extra-deps {nrepl/nrepl {:mvn/version "1.3.0"} 52 | cider/piggieback {:mvn/version "0.5.3"}}} 53 | 54 | :project/nrepl {:main-opts ["-m" "nrepl.cmdline" "--middleware" "[\"cider.nrepl/cider-middleware\"]"] 55 | :extra-deps {nrepl/nrepl {:mvn/version "1.3.0"} 56 | cider/cider-nrepl {:mvn/version "0.50.2"}} 57 | :jvm-opts ["-DENVIRONMENT=staging"]}}} 58 | -------------------------------------------------------------------------------- /dev/user.clj: -------------------------------------------------------------------------------- 1 | (ns user 2 | (:require [cljs.repl.node])) 3 | 4 | ;; (defn start-cljs 5 | ;; "Starts a CLJS repl by piggiebacking onto the cider nREPL" 6 | ;; [] 7 | ;; (cider.piggieback/cljs-repl (cljs.repl.node/repl-env))) 8 | -------------------------------------------------------------------------------- /doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to Papillon 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/what-to-write/) 4 | -------------------------------------------------------------------------------- /examples/lambda_toolshed/papillon/examples/condition_system.cljc: -------------------------------------------------------------------------------- 1 | (ns lambda-toolshed.papillon.examples.condition-system 2 | (:require 3 | [lambda-toolshed.papillon :as papillon :refer [execute]] 4 | [clojure.core.async :as async :refer [go ctx 36 | (update :lambda-toolshed.papillon/queue #(into (empty %) (concat [(peek stack)] %))) 37 | (update :lambda-toolshed.papillon/stack pop)))) 38 | 39 | ;; basic interceptor for examples 40 | (def one-ix 41 | {:name :one-ix 42 | :enter (fn [ctx] (assoc ctx :number 1))}) 43 | 44 | ;; basic interceptor for examples 45 | (def double-ix 46 | {:name :double-ix 47 | :enter (fn [ctx] (update-in ctx [:number] (partial * 2)))}) 48 | 49 | ;; make sure that requeue current looks good at a simple version 50 | (-> {:lambda-toolshed.papillon/queue (into clojure.lang.PersistentQueue/EMPTY [double-ix]) 51 | :lambda-toolshed.papillon/stack [one-ix]} 52 | requeue-current) 53 | 54 | ;; make a (fake) http request 55 | ;; Not making real HTTP so we don't need a HTTP library for 56 | ;; examples, and one that will work nicely in a CLJC file too. 57 | ;; - Our fake HTTP request occassionally returns non success 58 | ;; status response 59 | (defn http-request! 60 | "fakes out a http request to show examples. Occasionally fails" 61 | [{:keys [url]}] 62 | (go 63 | {:url url 64 | ;; Random status with roughly 1/4 chance of failure 65 | :status (rand-nth [200 200 200 500])})) 66 | 67 | ;; Was the http response a success response?? 68 | (defn success? 69 | "Success if the response map status was in the 200 range" 70 | [response] 71 | ((set (range 200 300)) (:status response))) 72 | 73 | (defn retry-request 74 | "This handler will retry a request until it hits the retry limit. 75 | 76 | It uses a sub-map on the context with the url as the key that tracks 77 | how many times a given url fails, so individual requests (keyed by url) 78 | can be tracked and retried individually. 79 | 80 | If the retry count is within the max retry count limit, this 81 | handler will update the retry count in the context for the request 82 | and requeue the current handler to try the response again. 83 | 84 | If the retry count limit has been exceeded, throws an exception 85 | signaling that we tried too many times and still failed" 86 | [max-retry-count ctx request response] 87 | (println "in retry-request") 88 | (let [url (:url request) 89 | retry-count (or (get-in ctx [:lambda-toolshed.papillon.examples.condition-system/request-retries url]) 0)] 90 | (println "retry-count..." retry-count) 91 | (if (>= retry-count max-retry-count) 92 | (throw (ex-info "Too Many Failures" 93 | {:retry-count retry-count 94 | :request-url url 95 | :response response 96 | :ctx ctx})) 97 | (do 98 | ;; timeout to do exponential back off 99 | (println "Fake timeout for" (* ((fnil inc 0) retry-count) 10) "seconds") 100 | (-> ctx 101 | (update-in [:lambda-toolshed.papillon.examples.condition-system/request-retries url] (fnil inc 0)) 102 | requeue-current))))) 103 | 104 | ;; The Retry handler interceptor. 105 | ;; Notice that there is no :enter, :leave, or :error key 106 | ;; but a special key that is used to specify a handler 107 | ;; for a given signal, in this case :http-request-failed 108 | ;; - Partially applies retry-request to configure it 109 | ;; to only retry with a limit of 3 retries 110 | (def retry-http-ix 111 | {:http-request-failed (partial retry-request 3)}) 112 | 113 | ;; Tries to make a request and signals if the response was 114 | ;; not successful. Async style, so need to catch exception in 115 | ;; the interceptor and return error on the channel result 116 | (def request-ix 117 | {:enter (fn [ctx] 118 | (go 119 | (try 120 | ;; fake http request 121 | (let [request {:url (:request-url ctx) :headers []} 122 | response (! chan]] 5 | [clojure.pprint :as pp])) 6 | 7 | (defn- expt [n power] 8 | (reduce * 1 (take (inc power) (repeat n)))) 9 | 10 | ;; Lets build a depth first sequence of the keyword hierarchy 11 | ;; Practically we might want a breath first, but this is a 12 | ;; simple example for illustrative purposes 13 | (defn- derivation-heirarchy 14 | "Builds a depth first sequence of the keyword hierarchy." 15 | [kw] 16 | (lazy-seq (cons kw (mapcat derivation-heirarchy (parents kw))))) 17 | 18 | (defn signal 19 | "Checks the signal in the stack of interceptors and 20 | invokes the handler with the context and args if 21 | a handler is found on the stack. 22 | If no handler is found for the keyword signal this 23 | was called with, it will start walking the keyword 24 | derivation hierarchy, and for each keyword in the 25 | derivation hierarchy it will re-process the stack 26 | looking for any handlers that can handle the 27 | current ancestor keyword until all ancestor keywords 28 | from the derivation heirarchy have been checked. 29 | If no handler for the signal, or any of the keywords 30 | the signal keyword is a descendant of, is found in 31 | the interceptor stack throw an error" 32 | [signal c-out ctx & args] 33 | ;; get signal derivation hierarcy and stack 34 | (let [signal-hierarchy (derivation-heirarchy signal) 35 | stack (:lambda-toolshed.papillon/stack ctx)] 36 | (loop [[ix & ix-stack] stack 37 | [sig & sigs] signal-hierarchy] 38 | (if sig 39 | (if ix ; do we have an interceptor? or did we exhaust the stack? 40 | ;; yes we have an interceptor to check 41 | (if-let [f (sig ix)] ; can this interceptor handle the signal 42 | (apply f (concat [c-out ctx] args)) ; yes? invoke it 43 | (recur ix-stack signal-hierarchy)) ; no? try the next interceptor on the stack 44 | ;; we exhausted the stack 45 | (recur stack sigs) ; start the stack over with the rest of the signals 46 | ) 47 | ;; no signal, we exhausted the signal hierarchy and found nothing 48 | (put! c-out (ex-info "no signal handler found or found for any ancestors" 49 | {:signal signal 50 | :derivation-heirarchy signal-hierarchy 51 | :ctx ctx 52 | :args args})))))) 53 | 54 | (defn- requeue-current 55 | "Helper method to add the current interceptor being processed 56 | (the top of the stack) to the queue as the immediate next 57 | interceptor to process, and removes the current interceptor 58 | from the stack to avoid dual attempts at cleanup." 59 | [ctx] 60 | (let [stack (:lambda-toolshed.papillon/stack ctx)] 61 | (-> ctx 62 | (update :lambda-toolshed.papillon/queue #(into (empty %) (concat [(peek stack)] %))) 63 | (update :lambda-toolshed.papillon/stack pop)))) 64 | 65 | (defn- retry! 66 | "This handler will retry a request until it hits the retry limit. 67 | It uses a sub-map on the context with the url as the key that tracks 68 | how many times a given url fails, so individual requests (keyed by url) 69 | can be tracked and retried individually. 70 | If the retry count is within the max retry count limit, this 71 | handler will update the retry count in the context for the request 72 | and requeue the current handler to try the response again. 73 | If the retry count limit has been exceeded, throws an exception 74 | signaling that we tried too many times and still failed" 75 | [base-opts c-out ctx {:keys [retry-key] :as retry-ctx}] 76 | (let [{:keys [max-retry-count back-off!] :as retry-opts} (merge base-opts retry-ctx) 77 | retry-count (or (get-in ctx [::retry-count retry-key]) 0)] 78 | (go 79 | (>! c-out 80 | (if (> retry-count (dec max-retry-count)) 81 | (ex-info "Too Many Failures" 82 | {:retry-count retry-count 83 | :info retry-ctx}) 84 | (do 85 | ( ctx 87 | (assoc-in [::retry-count retry-key] (inc retry-count)) 88 | requeue-current))))))) 89 | 90 | (defn exponential-back-off! 91 | "Does an exponential backoff waiting for the number of milliseconds resulting 92 | from raising `initial-backoff-ms` to the power of `retry-count`." 93 | [retry-count {:keys [initial-backoff-ms] :as _retry-opts}] 94 | (async/timeout (expt initial-backoff-ms retry-count))) 95 | 96 | (defn linear-back-off! 97 | "Does an linear backoff waiting for the number of milliseconds resulting from 98 | `initial-backoff-ms` multiplied by `retry-count`." 99 | [retry-count {:keys [initial-backoff-ms] :as _retry-opts}] 100 | (async/timeout (* initial-backoff-ms retry-count))) 101 | 102 | (defn retry-ix 103 | "The Retry handler interceptor. 104 | Notice that there is no :enter, :leave, or :error key 105 | but a special key that is used to specify a handler 106 | for a given signal of `:retry`. 107 | 108 | This will retry `max-retry-count` before failing. 109 | 110 | Default retry strategy is Exponential Backoff with a starting 111 | time of 5 milliseconds" 112 | [opts] 113 | {:retry (partial retry! (merge {:max-retry-count 3 114 | :initial-backoff-ms 5 115 | :back-off! exponential-back-off!} 116 | opts))}) 117 | 118 | (def mark-transaction-unreconciled-ix 119 | {:name :mark-transaction-unreconciled-ix 120 | ;; Marks the transaction as reconciled in the database 121 | :enter (fn [{:example.ditributed-transactions/keys [mark-reconciled! transaction-id] :as ctx}] 122 | (println 123 | (pp/cl-format nil "marking record with id ~d in as reconciled~%" transaction-id)) 124 | (go 125 | (try 126 | (mark-reconciled! transaction-id) 127 | ctx 128 | (catch #?(:clj Throwable :cljs :default) err 129 | err)))) 130 | ;; basic logging that we successfully marked the transaction as reconciled since we 131 | ;; completed both transactions of marking the item in the database and publishing a 132 | ;; notification to reconcile that transaction 133 | :leave (fn [{:example.ditributed-transactions/keys [transaction-id] :as ctx}] 134 | (go 135 | (println 136 | (pp/cl-format nil "previously unreconciled transaction record with id of ~d was marked and notified~%" transaction-id)) 137 | (assoc ctx :example.ditributed-transactions/reconcile-result :success))) 138 | #_"If we have an error, 'rollback' the transaction by marking it as unreconciled. We either got here 139 | through the marking the transaction as reconciled, so we try to undo it, or we failed publishing 140 | the notification, so we need to retry the reconciler process to send a new notification to 141 | reconcile the transaction. 142 | 143 | If this happened and we rolledback successfully, we remove the error as we put the system back 144 | into a state that we can try again next reconcile run." 145 | :error (fn 146 | [{:example.ditributed-transactions/keys [mark-unreconciled! transaction-id] 147 | :lambda-toolshed.papillon/keys [error] :as ctx}] 148 | (println 149 | (pp/cl-format nil "encountered error marking transaction record ~d as unreconciled; rolling back orphan marking in the database; error was ~A~%" transaction-id error)) 150 | (go 151 | (try 152 | (mark-unreconciled! transaction-id) 153 | ;; Mark the error as handled, as unmarking the transaction as unreconciled 154 | ;; means we will "ignore" the failure and catch it on the next round 155 | ;; of unreconciled transaction checking 156 | (dissoc ctx :lambda-toolshed.papillon/error) 157 | (catch #?(:clj Throwable :cljs :default) err 158 | err))))}) 159 | 160 | (def build-transaction-sqs-message-ix 161 | {:name :transaction-sqs-message-ix 162 | :enter (fn [{:example.ditributed-transactions/keys [transaction-id] :as ctx}] 163 | (let [message {:transaction-id transaction-id}] 164 | (println 165 | (pp/cl-format nil "building message for unreconciled tranasction record with id: ~d~%" transaction-id)) 166 | (assoc ctx :example.ditributed-transactions/retry-transaction-msg message)))}) 167 | 168 | (def notify-unreconciled-transaction-found-ix 169 | {:name :notify-unreconciled-transaction-found-ix 170 | :enter (fn [{:example.ditributed-transactions/keys [send-sqs-message! retry-transaction-msg transaction-id] :as ctx}] 171 | (go 172 | (try 173 | (assoc ctx :example.ditributed-transactions/sqs-message-result (send-sqs-message! retry-transaction-msg)) 174 | ;; catch an error and signal a retry 175 | (catch #?(:clj Throwable :cljs :default) err 176 | (let [c (chan 1) 177 | ;; retry key is includes the transction-id to avoid collisions 178 | ;; as well as tracking the error we caught to propagate if we fail the retry limit 179 | retry-ctx {:retry-key (keyword (str "unreconcile-notify-transaction-" transaction-id)) 180 | :error err}] 181 | (signal :retry c ctx retry-ctx) 182 | ( parent-ctx 194 | (select-keys [:example.ditributed-transactions/mark-reconciled! 195 | :example.ditributed-transactions/mark-unreconciled! 196 | :example.ditributed-transactions/send-sqs-message!]) 197 | (assoc :example.ditributed-transactions/transaction-record transaction-record 198 | :example.ditributed-transactions/transaction-id id))] 199 | (papillon/execute (process-unreconciled-transaction-ixs) ctx))) 200 | 201 | ;; This also shows of spinning up multiple interceptor chains and executing 202 | ;; them in parallel and collecting the results into a single context result 203 | ;; for example, taking an interceptor chain at the outer and doing a set of 204 | ;; nested interceptors, e.g. a fork-join for updating individual transactions 205 | (defn process-unreconciled-transactions [{:example.ditributed-transactions/keys [unreconciled-transaction-records] :as ctx}] 206 | (go 207 | (println 208 | (pp/cl-format nil "process-unreconciled-transactions~%")) 209 | (let [c (->> unreconciled-transaction-records 210 | ;; run interceptors in parallel 211 | (map (partial process-unreconciled-transaction ctx)) 212 | ;; merge channel results into single channel 213 | (async/merge) 214 | ;; turn channel of results into channel of vector of results; e.g. await-all 215 | (async/reduce conj [])) 216 | results (! chan]] 5 | clojure.pprint)) 6 | 7 | (def debug true) 8 | 9 | (def important-ix 10 | (with-meta 11 | {:name :important-ix 12 | :enter (fn [ctx] 13 | (println "! I mark the start of an important chain of events") 14 | ctx)} 15 | {:supports-timing? true})) 16 | 17 | (defn wrap-with-timing 18 | [ix] 19 | (let [ix-name (:name ix) 20 | start-timing (fn 21 | [ix-name f] 22 | (let [f (if f f identity)] 23 | (fn [ctx] 24 | (let [start-time #?(:clj (. System (currentTimeMillis)) 25 | :cljs (. js/Date now))] 26 | (-> ctx 27 | (assoc-in [::dynamic-tracing ix-name :start-millis] start-time) 28 | f))))) 29 | stop-timing (fn 30 | [ix-name f] 31 | (let [f (if f f identity)] 32 | (fn [ctx] 33 | (let [end-time #?(:clj (. System (currentTimeMillis)) 34 | :cljs (. js/Date now)) 35 | start-time (get-in ctx [::dynamic-tracing ix-name :start-millis]) 36 | duration (- end-time start-time)] 37 | (println "Interceptor " ix-name "took" duration "ms") 38 | (-> ctx 39 | (assoc-in [::dynamic-tracing ix-name :end-millis] end-time) 40 | (assoc-in [::dynamic-tracing ix-name :duration-millis] duration) 41 | f)))))] 42 | (if (:supports-timing? (meta ix)) 43 | (-> ix 44 | (update :enter (partial start-timing ix-name)) 45 | (update :leave (partial stop-timing ix-name)) 46 | (update :error (partial stop-timing ix-name))) 47 | ix))) 48 | 49 | (def instrument-timings-ix 50 | {:name :instrument-timings 51 | :enter (fn [ctx] 52 | (if debug 53 | (let [queue (:lambda-toolshed.papillon/queue ctx) 54 | new-queue (into (empty queue) (map wrap-with-timing) queue)] 55 | (assoc ctx :lambda-toolshed.papillon/queue new-queue)) 56 | ctx))}) 57 | 58 | (def long-running-ix 59 | {:name :long-running-ix 60 | :enter (fn [ctx] 61 | (println "⌛ I take a while... ⌛") 62 | (let [c (chan)] 63 | (go 64 | (! c (assoc ctx :long-running-result :finished))) 66 | c))}) 67 | 68 | (def some-more-long-running-ix 69 | {:name :some-more-long-running-ix 70 | :enter (fn [ctx] 71 | (println "⏳ I take some time too... ⏳") 72 | (let [c (chan)] 73 | (go 74 | (! c (assoc ctx :some-more-long-running-result :finished))) 76 | c))}) 77 | 78 | (def varying-duration-ix 79 | {:name :varying-duration-ix 80 | :enter (fn [ctx] 81 | (println "⏰ I can be quick, or I can be long... ⏰") 82 | (let [c (chan)] 83 | (go 84 | (! c (assoc ctx :varying-duration-result :finished))) 86 | c))}) 87 | 88 | (def another-important-ix 89 | (with-meta 90 | {:name :another-important-ix 91 | :enter (fn [ctx] 92 | (println "❗I mark the start of an another important chain of events") 93 | ctx)} 94 | {:supports-timing? true})) 95 | 96 | (def yet-another-important-ix 97 | (with-meta 98 | {:name :yet-another-important-ix 99 | :enter (fn [ctx] 100 | (println "‼️ I mark the start of an yet another important chain of events") 101 | ctx)} 102 | {:supports-timing? true})) 103 | 104 | (go 105 | (let [c (execute [instrument-timings-ix 106 | important-ix 107 | long-running-ix 108 | another-important-ix 109 | some-more-long-running-ix 110 | yet-another-important-ix 111 | varying-duration-ix] 112 | {})] 113 | (println) 114 | (println "Results:") 115 | (clojure.pprint/pprint (! chan]] 5 | clojure.pprint)) 6 | 7 | ;; Synchronous interceptor that only handles items 8 | ;; on enter, and adds a new key to the context 9 | (def one-ix 10 | {:name :one-ix 11 | :enter (fn [ctx] 12 | (assoc ctx :number 1))}) 13 | 14 | ;; Run an interceptor chain with one interceptor in it that is synchronous 15 | ;; and does not take an initial context to augment 16 | (let [c (execute [one-ix])] 17 | (clojure.pprint/pprint c)) 18 | 19 | ;; Synchronous interceptor with that only handles items 20 | ;; on enter, and updates an existing key in the context 21 | (def double-number-ix 22 | {:name :double-number-ix 23 | :enter (fn [ctx] 24 | (update ctx :number #(* % 2)))}) 25 | 26 | ;; Run an interceptor chain with one interceptor in it that is synchronous 27 | ;; and does not take an initial context to augment 28 | (let [c (execute [one-ix 29 | double-number-ix])] 30 | (clojure.pprint/pprint c)) 31 | 32 | ;; Define an interceptor that prints out a message for the different 33 | ;; stages that it handles, along with the context 34 | (defn make-logger-ix [enter-msg leave-msg error-msg] 35 | {:name :logger-ix 36 | :enter (fn [ctx] 37 | (println "logger-ix" enter-msg) 38 | (clojure.pprint/pprint ctx) 39 | ctx) 40 | :leave (fn [ctx] 41 | (println "logger-ix" leave-msg) 42 | (clojure.pprint/pprint ctx) 43 | ctx) 44 | :error (fn [ctx] 45 | (println "logger-ix" error-msg) 46 | (clojure.pprint/pprint ctx) 47 | ctx)}) 48 | 49 | ;; The execute takes a seq of interceptors for the queue, so 50 | ;; we can maniuplate the base sequence of interceptors before we 51 | ;; start execution 52 | (let [c (execute (interleave (repeat (make-logger-ix "entering" "leaving" "errored ❌")) 53 | [one-ix 54 | double-number-ix 55 | double-number-ix]))] 56 | (clojure.pprint/pprint c)) 57 | 58 | ;; More complex debugging functionality, that shows that since the queue 59 | ;; and the stack are on the context, one can use that to their advantage 60 | (letfn [(describe-interceptor [ix] (or (:name ix) ix)) 61 | (prettify [ixs] (into (empty ixs) (map describe-interceptor) ixs)) 62 | (prettify-keys [ctx & ks] (reduce (fn [accum k] (update accum k prettify)) ctx ks)) 63 | (prettify-ctx [ctx] (prettify-keys ctx 64 | :lambda-toolshed.papillon/queue 65 | :lambda-toolshed.papillon/stack)) 66 | (make-debugger [stage] (fn [ctx] 67 | (clojure.pprint/pprint (str "Debug:: stage" stage)) 68 | (clojure.pprint/pprint (prettify-ctx ctx)) 69 | (println) 70 | ctx))] 71 | (def debug-ix 72 | {:name :trace-ix 73 | :enter (make-debugger :enter) 74 | :leave (make-debugger :leave) 75 | :error (make-debugger :error)})) 76 | 77 | ;; Are we in debug mode? 78 | ;; (of course we are; we are playing with the examples.) 79 | ;; real code could pull from env/config/dynamic var/request header, etc. 80 | (def debug true) 81 | 82 | ;; A simplistic debugger helper to conditionally enable itx debugging 83 | (defn with-debugging 84 | [ixs] 85 | (if debug 86 | (interleave (repeat debug-ix) ixs) 87 | ixs)) 88 | 89 | ;; Do some doubling, but use the pretty tracing to show how the 90 | ;; context is available to be munged for display, without updating 91 | ;; the context itself and killing the execution chain. 92 | ;; Persistant Data Structures FOR THE WIN!! 93 | (let [c (execute (with-debugging [one-ix 94 | double-number-ix 95 | double-number-ix]))] 96 | (clojure.pprint/pprint c)) 97 | 98 | ;; Asynchronous handler; returns a channel with the updated context inside it 99 | ;; Simple version where it is a go block 100 | (def async-double-number-ix 101 | {:name :async-double-number-ix 102 | :enter (fn [ctx] 103 | (go (update ctx :number #(* % 2))))}) 104 | 105 | ;; Do some asynchronous doubling, and use the pretty debugging to show how 106 | ;; the context is available to be munged for display, without updating 107 | ;; the context itself and killing the execution chain. 108 | ;; Persistant Data Structures FOR THE WIN!! 109 | (go 110 | (let [c (execute (with-debugging [one-ix 111 | async-double-number-ix 112 | async-double-number-ix]))] 113 | (clojure.pprint/pprint (! c (update ctx :number #(* % %)))) 123 | c))}) 124 | 125 | ;; Do some asynchronous doubling and squaring, with pretty debugging 126 | (go 127 | (let [c (execute (with-debugging [one-ix 128 | async-double-number-ix 129 | async-square-number-ix 130 | async-double-number-ix 131 | async-square-number-ix]))] 132 | (clojure.pprint/pprint ( ctx 26 | (vary-meta assoc :type ::ctx) 27 | (assoc ::queue #?(:clj clojure.lang.PersistentQueue/EMPTY 28 | :cljs cljs.core/PersistentQueue.EMPTY) 29 | ::stack [] 30 | ::stage :enter) 31 | (enqueue ixs)))) 32 | 33 | (defn- error? 34 | "Is the given value `x` an exception?" 35 | [x] 36 | #?(:clj (instance? Throwable x) 37 | :cljs (instance? js/Error x))) 38 | 39 | (defn clear-queue 40 | "Empty the interceptor queue of the given context `ctx`, thus ensuring no 41 | further processing of the `enter` chain is attempted." 42 | [ctx] 43 | (update ctx ::queue empty)) 44 | 45 | (defn- context? [obj] (= (-> obj meta :type) ::ctx)) 46 | 47 | (defn- transition 48 | "Transition the context `ctx` to the candidate context value `candidate`. 49 | This function works synchronously with value candidates -any async processing 50 | should be performed prior to invoking this function." 51 | [ctx tag candidate-ctx] 52 | (cond 53 | (reduced? candidate-ctx) (-> ctx 54 | (transition tag (unreduced candidate-ctx)) 55 | clear-queue) 56 | (error? candidate-ctx) (-> ctx 57 | (assoc ::error candidate-ctx) 58 | clear-queue) 59 | (context? candidate-ctx) candidate-ctx 60 | :else (let [e (ex-info (fmt "Context was lost at %s!" tag) 61 | {::tag tag 62 | ::ctx ctx 63 | ::candidate-ctx candidate-ctx})] 64 | (transition ctx tag e)))) 65 | 66 | (defn- move 67 | "Transition the given context `ctx` to the next state by modifying the queue, 68 | stack and stage." 69 | [{::keys [queue stack stage error handled?] :as ctx}] 70 | (case stage 71 | :enter (if-let [ix (peek queue)] 72 | (-> ctx 73 | (update ::queue pop) 74 | (update ::stack conj ix)) 75 | (-> ctx 76 | (assoc ::stage (if error :error :leave)))) 77 | :leave (-> ctx (assoc ::stage (if error :error :final))) 78 | :error (-> ctx (assoc ::stage :final)) 79 | :final (-> ctx 80 | (update ::stack pop) 81 | (assoc ::stage (if error :error :leave))))) 82 | 83 | (defn- evaluate 84 | "Evaluate the next operation of the given context `ctx`. Returns a three-tuple 85 | of the context prior to interceptor execution, the emerge-able result of 86 | interceptor execution and a tag documenting the execution." 87 | [ctx] 88 | (let [{::keys [stage stack] :as ctx} (move ctx)] 89 | (when-let [ix (peek stack)] 90 | (let [tag [(identify ix) stage] 91 | f (or (ix stage) identity) 92 | ctx (update ctx ::trace (fn [t] (when t (conj t tag)))) 93 | obj (try (f ctx) (catch #?(:clj Throwable :cljs :default) e e))] 94 | [ctx obj tag])))) 95 | 96 | (defn- execute-sync 97 | "Recursively execute the given context `ctx`, synchronously returning the 98 | resulting context or throwing if an exception is not handled by the chain. 99 | 100 | The initial context `ctx` must include the necessary housekeeping data 101 | structures before processing the chain. See `initialize`." 102 | [ctx] 103 | (if-let [[ctx obj tag] (evaluate ctx)] 104 | (let [jump (partial transition ctx tag)] 105 | (recur (-> obj emerge jump))) 106 | (if-let [e (::error ctx)] (throw e) ctx))) 107 | 108 | (defn- execute-async 109 | "Recursively execute the given context `ctx`, calling the given `callback` 110 | asynchronously with the resulting context or exception, if not handled by 111 | the chain. 112 | 113 | The initial context `ctx` must include the necessary housekeeping data 114 | structures before processing the chain. See `initialize`." 115 | [ctx callback] 116 | (if-let [[ctx obj tag] (evaluate ctx)] 117 | (let [jump (partial transition ctx tag) 118 | continue (comp #(execute-async % callback) jump)] 119 | (emerge obj continue)) 120 | (callback (or (::error ctx) ctx)))) 121 | 122 | (defn execute 123 | "Execute the interceptor chain within the given context `ctx`. If the 124 | function `callback` is provided, run in async mode, otherwise run in 125 | sync mode. 126 | 127 | Run forward through the chain calling the functions associated with the 128 | `:enter` key (where it exists), while accumulating a stack of interceptors 129 | seen. When the `:enter` chain is exhausted, run the accumulated stack in 130 | reverse order. 131 | 132 | Async Mode: this function returns nil without blocking and `callback` is 133 | invoked (possibly on the calling thread, if no interceptor in the chain 134 | returns a value that must be emerged asynchronously). Each interceptor must 135 | return a (possibly deferred) context that can be realized without blocking 136 | (via the two-arity version of the Chrysalis protocol). Always returns nil. 137 | 138 | Sync Mode: this function returns the resulting context synchronously, possibly 139 | blocking while waiting for deferred contexts to be realized. Each interceptor 140 | must return a (possibly deferred) context that can be realized synchronously 141 | (via the single-arity version of the Chryslis protocol). Returns either the 142 | result context, or throws any unhandled exception." 143 | ([ixs ctx] ; sync mode 144 | {:pre [(sequential? ixs) (map? ctx)]} 145 | (execute-sync (initialize ixs ctx))) 146 | ([ixs ctx callback] ; async mode 147 | {:pre [(sequential? ixs) (map? ctx) (fn? callback)]} 148 | (execute-async (initialize ixs ctx) callback) 149 | nil)) 150 | -------------------------------------------------------------------------------- /src/lambda_toolshed/papillon/channel.cljc: -------------------------------------------------------------------------------- 1 | (ns lambda-toolshed.papillon.channel 2 | (:require [clojure.core.async :as async] 3 | [clojure.core.async.impl.channels :as channels] 4 | [lambda-toolshed.papillon.protocols :as protocols])) 5 | 6 | (extend-type #?(:clj clojure.core.async.impl.protocols.Channel 7 | :cljs cljs.core.async.impl.channels/ManyToManyChannel) 8 | protocols/Chrysalis 9 | (emerge 10 | #?(:clj ([this] (async/ this deref callback)))))) 40 | 41 | #?(:cljs 42 | (extend-protocol Chrysalis 43 | js/Promise 44 | (emerge 45 | ([this] (throw (ex-info "A deferred context cannot be resolved synchronously!" 46 | {::this this ::type (type this)}))) 47 | ([this f] (.then this f))))) 48 | -------------------------------------------------------------------------------- /test/lambda_toolshed/papillon/channel_test.cljc: -------------------------------------------------------------------------------- 1 | (ns lambda-toolshed.papillon.channel-test 2 | "Tests that demonstrate the opt-in ability of papillon to work seamlessly with 3 | clojure.core.async channels -either as the deferred output of an interceptor 4 | or as the output of the overall chain execution." 5 | (:require 6 | [clojure.core.async :as async] 7 | [clojure.test :refer [deftest is testing]] 8 | [lambda-toolshed.papillon :as ix] 9 | [lambda-toolshed.papillon.channel] 10 | [lambda-toolshed.test-utils :refer [runt! runt-fn! test-async] :include-macros true])) 11 | 12 | (def ix {:name :ix :enter identity :leave identity :error identity}) 13 | (def exception (ex-info "the exception" {})) 14 | (def ix-throw-on-enter {:name :ix-throw-on-enter :enter (fn [_] (throw exception))}) 15 | (def ix-throw-on-leave {:name :ix-throw-on-leave :leave (fn [_] (throw exception))}) 16 | (def ix-catch 17 | {:name :ix-catch 18 | :error (fn [{error ::ix/error :as ctx}] 19 | (-> ctx 20 | (dissoc ::ix/error) 21 | (assoc ::error error)))}) 22 | 23 | (def ix-counter {:name :ix-counter 24 | :enter #(update % :enter (fnil inc 0)) 25 | :leave #(update % :leave (fnil inc 0)) 26 | :error #(update % :error (fnil inc 0))}) 27 | 28 | (def $ctx {::ix/trace [] ::x true}) 29 | 30 | (deftest channels-as-chrysalis 31 | (let [ixs [{:name :ix-chrysalis 32 | :enter (fn [ctx] (async/go (assoc ctx ::hello true)))} 33 | ix] 34 | expected-trace [[:ix-chrysalis :enter] 35 | [:ix :enter] 36 | [:ix :leave] 37 | [:ix :final] 38 | [:ix-chrysalis :leave] 39 | [:ix-chrysalis :final]]] 40 | #?(:clj (testing "sync" 41 | (let [result (ix/execute ixs $ctx)] 42 | (is (= expected-trace (::ix/trace result))) 43 | (is (::x result))))) 44 | (testing "async" 45 | (test-async done 46 | (let [cb (fn [result] 47 | (is (= expected-trace (::ix/trace result))) 48 | (is (::x result)) 49 | (done))] 50 | (ix/execute ixs $ctx cb)))))) 51 | 52 | (deftest deferred-execution-result 53 | (let [ixs [{:name ::hello 54 | :enter (fn [ctx] (async/go (assoc ctx ::hello true)))} 55 | {:name ::world 56 | :leave (fn [ctx] (assoc ctx ::world true))}] 57 | expected-trace [[::hello :enter] 58 | [::world :enter] 59 | [::world :leave] 60 | [::world :final] 61 | [::hello :leave] 62 | [::hello :final]]] 63 | (test-async done 64 | (let [c (async/chan) 65 | callback (partial async/put! c)] 66 | (ix/execute ixs $ctx callback) 67 | (async/go (when-let [result (async/alt! c ([ctx] ctx) 68 | (async/timeout 10) nil)] 69 | (is (= expected-trace (::ix/trace result))) 70 | (is (::x result)) 71 | (is (::hello result)) 72 | (is (::world result))) 73 | (done)))))) 74 | -------------------------------------------------------------------------------- /test/lambda_toolshed/papillon_test.cljc: -------------------------------------------------------------------------------- 1 | (ns lambda-toolshed.papillon-test 2 | (:require 3 | [clojure.test :refer [deftest is testing]] 4 | [lambda-toolshed.papillon :as ix] 5 | [lambda-toolshed.test-utils :refer [runt! runt-fn! test-async] :include-macros true])) 6 | 7 | (def ix {:name :ix :enter identity :leave identity :error identity}) 8 | (def exception (ex-info "the exception" {})) 9 | (def ix-throw-on-enter {:name :ix-throw-on-enter :enter (fn [_] (throw exception))}) 10 | (def ix-throw-on-leave {:name :ix-throw-on-leave :leave (fn [_] (throw exception))}) 11 | (def ix-throw-on-error {:name :ix-throw-on-error :error (fn [_] (throw exception))}) 12 | (def ix-catch 13 | {:name :ix-catch 14 | :error (fn [{error ::ix/error :as ctx}] 15 | (-> ctx 16 | (dissoc ::ix/error) 17 | (assoc ::error error)))}) 18 | 19 | (def ix-counter {:name :ix-counter 20 | :enter #(update % :enter (fnil inc 0)) 21 | :leave #(update % :leave (fnil inc 0)) 22 | :error #(update % :error (fnil inc 0))}) 23 | 24 | (def $ctx {::ix/trace [] ::x true}) 25 | 26 | (deftest enqueue 27 | (testing "enqueues interceptors to an empty context" 28 | (let [ixs [{:enter identity}] 29 | ctx (ix/enqueue {} ixs)] 30 | (is (::ix/queue ctx)) 31 | (is (= (::ix/queue ctx) ixs)))) 32 | (testing "enqueues interceptors to existing interceptors" 33 | (let [ixs [{} {} {}] 34 | ixs2 [{}] 35 | ctx (ix/enqueue (ix/enqueue {} ixs) ixs2)] 36 | (is (::ix/queue ctx)) 37 | (is (= (::ix/queue ctx) (apply conj ixs ixs2))))) 38 | (testing "enqueues resolved vars" 39 | (let [ixs [] 40 | ctx (ix/enqueue (ix/initialize [] {}) [#'ix-counter])] 41 | (is (= ix-counter (-> ctx ::ix/queue first)))))) 42 | 43 | (deftest clear-queue 44 | (testing "clears the context's queue" 45 | (let [ixs [{:enter identity}] 46 | ctx (ix/clear-queue (ix/enqueue {} ixs))] 47 | (is (empty? (ctx ::ix/queue)))))) 48 | 49 | (deftest baseline 50 | (let [ixs [ix-counter] 51 | expected-trace [[:ix-counter :enter] [:ix-counter :leave] [:ix-counter :final]]] 52 | (testing "sync" 53 | (let [result (ix/execute ixs $ctx)] 54 | (is (= expected-trace (::ix/trace result))) 55 | (is (= 1 (:enter result))) 56 | (is (= 1 (:leave result))) 57 | (is (nil? (:error result))) 58 | (is (::x result)))) 59 | (testing "async" 60 | (test-async done 61 | (let [cb (fn [result] 62 | (is (= expected-trace (::ix/trace result))) 63 | (is (= 1 (:enter result))) 64 | (is (= 1 (:leave result))) 65 | (is (nil? (:error result))) 66 | (is (::x result)) 67 | (done))] 68 | (ix/execute ixs $ctx cb)))))) 69 | 70 | (deftest allows-for-empty-chain-of-interceptors 71 | (let [ixs [] 72 | expected-trace []] 73 | (testing "sync" 74 | (let [result (ix/execute ixs $ctx)] 75 | (is (= expected-trace (::ix/trace result))) 76 | (is (::x result)))) 77 | (testing "async" 78 | (test-async done 79 | (let [cb (fn [result] 80 | (is (= expected-trace (::ix/trace result))) 81 | (is (::x result)) 82 | (done))] 83 | (ix/execute ixs $ctx cb)))))) 84 | 85 | (deftest allows-for-interceptor-chain-of-only-enters 86 | (let [ixs [{:name :ix :enter identity}] 87 | expected-trace [[:ix :enter] [:ix :leave] [:ix :final]]] 88 | (testing "sync" 89 | (let [result (ix/execute ixs $ctx)] 90 | (is (= expected-trace (::ix/trace result))) 91 | (is (::x result)))) 92 | (testing "async" 93 | (test-async done 94 | (let [cb (fn [result] 95 | (is (= expected-trace (::ix/trace result))) 96 | (is (::x result)) 97 | (done))] 98 | (ix/execute ixs $ctx cb)))))) 99 | 100 | (deftest allows-for-interceptor-chain-of-only-leaves 101 | (let [ixs [{:name :ix :leave identity}] 102 | expected-trace [[:ix :enter] [:ix :leave] [:ix :final]]] 103 | (testing "sync" 104 | (let [result (ix/execute ixs $ctx)] 105 | (is (= expected-trace (::ix/trace result))) 106 | (is (::x result)))) 107 | (testing "async" 108 | (test-async done 109 | (let [cb (fn [result] 110 | (is (= expected-trace (::ix/trace result))) 111 | (is (::x result)) 112 | (done))] 113 | (ix/execute ixs $ctx cb)))))) 114 | 115 | (deftest allows-for-interceptor-chain-of-only-errors 116 | (let [ixs [{:name :ix :error identity}] 117 | expected-trace [[:ix :enter] [:ix :leave] [:ix :final]]] 118 | (testing "sync" 119 | (let [result (ix/execute ixs $ctx)] 120 | (is (= expected-trace (::ix/trace result))) 121 | (is (::x result)))) 122 | (testing "async" 123 | (test-async done 124 | (let [cb (fn [result] 125 | (is (= expected-trace (::ix/trace result))) 126 | (is (::x result)) 127 | (done))] 128 | (ix/execute ixs $ctx cb)))))) 129 | 130 | (deftest exception-semantics-are-preserved 131 | (let [ixs [ix-throw-on-enter] 132 | expected-trace [[:ix :enter] [:ix :error]]] 133 | (testing "sync" 134 | (is (thrown-with-msg? 135 | #?(:clj clojure.lang.ExceptionInfo :cljs ExceptionInfo) 136 | #"the exception" 137 | (ix/execute ixs $ctx)))) 138 | (testing "async" 139 | (test-async done 140 | (let [cb (fn [result] 141 | (is (= exception result)) 142 | (done))] 143 | (ix/execute ixs $ctx cb)))))) 144 | 145 | (deftest error-chain-is-invoked-when-enter-throws-an-exception 146 | (let [ixs [ix-catch ix-throw-on-enter] 147 | expected-trace [[:ix-catch :enter] 148 | [:ix-throw-on-enter :enter] 149 | [:ix-throw-on-enter :error] 150 | [:ix-throw-on-enter :final] 151 | [:ix-catch :error] 152 | [:ix-catch :final]]] 153 | (testing "sync" 154 | (let [result (ix/execute ixs $ctx)] 155 | (is (= expected-trace (::ix/trace result))) 156 | (is (::x result)))) 157 | (testing "async" 158 | (test-async done 159 | (let [cb (fn [result] 160 | (is (= expected-trace (::ix/trace result))) 161 | (is (::x result)) 162 | (done))] 163 | (ix/execute ixs $ctx cb)))))) 164 | 165 | (deftest error-chain-is-invoked-when-leave-throws-an-exception 166 | (let [ixs [ix-catch ix-throw-on-leave] 167 | expected-trace [[:ix-catch :enter] 168 | [:ix-throw-on-leave :enter] 169 | [:ix-throw-on-leave :leave] 170 | [:ix-throw-on-leave :error] 171 | [:ix-throw-on-leave :final] 172 | [:ix-catch :error] 173 | [:ix-catch :final]]] 174 | (testing "sync" 175 | (let [result (ix/execute ixs $ctx)] 176 | (is (= expected-trace (::ix/trace result))) 177 | (is (::x result)))) 178 | (testing "async" 179 | (test-async done 180 | (let [cb (fn [result] 181 | (is (= expected-trace (::ix/trace result))) 182 | (is (::x result)) 183 | (done))] 184 | (ix/execute ixs $ctx cb)))))) 185 | 186 | (deftest interceptors-can-return-chrysalises 187 | (let [ixs [{:name :ix-chrysalis 188 | :enter (fn [ctx] 189 | #?(:clj (let [p (promise)] (deliver p ctx) p) 190 | :cljs (js/Promise.resolve ctx)))} 191 | ix] 192 | expected-trace [[:ix-chrysalis :enter] 193 | [:ix :enter] 194 | [:ix :leave] 195 | [:ix :final] 196 | [:ix-chrysalis :leave] 197 | [:ix-chrysalis :final]]] 198 | #?(:clj (testing "sync" 199 | (let [result (ix/execute ixs $ctx)] 200 | (is (= expected-trace (::ix/trace result))) 201 | (is (::x result))))) 202 | (testing "async" 203 | (test-async done 204 | (let [cb (fn [result] 205 | (is (= expected-trace (::ix/trace result))) 206 | (is (::x result)) 207 | (done))] 208 | (ix/execute ixs $ctx cb)))))) 209 | 210 | (deftest error-chain-is-invoked-when-enter-returns-an-exception-chrysalis 211 | (let [p #?(:clj (let [p (promise)] (deliver p exception) p) 212 | :cljs (js/Promise.resolve exception)) 213 | ixs [ix-catch 214 | {:name :ix-thrown-chrysalis :enter (constantly p)}] 215 | expected-trace [[:ix-catch :enter] 216 | [:ix-thrown-chrysalis :enter] 217 | [:ix-thrown-chrysalis :error] 218 | [:ix-thrown-chrysalis :final] 219 | [:ix-catch :error] 220 | [:ix-catch :final]]] 221 | #?(:clj (testing "sync" 222 | (let [result (ix/execute ixs $ctx)] 223 | (is (= expected-trace (::ix/trace result))) 224 | (is (::x result)) 225 | (is (= exception (::error result)))))) 226 | (testing "async" 227 | (test-async done 228 | (let [cb (fn [result] 229 | (is (= expected-trace (::ix/trace result))) 230 | (is (::x result)) 231 | (is (= exception (::error result))) 232 | (done))] 233 | (ix/execute ixs $ctx cb)))))) 234 | 235 | (deftest lost-context-triggers-exception 236 | (let [ixs [ix-catch {:name :loser :enter (constantly nil)}] 237 | expected-trace [[:ix-catch :enter] 238 | [:loser :enter] 239 | [:loser :error] 240 | [:loser :final] 241 | [:ix-catch :error] 242 | [:ix-catch :final]]] 243 | (testing "sync" 244 | (let [result (ix/execute ixs $ctx)] 245 | (is (= expected-trace (::ix/trace result))) 246 | (is (= "Context was lost at [:loser :enter]!" (ex-message (result ::error)))))) 247 | (testing "async" 248 | (test-async done 249 | (let [cb (fn [result] 250 | (is (= expected-trace (::ix/trace result))) 251 | (is (= "Context was lost at [:loser :enter]!" (ex-message (result ::error)))) 252 | (done))] 253 | (ix/execute ixs $ctx cb)))))) 254 | 255 | (deftest error-chain-is-invoked-when-leave-returns-an-exception-chrysalis 256 | (let [p #?(:clj (let [p (promise)] (deliver p exception) p) 257 | :cljs (js/Promise.resolve exception)) 258 | ixs [ix-catch 259 | {:name :ix-thrown-chrysalis :leave (constantly p)}] 260 | expected-trace [[:ix-catch :enter] 261 | [:ix-thrown-chrysalis :enter] 262 | [:ix-thrown-chrysalis :leave] 263 | [:ix-thrown-chrysalis :error] 264 | [:ix-thrown-chrysalis :final] 265 | [:ix-catch :error] 266 | [:ix-catch :final]]] 267 | #?(:clj (testing "sync" 268 | (let [result (ix/execute ixs $ctx)] 269 | (is (= expected-trace (::ix/trace result))) 270 | (is (::x result)) 271 | (is (= exception (::error result)))))) 272 | (testing "async" 273 | (test-async done 274 | (let [cb (fn [result] 275 | (is (= expected-trace (::ix/trace result))) 276 | (is (::x result)) 277 | (is (= exception (::error result))) 278 | (done))] 279 | (ix/execute ixs $ctx cb)))))) 280 | 281 | (deftest leave-chain-is-resumed-when-error-processor-removes-error-key 282 | (let [ixs [ix ix-catch ix-throw-on-leave] 283 | expected-trace [[:ix :enter] 284 | [:ix-catch :enter] 285 | [:ix-throw-on-leave :enter] 286 | [:ix-throw-on-leave :leave] 287 | [:ix-throw-on-leave :error] 288 | [:ix-throw-on-leave :final] 289 | [:ix-catch :error] 290 | [:ix-catch :final] 291 | [:ix :leave] 292 | [:ix :final]]] 293 | (testing "sync" 294 | (let [result (ix/execute ixs $ctx)] 295 | (is (= expected-trace (::ix/trace result))) 296 | (is (::x result)))) 297 | (testing "async" 298 | (test-async done 299 | (let [cb (fn [result] 300 | (is (= expected-trace (::ix/trace result))) 301 | (is (::x result)) 302 | (done))] 303 | (ix/execute ixs $ctx cb)))))) 304 | 305 | (deftest reduced-context-stops-enter-chain-processing 306 | (let [ixs [{:name :reducer :enter reduced} ix] 307 | expected-trace [[:reducer :enter] 308 | [:reducer :leave] 309 | [:reducer :final]]] 310 | (testing "sync" 311 | (let [result (ix/execute ixs $ctx)] 312 | (is (= expected-trace (::ix/trace result))) 313 | (is (::x result)))) 314 | (testing "async" 315 | (test-async done 316 | (let [cb (fn [result] 317 | (is (= expected-trace (::ix/trace result))) 318 | (is (::x result)) 319 | (done))] 320 | (ix/execute ixs $ctx cb)))))) 321 | 322 | (deftest error-chain-is-continued-on-consecutive-throws 323 | (let [ixs [ix ix-catch ix-throw-on-error ix-throw-on-leave] 324 | expected-trace [[:ix :enter] 325 | [:ix-catch :enter] 326 | [:ix-throw-on-error :enter] 327 | [:ix-throw-on-leave :enter] 328 | [:ix-throw-on-leave :leave] 329 | [:ix-throw-on-leave :error] 330 | [:ix-throw-on-leave :final] 331 | [:ix-throw-on-error :error] 332 | [:ix-throw-on-error :final] 333 | [:ix-catch :error] 334 | [:ix-catch :final] 335 | [:ix :leave] 336 | [:ix :final]]] 337 | (testing "sync" 338 | (let [result (ix/execute ixs $ctx)] 339 | (is (= expected-trace (::ix/trace result))) 340 | (is (::x result)))) 341 | (testing "async" 342 | (test-async done 343 | (let [cb (fn [result] 344 | (is (= expected-trace (::ix/trace result))) 345 | (is (::x result)) 346 | (done))] 347 | (ix/execute ixs $ctx cb)))))) 348 | 349 | (deftest context-represents-chain-state-contract 350 | (let [recorder-fn (fn [{::ix/keys [queue stack stage] :as ctx}] 351 | (update ctx ::trace (fnil conj []) [(-> queue peek :name) (-> stack peek :name) stage])) 352 | recorderA {:name ::A :enter recorder-fn :leave recorder-fn :error recorder-fn :final recorder-fn} 353 | recorderB (assoc recorderA :name ::B) 354 | ixs [recorderA recorderB] 355 | expected-trace [[::B ::A :enter] 356 | [nil ::B :enter] 357 | [nil ::B :leave] 358 | [nil ::B :final] 359 | [nil ::A :leave] 360 | [nil ::A :final]]] 361 | (testing "sync" 362 | (let [result (ix/execute ixs $ctx)] 363 | (is (= expected-trace (::trace result))))) 364 | (testing "async" 365 | (test-async done 366 | (let [cb (fn [result] 367 | (is (= expected-trace (::trace result))) 368 | (done))] 369 | (ix/execute ixs $ctx cb)))))) 370 | 371 | (deftest processing-can-be-short-circuited 372 | (testing "clear-queue" 373 | (let [ixs [ix {:name :halter :enter ix/clear-queue} ix] 374 | expected-trace [[:ix :enter] 375 | [:halter :enter] 376 | [:halter :leave] 377 | [:halter :final] 378 | [:ix :leave] 379 | [:ix :final]]] 380 | (testing "sync" 381 | (let [result (ix/execute ixs $ctx)] 382 | (is (= expected-trace (::ix/trace result))) 383 | (is (::x result)))) 384 | (testing "async" 385 | (test-async done 386 | (let [cb (fn [result] 387 | (is (= expected-trace (::ix/trace result))) 388 | (is (::x result)) 389 | (done))] 390 | (ix/execute ixs $ctx cb)))))) 391 | (testing "clear-stack" 392 | (let [ixs [{:name ::ixA} {:name :halter :leave (fn [{:as ctx}] (update ctx ::ix/stack empty))} {:name ::ixB}]] 393 | ;; Testing for a specific trace locks papillon into the current semantics whereby clearing the stack skips 394 | ;; the :final stage. This may or may not be the intended behavior in the long term. Until then, beware. 395 | (testing "sync" 396 | (let [result (ix/execute ixs $ctx)] 397 | (is (::x result)))) 398 | (testing "async" 399 | (test-async done 400 | (let [cb (fn [result] 401 | (is (::x result)) 402 | (done))] 403 | (ix/execute ixs $ctx cb))))))) 404 | -------------------------------------------------------------------------------- /test/lambda_toolshed/test_utils.cljc: -------------------------------------------------------------------------------- 1 | (ns lambda-toolshed.test-utils 2 | (:require [clojure.core.async :as async] 3 | [clojure.core.async.impl.protocols :as impl] 4 | [clojure.test :as test])) 5 | 6 | (defmacro test-async 7 | "Asynchronously execute the test body." 8 | [done & body] 9 | (if (:ns &env) 10 | ;; In ClojureScript we execute the body as a test/async body, letting test/async bind the done callback. 11 | `(test/async ~done ~@body) 12 | ;; In Clojure we keep the same signature, but provide a blocking coordination function for the done "callback". 13 | `(let [p# (promise) 14 | ~done (fn [] (deliver p# true))] 15 | ~@body 16 | @p#))) 17 | 18 | (defn runt-fn! 19 | "`runt!` helper function" 20 | [f] 21 | (let [once-fixture-fn (clojure.test/join-fixtures (:clojure.test/once-fixtures (meta *ns*))) 22 | each-fixture-fn (clojure.test/join-fixtures (:clojure.test/each-fixtures (meta *ns*)))] 23 | (once-fixture-fn 24 | (fn [] 25 | (each-fixture-fn 26 | (fn [] 27 | #?(:clj (f) 28 | :cljs (let [f (f)] 29 | (if (satisfies? cljs.test/IAsyncTest f) 30 | (f (fn done [])) 31 | f))))))))) 32 | 33 | (defmacro runt! 34 | "Run expression with fixtures" 35 | [& body] 36 | `(runt-fn! (fn [] ~@body))) 37 | --------------------------------------------------------------------------------