├── .gitignore ├── .travis.yml ├── CONTRIBUTING.md ├── ChangeLog ├── LICENSE ├── Makefile ├── README.adoc ├── docs └── index.adoc ├── env └── dev │ └── user.clj ├── project.clj ├── specs ├── config │ ├── defaults.edn │ └── test.edn ├── migrations │ └── protocol_support_20160125.clj ├── resources │ └── config │ │ └── defaults.edn └── untangled │ └── server │ ├── core_spec.clj │ ├── impl │ ├── components │ │ ├── config_spec.clj │ │ ├── handler_spec.clj │ │ └── web_server_spec.clj │ ├── protocol_support_spec.clj │ └── util_spec.clj │ └── protocol_support_spec.clj └── src └── untangled └── server ├── core.clj ├── fixtures └── dont_require_me.clj ├── impl ├── components │ ├── config.clj │ ├── handler.clj │ ├── web_server.clj │ └── wrap_defaults.clj ├── middleware.clj ├── protocol_support.clj └── util.clj └── protocol_support.clj /.gitignore: -------------------------------------------------------------------------------- 1 | target 2 | .idea 3 | *.iml 4 | *.sw? 5 | .lein* 6 | .nrepl* 7 | *.log 8 | datahub.log* 9 | pom.xml 10 | pom.xml.asc 11 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | script: 3 | - lein test-refresh :run-once 4 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing 2 | 3 | If you'd like to submit a PR, please follow these general guidelines: 4 | 5 | - Either talk to use about it in Slack, or open a github issue 6 | - Do development against the develop branch (we use git flow). PRs should be directed at the develop branch. Master 7 | is the latest release, not the live development. 8 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | 0.7.0 2 | ----- 3 | - Added ability to manipulate respose from API handler 4 | - Significant refactoring to support more modular & flexible server creation. 5 | See `untangled.server.core/untangled-system` for more docs. 6 | - Various documentation improvements 7 | 8 | 0.6.2 9 | ----- 10 | - A Few openid fixes 11 | - Ability to set the API endpoint 12 | 13 | 0.6.1 14 | ----- 15 | - Access token handler inspect :headers, :params, :form-params, and :cookies 16 | - Openid Mock not handles post logout redirect. 17 | 18 | 0.6.0 19 | ----- 20 | - :authorized-routes => :unsecured-routes 21 | - should be a bidi route map to :ok handlers (enforced on system start) 22 | - top level files are always unsecured 23 | - root route "/" is also always unsecured 24 | - to unsecure a whole sub-route (eg: the js folder) 25 | use bidi's catch-all routes, eg: `{"/js" {true :ok}}` 26 | - Open id mock will now deal with multiple users. 27 | "user" can be passed as a query param to the open id mock endpoint. 28 | The user that is passed will be selected out of the :users, 29 | and if there is no user, the first will be selected 30 | Example 31 | ```clojure 32 | {:openid-mock {:users {"123-456" {:role ["user.awesome"] 33 | :realm ["14133"] 34 | :sub "123-456" 35 | :name "Donald Duck"} 36 | "456-789" {:role ["user.super"] 37 | :realm ["14133"] 38 | :sub "456-789" 39 | :name "Mickey Mouse"}}]] 40 | ``` 41 | - Fixing heisenbugs wrt datomic not sorting & protocol-testing randomly failing 42 | - Adding invalid-token-handler to the :openid config 43 | - Takes a request whenever an invalid token 44 | is passed to a secured-route (ie: not an unsecured-route) 45 | and should return whether the request should be allowed 46 | to flow through the handler stack (defaults to false) 47 | - Removing specter => clojure.walk 48 | 49 | 0.5.1 50 | ----- 51 | - Logging the config on start 52 | - Upgraded specter to 0.11.0 53 | 54 | 0.5.0 55 | ----- 56 | - :extra-routes handlers are now of type (fn [env match] res) 57 | the :request is in the env 58 | - access-token-handler looks for :client_id if :sub is not present 59 | 60 | 0.4.8 61 | ----- 62 | - Added stack traces to server parsing error logging 63 | - Updated dependencies 64 | - Added server settings to log message of webserver start 65 | - Removed dev environ 66 | 67 | 0.4.7 68 | ----- 69 | - Added build-test-mock-openid-server to grab openid config and put into the 70 | server parser env when protocol testing. The component should be placed 71 | under the key :test-openid-mock and have information under :openid-mock/claims 72 | that gets placed in env [:request :user]. 73 | - check-response-to-client's :on-success callback now has a :remap-fn in its env 74 | which is a function to remap a response from real ids to the fake (keyword) ids 75 | eg: :datomic.id/* & :om.tempid/* 76 | - check-response-to-client now takes an optional :which-db which is a keyword 77 | that specifies from which db a response originates from. 78 | This is because :db/id's are not unique across datomic databases. 79 | 80 | 0.4.5 81 | ----- 82 | - Removed default logger configuration 83 | - Moved GELF logger to an optional compoent 84 | - Changed dependencies to not pull GELF in as a transitive dependency 85 | - Fixed various docs 86 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | Copyright (c) 2015 NAVIS 3 | 4 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated 5 | documentation files (the "Software"), to deal in the Software without restriction, including without limitation the 6 | rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit 7 | persons to whom the Software is furnished to do so, subject to the following conditions: 8 | 9 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the 10 | Software. 11 | 12 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE 13 | WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 14 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR 15 | OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 16 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | test-server: 2 | rlwrap lein test-refresh 3 | 4 | help: 5 | @ make -rpn | sed -n -e '/^$$/ { n ; /^[^ ]*:/p; }' | sort | egrep --color '^[^ ]*:' 6 | -------------------------------------------------------------------------------- /README.adoc: -------------------------------------------------------------------------------- 1 | = Untangled Server 2 | :source-highlighter: coderay 3 | :source-language: clojure 4 | :toc: 5 | :toc-placement: preamble 6 | :sectlinks: 7 | :sectanchors: 8 | :sectnums: 9 | 10 | image::https://img.shields.io/clojars/v/navis/untangled-server.svg[link=https://clojars.org/navis/untangled-server] 11 | 12 | Release: image:https://api.travis-ci.org/untangled-web/untangled-server.svg?branch=master[link=https://github.com/untangled-web/untangled-server/tree/master] 13 | Snapshot: image:https://api.travis-ci.org/untangled-web/untangled-server.svg?branch=develop[link=https://github.com/untangled-web/untangled-server/tree/develop] 14 | 15 | == Features 16 | 17 | The Untangled server library provides a full-stack development experience for Untangled Web applications. 18 | When combined with the client library, you get a number of base features that are useful for most applications: 19 | 20 | - An easy-to-use pluggable architecture for adding in databases and other components 21 | - A clear way to add read/write semantics for handling Untangled queries and mutations 22 | - Processing pipeline hooks for pre-processing, post-processing, and non-API routes (e.g. file serving) 23 | - General data compression and file resource cache headers 24 | 25 | The overall network plumbing of Untangled includes a number of additional features that assist with some 26 | common patterns needed by most applications: 27 | 28 | - JSON+Transit for API encoding 29 | - The ability to elide UI-only bits of query when using a general UI query against a server 30 | - A clean story for app-state merging that includes attribute "stomping" semantics 31 | - Clear network communication ordering to prevent out-of-order execution reasoning 32 | - The ability to send queries in parallel when sequential reads are not necessary for clear reasoning (parallel loading) 33 | - A pluggable ring handler middleware stack for injecting your own middleware as needed. 34 | - Provides access to the underlying https://github.com/stuartsierra/component[stuartsierra component system] for injecting your own components. 35 | - Lets you write your own api routes using a thin wrapper around https://github.com/juxt/bidi[bidi] 36 | - Configurable configuration component that supports: a defaults.edn file, a path to a config edn file for merging into the defaults, and support for environmental variable access. 37 | 38 | == Getting Started 39 | 40 | === The Easy Way 41 | 42 | [source] 43 | ---- 44 | (ns your.system 45 | (:require 46 | [com.stuartsierra.component :as cp] 47 | [untangled.server.core :as usc] 48 | [om.next.server :as oms])) 49 | 50 | (def your-server 51 | (usc/make-untangled-server 52 | :config-path "/your/config/path.edn" ;;<1> 53 | :components {:your-key (your-component)} ;;<2> 54 | :parser (oms/parser {:read your-read :mutate your-mutate}) ;;<3> 55 | :parser-injections #{:config :your-key})) ;;<4> 56 | 57 | (cp/start your-server) ;;<5> 58 | ---- 59 | <1> Optional path to a edn config file that will override any defaults found in `config/defaults.edn`. 60 | <2> A map for your components, eg: databases, custom networking, etc... 61 | <3> A parser to parse untangled-client (ie om.next) reads and mutates 62 | <4> A set of keywords corresponding to component keys that will be injected into the parser environment. 63 | `:config` is a special case that untangled-server always creates one of. 64 | <5> Simply start the returned system. This can be at the top level, or inside some other function that you control (eg: -main). 65 | 66 | === The Simple Way 67 | 68 | `untangled.server.core/untangled-system` is the recommended way to build untangled servers. + 69 | The basic concepts and differences between it and <> are as follows: 70 | 71 | // tag::untangled-system[] 72 | . It does less work and creates fewer implicit components behind the covers, + 73 | this so you (the user) have more control and flexibility over what your untangled-server does and provides. 74 | 75 | . You control your server, and if you are using ring with it, your own middleware stack. 76 | 77 | . Provides an api-handler with a ring middleware function that takes care of parsing requests from an untangled client. 78 | 79 | . You control the composition of parsing functions (reads and mutates) from any number of sources. + 80 | This is invaluable when trying to consume libraries that provide parser functions, + 81 | but must be injected into the api-handler in a very specific order (or just for performance reasons). + 82 | 83 | . `Module` s are what untangled-server calls the components that provide components, + 84 | and if they implement `APIHandler`, they also provide parser functions (`api-read` and `api-write`). 85 | 86 | . An `APIHandler` satisfying component should depend on any other components it needs for parsing, + 87 | as they will get put in its parsing environment. This obsoletes the old `:parser-injections` method + 88 | by superceding it with a dependency injection system that limits the injection to just that `APIHandler` component. 89 | 90 | . You control where the api-handler gets located in the returned system. + 91 | For example, you would use this to extract the api-handler (which parses reads and mutations from a request) into a java servlet. 92 | 93 | The following examples all rely on these requires: 94 | [source] 95 | ---- 96 | (ns your.system 97 | (:require 98 | [com.stuartsierra.component :as cp] 99 | [untangled.server.core :as usc] 100 | [untangled.server.impl.middleware :as mid])) 101 | ---- 102 | 103 | === Defining Your Own Middleware 104 | 105 | [source] 106 | ---- 107 | (defn MIDDLEWARE [handler component] <5> 108 | ((get component :middleware) handler)) 109 | 110 | (defrecord YourRingHandler [api-handler] 111 | cp/Lifecycle 112 | (start [this] 113 | (assoc this :middleware ;;<2> 114 | (-> (fn [req] {:status 404}) ;;<3><4> 115 | #_... 116 | (MIDDLEWARE api-handler) ;;<6> 117 | (mid/wrap-transit-params) ;;<7> 118 | (mid/wrap-transit-response) ;;<7> 119 | #_...))) 120 | (stop [this] (dissoc this :middleware))) 121 | 122 | (defn make-your-ring-handler [api-handler-key] 123 | (cp/using (->YourRingHandler) {:api-handler api-handler-key}) ;;<1> 124 | ---- 125 | <1> Depend on the api-handler as `api-handler`. 126 | <2> Assoc a middleware function under `:middleware`. 127 | <3> A middleware function takes a request and returns a response. 128 | <4> A simple not-found handler for showing the signature of the middleware. 129 | <5> A small utility function for being able to compose middleware components in a threading arrow. 130 | <6> Install the api-handler middleware into the location of choosing. 131 | <7> Add the transit middleware for encoding/decoding parameters and responses. 132 | 133 | WARNING: The transit middleware is required when dealing with an untangled-client with the default transit based networking. 134 | 135 | === Defining Your System 136 | 137 | [source] 138 | ---- 139 | (def your-server 140 | (usc/untangled-system 141 | {:api-handler-key ::your-api-handler-key ;;<1> 142 | :components {:config (usc/new-config) ;;<2> 143 | :server (usc/make-web-server ::handler) ;;<3> 144 | ::handler (make-your-ring-handler ::your-api-handler-key)}})) ;;<4> 145 | 146 | ;; EXAMPLE USAGE 147 | (cp/start your-server) ;;<5> 148 | 149 | (.start some-java-servlet (::your-api-handler-key (cp/start your-server))) ;;<5> 150 | ---- 151 | <1> You can redifine where the api-handler is located, defaults to `::usc/api-handler` 152 | <2> You are responsible for creating whatever config you need. 153 | <3> The web-server we provide takes an optional keyword that points to the handler component key it should depend on and look inside of for a `:middleware` fn. 154 | <4> We create a ring handler as described earlier with the api-handler-key as a dependency. 155 | <5> You can just start the system, or embed it in some other container that deals with serving requests, eg: some java servlet. 156 | 157 | === Defining A Module & APIHandler 158 | 159 | [source] 160 | ---- 161 | (defrecord YourApiModule [] 162 | usc/Module 163 | (system-key [this] ::YourApiModule) ;;<2> 164 | (components [this] {#_..sub-components..}) ;;<3> 165 | usc/APIHandler 166 | (api-read [this] 167 | (fn [{:as env :keys [db]} k params] #_...)) ;;<4><5> 168 | (api-mutate [this] 169 | (fn [{:as env :keys [db]} k params] #_...)) ;;<4><5> 170 | (defn make-your-api-module [] 171 | (cp/using (->YourApiModule) [:db #_..sub-components..])) ;;<3><5> 172 | 173 | (def your-server 174 | (usc/untangled-system 175 | {:components {#_...} 176 | :modules [(make-your-api-module) #_...]})) ;;<1> 177 | ---- 178 | <1> You can have any number of modules, they compose left to right (ie: they are tried in that order). 179 | <2> Modules must have a unique `system-key`. 180 | <3> Modules can also have uniquely named sub `components`, but must at minimum be implemented to return `nil` or `{}`. 181 | <4> Modules that implement `usc/APIHandler` must implement both `api-read` and `api-mutate` to return an appropriate parser function. 182 | These functions can however return nil at any time to indicate to the api parsing plumbing that it does not know how to respond, and that the next module should attempt to respond. 183 | <5> To use a component in your parser environments (`env`), make the component depend on it using `cp/using`. 184 | 185 | //end::untangled-system[] 186 | == Learn more 187 | * about link:docs/index.adoc#untangled-server-docs[Untangled Server] 188 | * about link:http://untangled-web.github.io/untangled/index.html[Untangled] & checkout the link:http://untangled-web.github.io/untangled/index.html[Documentation Reference] 189 | * interactively with the link:http://untangled-web.github.io/untangled/tutorial.html[Untangled Tutorial] 190 | ** http://untangled-web.github.io/untangled/tutorial.html#!/untangled_tutorial.I_Building_A_Server[I_Building_A_Server] 191 | 192 | == License 193 | 194 | The MIT License (MIT) Copyright © 2016 NAVIS 195 | -------------------------------------------------------------------------------- /docs/index.adoc: -------------------------------------------------------------------------------- 1 | = Untangled Server Docs 2 | :source-highlighter: coderay 3 | :source-language: clojure 4 | :toc: 5 | :toc-placement!: 6 | :toclevels: 3 7 | :sectlinks: 8 | :sectanchors: 9 | :sectnums: 10 | 11 | ifdef::env-github[] 12 | :tip-caption: :bulb: 13 | :note-caption: :information_source: 14 | :important-caption: :heavy_exclamation_mark: 15 | :caution-caption: :fire: 16 | :warning-caption: :warning: 17 | endif::[] 18 | 19 | ifdef::env-github[] 20 | toc::[] 21 | endif::[] 22 | 23 | == Fetching Data From the Server 24 | 25 | There are a number of convenient things that the network stack does automatically, as shown in the 26 | diagram below: 27 | 28 | [ditaa,target=plumbing] 29 | .... 30 | /-----\ /-----\ 31 | |Query| strip ui |Queue| Network Request 32 | | |----------->| |---------------------------------------------------------->---+ 33 | \-----/ \-----/ | 34 | /------\ 35 | |API | 36 | | | 37 | /-----\ /-----\ /-----\ Mark \------/ 38 | |App | post mutation |App | Sweep/remap|App | Missing + Merge Network Response | 39 | |State|<---------------|State|<-----------|State|<---------------------------------<----+ 40 | \-----/ \-----/ \-----/ 41 | .... 42 | 43 | Strip UI:: 44 | This stage removes any attributes in the query that are namespaced to `ui`. For example, `:ui/checked`. This 45 | allows you to place attributes on a UI component that use the app database for storage (and then query for them) while 46 | still being able to easily use that component's query as part of a server query. 47 | 48 | Queue:: 49 | All queries are placed on a queue, and are processed one-at-a-time. There is an option to do queries in parallel and 50 | bypass this queue. 51 | 52 | API:: 53 | This is the server-side API you write to process the query. 54 | 55 | Mark missing/Merge:: 56 | This is the first stage of the client response processing. During this phase the query and response are walked. If 57 | the response does not contain a value for an attribute that was in the query, then a special `:untangled.client.impl.om-plumbing/not-found` 58 | value is added to the incoming response. This composite value is then deep merged with the application state. This forces 59 | anything that has "disappeared" from the server to be marked as `:untangled.client.impl.om-plumbing/not-found` in the app database. 60 | 61 | Sweep:: 62 | This post-processing stage walks the app database and removes anything that has a value of `:untangled.client.impl.om-plumbing/not-found`. 63 | This is the second half of the mark/sweep of data that has disappeared from the server. 64 | 65 | Remap:: 66 | If the request was a mutation (instead of a query), then the response may contain tempid remaps. This step walks the 67 | app database replacing IDs that have been remapped. 68 | 69 | Post Mutation:: 70 | The client API for network queries allows for a user-defined post mutation to run at the end of the chain. This is 71 | used to create or update alternate UI views of the recently loaded data, if necessary. 72 | 73 | === Loading Data During Initialization 74 | 75 | When an Untangled Application is mounted, it will render the application using initial application state as described 76 | in the http://untangled-web.github.io/untangled/reference/reference.html#_initial_application_state[Initial Application State section]. 77 | The first opportunity for an Untangled app to load data from a remote server is in the function defined under the 78 | `:started-callback` parameter when making a new untangled client: 79 | 80 | [source] 81 | ---- 82 | (:require 83 | [untangled.client.core :as uc] 84 | [untangled.client.data-fetch :as df]) 85 | 86 | (uc/new-untangled-client 87 | :started-callback (fn [reconciler] 88 | (df/load-data reconciler [:some {:query [:on-app-load]}]))) 89 | ---- 90 | 91 | One or more calls to `untangled.client.data-fetch/load-data` can be used to queue up initial reads from your server, and each of those 92 | loads can specify `:parallel true` to indicate that the loads are not order dependent (if that is indeed true). 93 | You may also choose to hit an external API on app load and manually merge data into the app-state by calling 94 | `(om/app-state reconciler)` to get the app-state atom. 95 | 96 | NOTE: A re-render is *not* scheduled after the started-callback is run. If you decide to manually change the app-state 97 | atom in the started-callback, you must schedule your own re-render of the root component. Data fetches are standard 98 | transactions, and will take care of scheduling their own re-renders. 99 | 100 | === Loading Data On Demand 101 | 102 | Any event (timeout, user interaction, etc) can be used to trigger additional loads. The typical calls used for this 103 | are `untangled.client.data-fetch/load-data` and `untangled.client.data-fetch/load-field`. The former is completely general 104 | and allows for an arbitrary query. The latter is component-centric, and can be used to auto-construct a server query 105 | based on the component's ident, fields, and sub-queries. 106 | 107 | There are a number of examples in the 108 | https://github.com/untangled-web/untangled-cookbook[Untangled Cookbook]. 109 | 110 | WARNING: Due to the various circumstances under which React Lifecycle methods are called, we do not recommend that data 111 | fetches are executed within the body of overridden Lifecycle methods in your Om components. Your network traffic may be 112 | higher tha necessary if Lifecycle methods are triggered multiple times. Data fetches trigger also trigger a re-render 113 | cycle, which could potentially put your application into an infinite loop of loading and re-rendering. 114 | 115 | === Server reads (after mutation) 116 | 117 | If you execute a mutation that does not optimistically update the client before executing on the server, then the 118 | server will have updated information that needs to make its way back to the client. 119 | 120 | However, *server mutations in Untangled do not have return values*. 121 | 122 | The Om model is that mutations can only remap tempids, and will never return newly created data. Even if mutations did 123 | have return values, they do not contain a query that the client could use to properly merge the server's data into the 124 | client-side database. 125 | 126 | When the client is displaying data and runs a mutation that will modify that data, there are two possible execution paths: 127 | 128 | 1. Update the client-side database first (optimistically), and then send the mutation to run on the server. 129 | 2. Send the mutation directly to the server, followed immediately by a remote read to obtain the new data. 130 | 131 | The Untangled design patterns favor the first execution path over the second, however, both are supported. The first 132 | execution path is made possible by specifying both a `:remote` keyword and an `:action` keyword in the map returned 133 | by your mutation, which follow standard Om patterns: 134 | 135 | [source] 136 | ---- 137 | (:require 138 | [untangled.client.mutations :refer [mutate]]) 139 | 140 | (defmutation mutate 'person/add-friend [env k params] 141 | {:remote true 142 | :action (fn [] 143 | ;; code to optimistically add friend of `friend-id` 144 | ;; to the person `person-id` in the client-side database 145 | )}) 146 | 147 | ---- 148 | 149 | You can utilize the second execution path by adding a server read to a transaction that also contains a mutation. 150 | In this case the mutations and reads will be split, the mutations will run, then the reads will run (ordered using the 151 | network queue). Server reads take the form of an `untangled/load` built-in client mutation, including all of the 152 | parameters supported by a call to `load-data`: 153 | 154 | [source] 155 | ---- 156 | (:require 157 | [om.next :as om] 158 | [untangled.client.mutations]) 159 | 160 | (om/transact! component '[(app/remote-action) 161 | (untangled/load {:query [:data-changed-by-remote-action] 162 | :post-mutation data/modify-server-response 163 | :fallback app/handle-failures})]) 164 | ---- 165 | 166 | For a walkthrough of this remote mutation and load execution path, see the getting started video about 167 | https://youtu.be/t49JYB27fv8?list=PLVi9lDx-4C_T_gsmBQ_2gztvk6h_Usw6R&t=1535[server basics at roughly 25:20] 168 | 169 | === Loading markers 170 | 171 | When an item reaches the tip of networking queue and is pulled off Untangled will replace the data being loaded with a 172 | marker that the UI can use to show an alternate representation (e.g. a spinner in place of a table). There 173 | is also a global loading marker at the top of the application state. 174 | 175 | To access the global loading marker, add `[:ui/loading-data '_]` to the query of any component that composes to root. 176 | This will put a boolean flag in that component's props indicating if there is some some data fetch occurring at the 177 | moment that the component is rendered. 178 | 179 | The `:ui/loading-data` keyword is set to true when *any load* is occurring. If you want to be sure that a particular 180 | piece of data is being loaded at a given moment, then you will want to access the data fetch state on that field: 181 | 182 | [source] 183 | ---- 184 | (:require 185 | [om.next :as om] 186 | [om.dom :as dom]) 187 | 188 | (defui Item 189 | static om/IQuery (query [this] [:id :title :ui/fetch-state]) 190 | ;; note that the *subcomponent* queries for :ui/fetch-state 191 | ;; ... 192 | Object 193 | (render [this] 194 | ;; render an item 195 | )) 196 | 197 | (def ui-item (om/factory Item {:keyfn :id})) 198 | 199 | (defui ItemList 200 | static om/IQuery (query [this] [{:items (om/get-query Item)}]) 201 | ;; ... 202 | Object 203 | (render [this] 204 | (let [{:keys [items]} (om/props this)] 205 | (if (:ui/fetch-state items) 206 | (dom/div nil "Loading...") 207 | (dom/div nil (map ui-item items)))))) 208 | 209 | ---- 210 | 211 | In this case, we might be loading items in the `ItemList` component, and we might not. If we are, then we can tell 212 | that the field `:items` is being loaded because the map at the `:items` key in props has a `:ui/fetch-state` key. 213 | If it did not, then we know that there is data available to be rendered (even if that data is `nil`). 214 | 215 | Take a look at `untangled.client.data-fetch/lazily-loaded`, which handles the conditional logic in the render-method 216 | above for you, and offers several enhancements. 217 | 218 | If you do not want markers to wipe out the existing data on the client when reloading that data, you may specify the `:marker` 219 | parameter as `false` in your calls to any of the data fetch methods. 220 | 221 | Loading markers are covered in more depth in this https://youtu.be/t49JYB27fv8[getting started video] 222 | and the https://github.com/untangled-web/untangled-cookbook/tree/master/recipes/lazy-loading-visual-indicators[Untangled 223 | Cookbook recipe about lazy loading visual indicators]. 224 | 225 | === Out-of-band Data (websocket, timeout, XHR) 226 | 227 | When using things like websocket server push, timeouts, and manual XHR requests you may have data that you'd like to 228 | place in your application's state that does not arrive through the normal Untangled processing pipeline. In these cases 229 | you may use Om's `merge!` function or Untangled's `merge-state!`. The latter does a bit of common work for you if you 230 | can structure the data in a way that looks like the response to an existing query of a UI component with an ident. 231 | 232 | Basically, you structure the data to be a tree of maps that could exist in the database for a given component (and 233 | children). The `merge-state!` function will extract the ident from that data, normalize the tree into objects, and 234 | merge everything into tables. 235 | 236 | Any number of named parameters can be given at the same time to add that object's ident to other locations in the 237 | database. 238 | 239 | See the docstring of `merge-state!` and `integrate-ident!` in the `untangled.client.core` namespace. 240 | 241 | === Handling network errors 242 | 243 | There are several different kinds of errors that can happen when working with a full-stack application: 244 | 245 | - Hard network errors (e.g. lost WiFi, server crashed) 246 | - Unexpected server errors (code threw an unexpected exception) 247 | - API errors (client made a bad request, server state is out of sync with client, etc.) 248 | 249 | Untangled gives you a few mechanisms for dealing with full-stack errors: 250 | 251 | - A global handler that can be set when you create a client (see `:network-error-callback` in `new-untangled-client`). This 252 | is only available if you use the default network implementation. This function will also be called on server 253 | exceptions, since the default server implementation sends back a hard error. 254 | - Fallbacks: A fallback is a placeholder in mutations that is called if the mutation transaction fails. It can modify 255 | the app state in any way it sees fit to represent the handling of the error (e.g. change UI state to show an error 256 | dialog, reload the page, etc.). 257 | 258 | For a more in depth explanation of handling server errors please see the 259 | https://github.com/untangled-web/untangled-cookbook/tree/master/recipes/error-handling#error-handling[Error Handling Recipe] 260 | 261 | == Returning Data to the Client 262 | 263 | === Implementing server queries 264 | 265 | The server-side queries come in a the full EDN send from the client. The Untangled Server code automatically decodes 266 | this query and passes it to an Om parser that you define. The basics of processing these queries are covered in the 267 | https://github.com/untangled-web/untangled-tutorial[tutorial]. 268 | 269 | The primary thing to remember is that server query processing functions (which run inside of a parser) 270 | should return a map whose only key is `:value` and whose value is the value for that query attribute/fragment. 271 | 272 | === Implementing server mutations 273 | 274 | Server mutations are coded exactly like client mutations, but their body does whatever server-side operations you care 275 | to do (instead of mutating a client-focused UI database). 276 | 277 | There are a few things to understand when implementing a mutation: 278 | 279 | - You must return a map whose main key is `:action` and whose value is a function that will accomplish the change 280 | - The function should return a map. If any data came into the mutation from the client as a temporary ID, then 281 | the map should contain the key `:tempids` whose value is a map from the incoming tempid to the newly assigned 282 | permanent ID. You may optionally add a `:keys` entry whose value is a list of the attributes where data changed. 283 | Untangled will not do anything with the `:keys` entry, but you may choose to use it for documentation of what 284 | entities changed during the server mutation. 285 | 286 | == Building your own components 287 | 288 | When creating an untangled server, it is often desirable to create 289 | custom app specific https://github.com/stuartsierra/component[Stuart Sierra Components]. + 290 | `make-untangled-server` takes a `:component` map keyed by component name with the components as values. 291 | 292 | [source] 293 | ---- 294 | (:require 295 | [com.stuartsierra.component :as component] 296 | [om.next.server :as oms]) 297 | 298 | (defrecord MyComp [name] 299 | component/Lifecycle ;;<5> 300 | (start [this] ...) 301 | (stop [this] ...)) 302 | (defn build-my-comp [name] 303 | (component/using ;;<4> 304 | (map->MyDatabase {:name name}) 305 | [:config])) 306 | 307 | (make-untangled-server 308 | :parser-injections #{:config :database} ;;<1> 309 | :components {:database ;;<2> 310 | (build-my-comp "Best Component")} ;;<3> 311 | :parser (oms/parser {:read api-read :mutate api-mutate})) ;;<6> 312 | 313 | (defn api-read [{:as env :keys [config]} k params] ...) ;;<6> 314 | (defn api-mutate [{:as env :keys [config]} k params] ...) ;;<6> 315 | ---- 316 | <1> Injects the named components into your parser environment for access during reads and mutations. 317 | <2> Name of the component, for parser injections. 318 | <3> The Component itself. 319 | <4> The component can be wrapped with `component/using` for dependency injection. 320 | <5> Should implement `component/Lifecycle`. 321 | <6> `:database` is now available in the parser env, ie: the first argument to api-read and api-mutate. 322 | 323 | [NOTE] 324 | ==== 325 | The components `:config`, `:handler`, and `:server` are always available. + 326 | To make them available you *must* include them in either your: 327 | 328 | - `:parser-injections` 329 | - component depenencies, eg: `(component/using MyComp dependencies)` 330 | ==== 331 | 332 | == Ring Handler Injection (Easy) 333 | 334 | There are two locations in untangled-server's pre-built handler stack, https://github.com/untangled-web/untangled-server/blob/8dba26aafe36a5f0dab36d0dc89a98f43212df1d/src/untangled/server/impl/components/handler.clj#L176[pre-hook] and https://github.com/untangled-web/untangled-server/blob/8dba26aafe36a5f0dab36d0dc89a98f43212df1d/src/untangled/server/impl/components/handler.clj#L170[fallback-hook], that are made publically accessible. 335 | The first step is to create a component that depends (`component/using`) on the `:handler`, and then on start to get and set the desired hook. 336 | [source] 337 | ---- 338 | (:require 339 | [com.stuartsierra.component :as component] 340 | [untangled.server.impl.components.handler :as h]) 341 | 342 | (defrecord Hooks [handler] 343 | component/Lifecycle 344 | (start [this] 345 | (let [pre-hook (h/get-pre-hook handler)] 346 | (h/set-pre-hook! handler 347 | (comp 348 | ... your-wrap-handlers-here ... 349 | pre-hook 350 | ...or-here...))))) 351 | (defn build-hooks [] 352 | (component/using 353 | (map->Hooks {}) 354 | [:handler])) 355 | ---- 356 | 357 | An alternative to injecting middleware into the global stack is to wrap the function/component that uses that middleware with that handler directly. Here's an example: 358 | [source] 359 | ---- 360 | (defn wrap-with-user [handler] ;;<1> 361 | (fn [req] (assoc req :user ...get-user...))) ;;<2> 362 | (defn authorize-request! [req] ;;<3> 363 | ((-> (fn [req] ...assert-authorized...) ;;<4> 364 | wrap-with-user 365 | ...more handlers...) 366 | req)) ;;<5> 367 | ---- 368 | <1> Can be your own or from a library (eg: `ring.middleware.*`) 369 | <2> Takes a handler, and returns a fn that takes a req and returns a response 370 | <3> Can be a function, a component, a whatever, so long as it can take request 371 | <4> Wrap/thread your original function into the handlers 372 | <6> DON'T forget to pass the resulting composition of handlers the request 373 | 374 | == API Routes (Easy) 375 | 376 | Simply add an `:extra-routes` map to `make-untangled-server` with keys `:routes` and `:handlers`. 377 | 378 | * `:routes` contains a https://github.com/juxt/bidi[bidi] mapping from url route to a key in the `:handlers` map. 379 | * `:handlers` is a mapping from handler key (from `:routes`) to a function `(fn [env match] ... res)`. 380 | 381 | Eg: 382 | [source] 383 | ---- 384 | (:require 385 | [untangled.server.core :refer [make-untangled-server]) 386 | 387 | (make-untangled-server 388 | :extra-routes 389 | {:routes ["" {"/store-file" :store-file}] 390 | :handlers {:store-file (fn [env match] (store-file (:db env) (get-in env [:request :body]))))}) 391 | ---- 392 | 393 | == Untangled System (Simple) 394 | 395 | `untangled.server.core/untangled-system` is the recommended way to build untangled servers. + 396 | The advantages to the "(Easy)" way are as follows: 397 | 398 | include::../README.adoc[tag=untangled-system] 399 | 400 | == Configuration 401 | 402 | === Abstract 403 | Configuration for your application is about tweaking the behavior of your program statically before it even runs. 404 | Traditionally configuration is an formed by aggregating a plethera of sources, however, untangled holds that constraining you to one file and some sane defaults, leads to more a maintanable and debuggable system. 405 | 406 | Untangled configuration is done by reading two *edn* files, a `config/defaults.edn` and one specified by you when creating an untangled-server. 407 | It then does a deep merging of the two files, where the defaults are always overriden if specified in the other file. 408 | 409 | [TIP] 410 | ==== 411 | You can inject config into your parser environment by putting it in your `:parser-injections`, or in your component by using `component/using`. 412 | [source] 413 | ---- 414 | (:require 415 | [com.stuartsierra.component :as component] 416 | [untangled.server.core :refer [make-untangled-server]) 417 | 418 | (make-untangled-server 419 | :parser-injections #{:config}) 420 | 421 | (component/using 422 | (map->MyComponent {}) 423 | [:config]) 424 | ---- 425 | See <> for more detail on parser injections. 426 | ==== 427 | 428 | === Default values 429 | Your application must have a `config/defaults.edn` available in your `:resource-paths`, 430 | and it must be a map containing safe default values for your application. + 431 | An example of a "safe" default is not auto migrating or dropping tables on startup. 432 | [source] 433 | ---- 434 | {:datomic 435 | {:dbs 436 | {:your-db 437 | {:uri "..." 438 | :auto-migrate false 439 | :auto-drop false} 440 | ---- 441 | 442 | The values in your `defaults.edn` file are deep merged underneath the file you specify in <>. 443 | [source] 444 | .for example 445 | ---- 446 | ;;defaults.edn 447 | {:override {:me 13} 448 | :keep :me} 449 | 450 | ;;myconfig.edn 451 | {:override {:me 42 452 | :seven 7} 453 | :hello "world"} 454 | 455 | ;;results in => 456 | {:override {:me 42 457 | :seven 7} 458 | :hello "world" 459 | :keep :me} 460 | ---- 461 | 462 | === Specifying a config file 463 | Simply pass `make-untangled-server` a `:config-path`. 464 | [WARNING] 465 | ==== 466 | - If it begins with a slash "/" => it should be an absolute path. 467 | - If it doesn't => it should be on your classpath, eg: your `resources` folder. 468 | ==== 469 | 470 | ==== Configurable config path 471 | An useful pattern to follow is to parameterize the `:config-path` passed to `make-untangled-server`. + 472 | This lets you use different config paths when developing in the repl, but keep a single production configuration path. 473 | [source] 474 | .src/yourapp/system.clj 475 | ---- 476 | (:require 477 | [untangled.server.core :refer [make-untangled-server]) 478 | 479 | (defn make-system [cfg-path] 480 | (make-untangled-server 481 | :config-path cfg-path)) 482 | ---- 483 | [source] 484 | .dev/server/user.clj (see: https://github.com/stuartsierra/component#reloading[here] for more info) 485 | ---- 486 | ;;development 487 | (:require 488 | [my.app.system :refer [make-system]]) 489 | 490 | (def config-paths 491 | {:dev "config/dev.edn" 492 | :secure "config/secure.edn"}) 493 | (defn init [path] 494 | (make-system (get config-paths path))) 495 | ---- 496 | [source] 497 | .src/yourapp/core.clj (see: http://clojure.org/reference/compilation#_gen_class_examples[here] for info on -main) 498 | ---- 499 | ;;production 500 | (:require 501 | [com.stuartsierra.component :as component] 502 | [untangled.server.core :refer [make-untangled-server]) 503 | 504 | (defn -main [& args] 505 | (component/start (make-system "/usr/local/etc/my_app.edn"))) 506 | ---- 507 | 508 | ==== Production override 509 | In production builds however it is convenient to be able to point to switch between configs at run time. + 510 | So when running your server you can specify the path of the config file using the `-Dconfig=...` config system property. 511 | 512 | TIP: Options come before the jar + 513 | `java [-options] -jar jarfile [args...]`. 514 | 515 | WARNING: Use this option sparingly and as needed, as you should be relying on the previously described methods first. 516 | 517 | === Environmental Variables 518 | It is often convenient & useful to be able to reference environmental variables, so we provide a way to access env vars from your config file as follows: 519 | 520 | - `:env/PORT` => "8080" 521 | - `:env.edn/PORT` => 8080 522 | 523 | [WARNING] 524 | ==== 525 | Note the subtle distinction between the two. 526 | 527 | - `+++:env/*+++` will read the env var as a *string*. 528 | - `+++:env.edn/*+++` will read it as *edn* using `clojure.edn/read-string`. 529 | ==== 530 | 531 | === Extending or replacing the config component 532 | If you find yourself wanting to replace the built-in configuration component & semantics, you can simply specify in the `:components` map of `make-untangled-server` a `:config` component. 533 | [WARNING] 534 | ==== 535 | The new config component must satisfy two criteria: 536 | 537 | - Must implement `component/Lifecycle`. 538 | - Should place the loaded configuration in itself under `:value`. 539 | ==== 540 | 541 | [source] 542 | .a naive but simple example 543 | ---- 544 | (:require 545 | [untangled.server.core :refer [make-untangled-server]] 546 | [com.stuartsierra.component :as component] 547 | [clojure.java.io :as io]) 548 | 549 | (defrecord MyConfig [value] 550 | component/Lifecycle 551 | (start [this] 552 | (->> (System/getproperty "config") 553 | io/resource 554 | slurp 555 | read-string 556 | (hash-map :value))) 557 | (stop [this] this)) 558 | (make-untangled-server 559 | :components {:config (->MyConfig)}) 560 | ---- 561 | -------------------------------------------------------------------------------- /env/dev/user.clj: -------------------------------------------------------------------------------- 1 | (ns user 2 | (:require 3 | [clojure.java.io :as io] 4 | [clojure.pprint :refer (pprint)] 5 | [clojure.stacktrace :refer (print-stack-trace)] 6 | [clojure.tools.namespace.repl :refer [disable-reload! refresh clear]] 7 | [clojure.repl :refer [doc source]] 8 | [clojure.test :refer [run-tests]] 9 | untangled.server.impl.components.config-spec 10 | )) 11 | 12 | #_(defn run-all-tests [] 13 | (report/with-untangled-output 14 | (run-tests 15 | 'untangled.server.impl.components.config-spec))) 16 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject navis/untangled-server "0.7.1-SNAPSHOT" 2 | :description "Library for creating Untangled web servers" 3 | :url "" 4 | :license {:name "MIT" 5 | :url "https://opensource.org/licenses/MIT"} 6 | :dependencies [[org.clojure/clojure "1.9.0-alpha14" :scope "provided"] 7 | [org.clojure/math.combinatorics "0.1.1"] 8 | [org.clojure/tools.namespace "0.2.10"] 9 | [org.omcljs/om "1.0.0-alpha48"] 10 | [http-kit "2.1.19"] 11 | [bidi "2.0.12"] 12 | [ring/ring-defaults "0.1.5"] 13 | [bk/ring-gzip "0.1.1"] 14 | [com.stuartsierra/component "0.3.1"] 15 | [com.taoensso/timbre "4.3.1"] 16 | [org.clojure/java.classpath "0.2.2"] 17 | [org.bouncycastle/bcpkix-jdk15on "1.54"] 18 | [navis/untangled-spec "0.3.6" :scope "test" :exclusions [org.clojure/google-closure-library-third-party org.clojure/google-closure-library io.aviso/pretty org.clojure/clojurescript]] 19 | [navis/untangled-datomic "0.4.4" :scope "test"] 20 | [commons-codec "1.10"] 21 | [com.datomic/datomic-free "0.9.5206" :scope "test" :exclusions [joda-time]] ] 22 | 23 | :plugins [[com.jakemccrary/lein-test-refresh "0.17.0"]] 24 | 25 | :source-paths ["src"] 26 | :test-paths ["specs" "specs/config"] 27 | :resource-paths ["src" "resources"] 28 | 29 | :jvm-opts ["-server" "-Xmx1024m" "-Xms512m" "-XX:-OmitStackTraceInFastThrow"] 30 | 31 | :test-refresh {:report untangled-spec.reporters.terminal/untangled-report 32 | :with-repl true 33 | :changes-only true} 34 | 35 | :test-selectors {:focused :focused} 36 | 37 | :profiles {:dev {:source-paths ["env/dev"] 38 | :repl-options {:init-ns user}}}) 39 | -------------------------------------------------------------------------------- /specs/config/defaults.edn: -------------------------------------------------------------------------------- 1 | {} 2 | -------------------------------------------------------------------------------- /specs/config/test.edn: -------------------------------------------------------------------------------- 1 | {:datomic {:dbs {:protocol-support {:url "datomic:mem://protocol-support" 2 | :schema "migrations" 3 | :auto-migrate true 4 | :auto-drop true} 5 | :protocol-support-2 {:url "datomic:mem://protocol-support-2" 6 | :schema "migrations" 7 | :auto-migrate true 8 | :auto-drop true} 9 | :protocol-support-3 {:url "datomic:mem://protocol-support-3" 10 | :schema "migrations" 11 | :auto-migrate true 12 | :auto-drop true}}}} 13 | -------------------------------------------------------------------------------- /specs/migrations/protocol_support_20160125.clj: -------------------------------------------------------------------------------- 1 | (ns migrations.protocol-support-20160125 2 | (:require [untangled.datomic.schema :as schema] 3 | [datomic.api :as d])) 4 | 5 | (defn transactions [] 6 | [(schema/generate-schema 7 | [(schema/schema old-one 8 | (schema/fields 9 | [name :string] 10 | [madness :double] 11 | [followers :ref :many] 12 | )) 13 | (schema/schema follower 14 | (schema/fields 15 | [name :string] 16 | [devotion :double] 17 | )) 18 | ])]) 19 | -------------------------------------------------------------------------------- /specs/resources/config/defaults.edn: -------------------------------------------------------------------------------- 1 | { 2 | :some-key :some-default-val 3 | } 4 | -------------------------------------------------------------------------------- /specs/untangled/server/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.core-spec 2 | (:require 3 | [clojure.test :as t] 4 | [com.stuartsierra.component :as component] 5 | [untangled.server.core :as core] 6 | [untangled-spec.core :refer [specification behavior provided component assertions]]) 7 | (:import (clojure.lang ExceptionInfo))) 8 | 9 | (specification "transitive join" 10 | (behavior "Creates a map a->c from a->b combined with b->c" 11 | (assertions 12 | (core/transitive-join {:a :b} {:b :c}) => {:a :c}))) 13 | 14 | (specification "make-untangled-server" 15 | (assertions 16 | "requires :parser as a parameter, and that parser be a function" 17 | (core/make-untangled-server) =throws=> (AssertionError #"") 18 | (core/make-untangled-server :parser 'cymbal) =throws=> (AssertionError #"") 19 | "requires that :components be a map" 20 | (core/make-untangled-server :parser #() :components [1 2 3]) =throws=> (AssertionError #"") 21 | "throws an exception if injections are not keywords" 22 | (core/make-untangled-server :parser #() :parser-injections [:a :x 'sym]) =throws=> (AssertionError #""))) 23 | 24 | (defrecord SimpleTestModule [] 25 | core/Module 26 | (system-key [this] ::SimpleTestModule) 27 | (components [this] {})) 28 | (defn make-simple-test-module [] 29 | (component/using 30 | (map->SimpleTestModule {}) 31 | [])) 32 | 33 | (defrecord DepTestModule [test-dep] 34 | core/Module 35 | (system-key [this] ::DepTestModule) 36 | (components [this] 37 | {:test-dep 38 | (or test-dep 39 | (reify 40 | component/Lifecycle 41 | (start [this] {:value "test-dep"}) 42 | (stop [this] this)))}) 43 | component/Lifecycle 44 | (start [this] (assoc this :value "DepTestModule")) 45 | (stop [this] this)) 46 | (defn make-dep-test-module [& [{:keys [test-dep]}]] 47 | (component/using 48 | (map->DepTestModule {:test-dep test-dep}) 49 | [:test-dep])) 50 | 51 | (defrecord TestApiModule [sys-key reads mutates cmps] 52 | core/Module 53 | (system-key [this] (or sys-key ::TestApiModule)) 54 | (components [this] (or cmps {})) 55 | core/APIHandler 56 | (api-read [this] 57 | (if-not reads (constantly {:value :read/ok}) 58 | (fn [env k ps] 59 | (when-let [value (get reads k)] 60 | {:value value})))) 61 | (api-mutate [this] 62 | (if-not mutates (constantly {:action (constantly :mutate/ok)}) 63 | (fn [env k ps] 64 | (when-let [value (get mutates k)] 65 | {:action (constantly value)}))))) 66 | (defn make-test-api-module [& [opts]] 67 | (map->TestApiModule 68 | (select-keys opts 69 | [:reads :mutates :sys-key :cmps]))) 70 | 71 | (defn test-untangled-system [opts] 72 | (component/start (core/untangled-system opts))) 73 | (specification "untangled-system" 74 | (component ":api-handler-key - defines location in the system of the api handler" 75 | (assertions 76 | (test-untangled-system {:api-handler-key ::here}) 77 | =fn=> (fn [sys] 78 | (t/is (fn? (get-in sys [::here :middleware]))) 79 | true) 80 | "defaults to :untangled.server.core/api-handler" 81 | (test-untangled-system {}) 82 | =fn=> (fn [sys] 83 | (t/is (fn? (get-in sys [::core/api-handler :middleware]))) 84 | true))) 85 | (component ":app-name - prefixes the /api route" 86 | (assertions 87 | (-> (test-untangled-system {:app-name "asdf"}) 88 | ::core/api-handler :middleware 89 | (#(% (constantly {:status 404})))) 90 | =fn=> (fn [h] 91 | (t/is (= {:status 404} (h {:uri "/api"}))) 92 | (t/is (= 200 (:status (h {:uri "/asdf/api"})))) 93 | true))) 94 | (component ":components" 95 | (behavior "get put into the system as is" 96 | (assertions 97 | (test-untangled-system 98 | {:components {:c1 (reify 99 | component/Lifecycle 100 | (start [this] {:value "c1"}) 101 | (stop [this] this)) 102 | :c2 {:test "c2"}}}) 103 | =fn=> (fn [sys] 104 | (t/is (= #{::core/api-handler :c1 :c2} (set (keys sys)))) 105 | (t/is (not-any? nil? (vals sys))) 106 | true)))) 107 | (component ":modules - implement:" 108 | (component "Module (required)" 109 | (component "system-key" 110 | (assertions "is used to locate them in the system" 111 | (test-untangled-system 112 | {:modules [(make-simple-test-module)]}) 113 | =fn=> (fn [sys] 114 | (t/is (not (nil? (get-in sys [::SimpleTestModule])))) 115 | true))) 116 | (component "components" 117 | (assertions 118 | (core/components (make-dep-test-module)) =fn=> :test-dep 119 | "are sub components raised into the system" 120 | (test-untangled-system 121 | {:modules [(make-dep-test-module)]}) 122 | =fn=> (fn [sys] 123 | (t/is (= "DepTestModule" (get-in sys [::DepTestModule :value]))) 124 | (t/is (= (get-in sys [::DepTestModule :test-dep]) 125 | (get-in sys [:test-dep]))) 126 | true) 127 | "they can have their own deps" 128 | (test-untangled-system 129 | {:modules [(make-dep-test-module 130 | {:test-dep (component/using {:test-dep "yeah"} [:dep2])})] 131 | :components {:dep2 {:value "dep2"}}}) 132 | =fn=> (fn [sys] 133 | (t/is (= (get-in sys [::DepTestModule :test-dep :dep2]) 134 | (get-in sys [:dep2]))) 135 | true)))) 136 | (component "APIHandler (optional)" 137 | (behavior "is used to compose reads&mutates like (ring) middleware" 138 | (assertions 139 | (((get-in 140 | (test-untangled-system 141 | {:modules [(make-test-api-module)]}) 142 | [::core/api-handler :middleware]) 143 | (constantly {:status 404})) 144 | {:uri "/api" 145 | :transit-params '[(launch-rocket!) :rocket-status]}) 146 | => {:status 200 147 | :headers {"Content-Type" "application/transit+json"} 148 | :body {'launch-rocket! :mutate/ok 149 | :rocket-status :read/ok}} 150 | "get executed in the order of :modules, you should return nil if you do not handle the dispatch-key" 151 | (((get-in 152 | (test-untangled-system 153 | {:modules [(make-test-api-module 154 | {:sys-key :always-working 155 | :reads {:rocket-status :working 156 | :working :working/true}}) 157 | (make-test-api-module 158 | {:sys-key :always-broken 159 | :reads {:rocket-status :broken 160 | :broken :broken/true}})]}) 161 | [::core/api-handler :middleware]) 162 | (constantly {:status 404})) 163 | {:uri "/api" 164 | :transit-params '[:rocket-status :working :broken]}) 165 | => {:status 200 166 | :headers {"Content-Type" "application/transit+json"} 167 | :body {:rocket-status :working 168 | :working :working/true 169 | :broken :broken/true}})))) 170 | (behavior "all system keys must be unique, (Module/system-key and Module/components keys)" 171 | (assertions 172 | (core/untangled-system {:components {:foo {}} 173 | :modules [(make-test-api-module 174 | {:sys-key :foo})]}) 175 | =throws=> (ExceptionInfo #"(?i)duplicate.*:foo.*untangled-system") 176 | (core/untangled-system {:components {:foo {}} 177 | :modules [(make-test-api-module 178 | {:cmps {:foo "test-api"}})]}) 179 | =throws=> (ExceptionInfo #"(?i)duplicate.*:foo.*untangled-system" 180 | #(do (t/is 181 | (= (ex-data %) {:key :foo :prev-value {} :new-value "test-api"})) 182 | true)) 183 | (core/untangled-system {:modules [(make-test-api-module 184 | {:sys-key :foo}) 185 | (make-test-api-module 186 | {:sys-key :foo})]}) 187 | =throws=> (ExceptionInfo #"(?i)duplicate.*:foo.*Module/system-key") 188 | (core/untangled-system {:modules [(make-test-api-module 189 | {:sys-key :foo1 190 | :cmps {:foo "foo1"}}) 191 | (make-test-api-module 192 | {:sys-key :foo2 193 | :cmps {:foo "foo2"}})]}) 194 | =throws=> (ExceptionInfo #"(?i)duplicate.*:foo.*Module/components")))) 195 | -------------------------------------------------------------------------------- /specs/untangled/server/impl/components/config_spec.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.impl.components.config-spec 2 | (:require [com.stuartsierra.component :as component] 3 | [untangled.server.impl.components.config :as cfg] 4 | [untangled.server.core :refer [new-config raw-config]] 5 | [untangled-spec.core :refer 6 | [specification component behavior assertions when-mocking provided]] 7 | [clojure.test :as t] 8 | [taoensso.timbre :as timbre]) 9 | (:import (java.io File) 10 | (clojure.lang ExceptionInfo))) 11 | 12 | (t/use-fixtures 13 | :once #(timbre/with-merged-config 14 | {:ns-blacklist ["untangled.server.impl.components.config"]} 15 | (%))) 16 | 17 | (defn with-tmp-edn-file 18 | "Creates a temporary edn file with stringified `contents`, 19 | calls `f` with its absolute path, 20 | and returns the result after deleting the file." 21 | [contents f] 22 | (let [tmp-file (File/createTempFile "tmp-file" ".edn") 23 | _ (spit tmp-file (str contents)) 24 | abs-path (.getAbsolutePath tmp-file) 25 | res (f abs-path)] 26 | (.delete tmp-file) res)) 27 | 28 | (def defaults-path "config/defaults.edn") 29 | 30 | (specification "untangled.config" 31 | (when-mocking 32 | (cfg/get-defaults defaults-path) => {} 33 | (cfg/get-system-prop "config") => "some-file" 34 | (cfg/get-config "some-file") => {:k :v} 35 | 36 | (behavior "looks for system property -Dconfig" 37 | (assertions 38 | (cfg/load-config {}) => {:k :v}))) 39 | 40 | (behavior "does not fail when returning nil" 41 | (assertions 42 | (#'cfg/get-system-prop "config") => nil)) 43 | (behavior "defaults file is always used to provide missing values" 44 | (when-mocking 45 | (cfg/get-defaults defaults-path) => {:a :b} 46 | (cfg/get-config nil) => {:c :d} 47 | (assertions 48 | (cfg/load-config {}) => {:a :b 49 | :c :d}))) 50 | 51 | (behavior "config file overrides defaults" 52 | (when-mocking 53 | (cfg/get-defaults defaults-path) => {:a {:b {:c :d} 54 | :e {:z :v}}} 55 | (cfg/get-config nil) => {:a {:b {:c :f 56 | :u :y} 57 | :e 13}} 58 | (assertions (cfg/load-config {}) => {:a {:b {:c :f 59 | :u :y} 60 | :e 13}}))) 61 | 62 | (component "load-config" 63 | (behavior "crashes if no default is found" 64 | (assertions 65 | (cfg/load-config {}) =throws=> (ExceptionInfo #""))) 66 | (behavior "crashes if no config is found" 67 | (when-mocking 68 | (cfg/get-defaults defaults-path) => {} 69 | (assertions (cfg/load-config {}) =throws=> (ExceptionInfo #"")))) 70 | (behavior "falls back to `config-path`" 71 | (when-mocking 72 | (cfg/get-defaults defaults-path) => {} 73 | (cfg/get-config "/some/path") => {:k :v} 74 | (assertions (cfg/load-config {:config-path "/some/path"}) => {:k :v}))) 75 | (behavior "recursively resolves symbols using resolve-symbol" 76 | (when-mocking 77 | (cfg/get-defaults defaults-path) => {:a {:b {:c 'clojure.core/symbol}} 78 | :v [0 "d"] 79 | :s #{'clojure.core/symbol}} 80 | (cfg/get-config nil) => {} 81 | (assertions (cfg/load-config {}) => {:a {:b {:c #'clojure.core/symbol}} 82 | :v [0 "d"] 83 | :s #{#'clojure.core/symbol}}))) 84 | (behavior "passes config-path to get-config" 85 | (when-mocking 86 | (cfg/get-defaults defaults-path) => {} 87 | (cfg/get-config "/foo/bar") => {} 88 | (assertions (cfg/load-config {:config-path "/foo/bar"}) => {}))) 89 | (assertions 90 | "config-path can be a relative path" 91 | (cfg/load-config {:config-path "not/abs/path"}) 92 | =throws=> (ExceptionInfo #"Invalid config file") 93 | 94 | "prints the invalid path in the exception message" 95 | (cfg/load-config {:config-path "invalid/file"}) 96 | =throws=> (ExceptionInfo #"invalid/file"))) 97 | 98 | (component "resolve-symbol" 99 | (behavior "requires if necessary" 100 | (when-mocking 101 | (resolve 'untangled.server.fixtures.dont-require-me/stahp) => false 102 | (require 'untangled.server.fixtures.dont-require-me) => true 103 | (assertions (#'cfg/resolve-symbol 'untangled.server.fixtures.dont-require-me/stahp) => false))) 104 | (behavior "fails if require fails" 105 | (assertions 106 | (#'cfg/resolve-symbol 'srsly/not-a-var) =throws=> (java.io.FileNotFoundException #""))) 107 | (behavior "if not found in the namespace after requiring" 108 | (assertions 109 | (#'cfg/resolve-symbol 'untangled.server.fixtures.dont-require-me/invalid) =throws=> (AssertionError #"not \(nil"))) 110 | (behavior "must be namespaced, throws otherwise" 111 | (assertions 112 | (#'cfg/resolve-symbol 'invalid) =throws=> (AssertionError #"namespace")))) 113 | 114 | (component "load-edn" 115 | (behavior "returns nil if absolute file is not found" 116 | (assertions (#'cfg/load-edn "/garbage") => nil)) 117 | (behavior "returns nil if relative file is not on classpath" 118 | (assertions (#'cfg/load-edn "garbage") => nil)) 119 | (behavior "can load edn from the classpath" 120 | (assertions (:some-key (#'cfg/load-edn "resources/config/defaults.edn")) => :some-default-val)) 121 | (behavior :integration "can load edn from the disk" 122 | (assertions (with-tmp-edn-file {:foo :bar} #'cfg/load-edn) => {:foo :bar})) 123 | (behavior :integration "can load edn with symbols" 124 | (assertions (with-tmp-edn-file {:sym 'sym} #'cfg/load-edn) => {:sym 'sym})) 125 | (behavior "can load edn with :env/vars" 126 | (when-mocking 127 | (cfg/get-system-env "FAKE_ENV_VAR") => "FAKE STUFF" 128 | (cfg/get-defaults defaults-path) => {} 129 | (cfg/get-system-prop "config") => :..cfg-path.. 130 | (cfg/get-config :..cfg-path..) => {:fake :env/FAKE_ENV_VAR} 131 | (assertions (cfg/load-config) => {:fake "FAKE STUFF"})) 132 | (behavior "when the namespace is env.edn it will edn/read-string it" 133 | (when-mocking 134 | (cfg/get-system-env "FAKE_ENV_VAR") => "3000" 135 | (cfg/get-defaults defaults-path) => {} 136 | (cfg/get-system-prop "config") => :..cfg-path.. 137 | (cfg/get-config :..cfg-path..) => {:fake :env.edn/FAKE_ENV_VAR} 138 | (assertions (cfg/load-config) => {:fake 3000})) 139 | (behavior "buyer beware as it'll parse it in ways you might not expect!" 140 | (when-mocking 141 | (cfg/get-system-env "FAKE_ENV_VAR") => "http://google.com" 142 | (cfg/get-defaults defaults-path) => {} 143 | (cfg/get-system-prop "config") => :..cfg-path.. 144 | (cfg/get-config :..cfg-path..) => {:fake :env.edn/FAKE_ENV_VAR} 145 | (assertions (cfg/load-config) => {:fake 'http://google.com})))))) 146 | 147 | (component "open-config-file" 148 | (behavior "takes in a path, finds the file at that path and should return a clojure map" 149 | (when-mocking 150 | (cfg/load-edn "/foobar") => "42" 151 | (assertions 152 | (#'cfg/open-config-file "/foobar") => "42"))) 153 | (behavior "or if path is nil, uses a default path" 154 | (assertions 155 | (#'cfg/open-config-file nil) =throws=> (ExceptionInfo #"Invalid config file"))) 156 | (behavior "if path doesn't exist on fs, it throws an ex-info" 157 | (assertions 158 | (#'cfg/get-config "/should/fail") =throws=> (ExceptionInfo #"Invalid config file"))))) 159 | 160 | (defrecord App [] 161 | component/Lifecycle 162 | (start [this] this) 163 | (stop [this] this)) 164 | 165 | (defn new-app [] 166 | (component/using 167 | (map->App {}) 168 | [:config])) 169 | 170 | (specification "untangled.server.impl.components.config" 171 | (component "new-config" 172 | (behavior "returns a stuartsierra component" 173 | (assertions (satisfies? component/Lifecycle (new-config "w/e")) => true) 174 | (behavior ".start loads the config" 175 | (when-mocking 176 | (cfg/load-config _) => "42" 177 | (assertions (:value (.start (new-config "mocked-out"))) => "42"))) 178 | (behavior ".stop removes the config" 179 | (when-mocking 180 | (cfg/load-config _) => "wateva" 181 | (assertions (-> (new-config "mocked-out") .start .stop :config) => nil))))) 182 | 183 | (behavior "new-config can be injected through a system-map" 184 | (when-mocking 185 | (cfg/load-config _) => {:foo :bar} 186 | (assertions 187 | (-> (component/system-map 188 | :config (new-config "mocked-out") 189 | :app (new-app)) .start :app :config :value) => {:foo :bar}))) 190 | 191 | (behavior "raw-config creates a config with the passed value" 192 | (assertions (-> (component/system-map 193 | :config (raw-config {:some :config}) 194 | :app (new-app)) 195 | .start :app :config :value) => {:some :config}))) 196 | -------------------------------------------------------------------------------- /specs/untangled/server/impl/components/handler_spec.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.impl.components.handler-spec 2 | (:require [untangled-spec.core :refer [specification assertions provided component behavior]] 3 | [clojure.test :as t] 4 | [untangled.server.core :refer [augment-response]] 5 | [untangled.server.impl.components.handler :as h] 6 | [com.stuartsierra.component :as component] 7 | [om.next.server :as om] 8 | [taoensso.timbre :as timbre]) 9 | (:import (clojure.lang ExceptionInfo))) 10 | 11 | (t/use-fixtures 12 | :once #(timbre/with-merged-config 13 | {:ns-blacklist ["untangled.server.impl.components.handler"]} 14 | (%))) 15 | 16 | (specification "generate-response" 17 | (assertions 18 | "returns a map with status, header, and body." 19 | (keys (h/generate-response {})) => [:status :body :headers] 20 | 21 | "merges Content-Type of transit json to the passed-in headers." 22 | (:headers (h/generate-response {:headers {:my :header}})) => {:my :header 23 | "Content-Type" "application/transit+json"} 24 | 25 | "preserves extra response keys from input" 26 | (h/generate-response {:status 200 :body {} :session {:user-id 123}}) 27 | => {:status 200 28 | :headers {"Content-Type" "application/transit+json"} 29 | :body {} 30 | :session {:user-id 123}}) 31 | 32 | (behavior "does not permit" 33 | (assertions 34 | "a \"Content-Type\" key in the header." 35 | (h/generate-response {:headers {"Content-Type" "not-allowed"}}) =throws=> (AssertionError #"headers") 36 | 37 | "a status code less than 100." 38 | (h/generate-response {:status 99}) =throws=> (AssertionError #"100") 39 | 40 | "a status code greater than or equal to 600." 41 | (h/generate-response {:status 600}) =throws=> (AssertionError #"600")))) 42 | 43 | (specification "An API Response" 44 | (let [my-read (fn [_ key _] {:value (case key 45 | :foo "success" 46 | :foo-session (augment-response {:some "data"} #(assoc-in % [:session :foo] "bar")) 47 | :bar (throw (ex-info "Oops" {:my :bad})) 48 | :bar' (throw (ex-info "Oops'" {:status 402 :body "quite an error"})) 49 | :baz (throw (IllegalArgumentException.)))}) 50 | 51 | my-mutate (fn [_ key _] {:action (condp = key 52 | 'foo (fn [] "success") 53 | 'overrides (fn [] (augment-response {} #(assoc % :body "override" 54 | :status 201 55 | :cookies {:foo "bar"}))) 56 | 'bar (fn [] (throw (ex-info "Oops" {:my :bad}))) 57 | 'bar' (fn [] (throw (ex-info "Oops'" {:status 402 :body "quite an error"}))) 58 | 'baz (fn [] (throw (IllegalArgumentException.))))}) 59 | 60 | parser (om/parser {:read my-read :mutate my-mutate}) 61 | parse-result (fn [query] (h/api {:parser parser :transit-params query}))] 62 | 63 | (behavior "for Om reads" 64 | (behavior "for a valid request" 65 | (behavior "returns a query response" 66 | (let [result (parse-result [:foo])] 67 | (assertions 68 | "with a body containing the expected parse result." 69 | (:body result) => {:foo "success"})))) 70 | 71 | (behavior "for an invalid request" 72 | (behavior "when the parser generates an expected error" 73 | (let [result (parse-result [:bar'])] 74 | (assertions 75 | "returns a status code." 76 | (:status result) =fn=> (complement nil?) 77 | 78 | "returns body if provided." 79 | (:body result) => "quite an error"))) 80 | 81 | (behavior "when the parser generates an unexpected error" 82 | (let [result (parse-result [:bar])] 83 | (assertions 84 | "returns a 500 http status code." 85 | (:status result) => 500 86 | 87 | "contains an exception in the response body." 88 | (:body result) => {:type "class clojure.lang.ExceptionInfo" :message "Oops" :data {:my :bad}}))) 89 | 90 | (behavior "when the parser does not generate the error" 91 | (let [result (parse-result [:baz])] 92 | (assertions 93 | "returns a 500 http status code." 94 | (:status result) => 500 95 | 96 | "returns exception data in the response body." 97 | (:body result) => {:type "class java.lang.IllegalArgumentException", :message nil}))))) 98 | 99 | (behavior "for Om mutates" 100 | (behavior "for a valid request" 101 | (behavior "returns a query response" 102 | (let [result (parse-result ['(foo)])] 103 | (assertions 104 | "with a body containing the expected parse result." 105 | (:body result) => {'foo "success"})))) 106 | 107 | (behavior "for invalid requests (where one or more mutations fail)" 108 | (let [bar-result (parse-result ['(bar')]) 109 | bar'-result (parse-result ['(bar)]) 110 | baz-result (parse-result ['(baz)])] 111 | 112 | (behavior "returns a status code of 400." 113 | (doall (map #(t/is (= 400 (:status %))) [bar'-result bar-result baz-result]))) 114 | 115 | (behavior "returns failing mutation result in the body." 116 | (letfn [(get-error [result] (-> result :body vals first :om.next/error))] 117 | (assertions 118 | (get-error bar-result) => {:type "class clojure.lang.ExceptionInfo", 119 | :message "Oops'", 120 | :data {:status 402, :body "quite an error"}} 121 | 122 | (get-error bar'-result) => {:type "class clojure.lang.ExceptionInfo", 123 | :message "Oops", 124 | :data {:my :bad}} 125 | 126 | (get-error baz-result) => {:type "class java.lang.IllegalArgumentException", 127 | :message nil})))))) 128 | 129 | (behavior "for updating the response" 130 | (behavior "adds the response keys to the ring response" 131 | (let [result (parse-result [:foo-session])] 132 | (assertions 133 | (:session result) => {:foo "bar"}))) 134 | (behavior "user can override response status and body" 135 | (assertions 136 | (parse-result ['(overrides)]) 137 | => {:status 201, :body "override", :cookies {:foo "bar"}}))))) 138 | 139 | (defn run [handler req] 140 | ((:middleware (component/start handler)) req)) 141 | (specification "the handler" 142 | (behavior "takes an extra-routes map containing bidi :routes & :handlers" 143 | (let [make-handler (fn [extra-routes] 144 | (h/build-handler (constantly nil) #{} 145 | :extra-routes extra-routes))] 146 | (assertions 147 | (-> {:routes ["/" {"test" :test}] 148 | :handlers {:test (fn [env match] 149 | {:body "test" 150 | :status 200})}} 151 | (make-handler) 152 | (run {:uri "/test"})) 153 | => {:body "test" 154 | :headers {"Content-Type" "application/octet-stream"} 155 | :status 200} 156 | 157 | "handler functions get passed the bidi match as an arg" 158 | (-> {:routes ["/" {["test/" :id] :test-with-params}] 159 | :handlers {:test-with-params (fn [env match] 160 | {:body (:id (:route-params match)) 161 | :status 200})}} 162 | (make-handler) 163 | (run {:uri "/test/foo"})) 164 | => {:body "foo" 165 | :status 200 166 | :headers {"Content-Type" "application/octet-stream"}} 167 | 168 | "and the request in the environment" 169 | (-> {:routes ["/" {["test"] :test}] 170 | :handlers {:test (fn [env match] 171 | {:body {:req (:request env)} 172 | :status 200})}} 173 | (make-handler) 174 | (run {:uri "/test"})) 175 | => {:body {:req {:uri "/test"}} 176 | :status 200 177 | :headers {"Content-Type" "application/octet-stream"}} 178 | 179 | "also dispatches on :request-method" 180 | (-> {:routes ["/" {["test/" :id] {:post :test-post}}] 181 | :handlers {:test-post (fn [env match] 182 | {:body "post" 183 | :status 200})}} 184 | (make-handler) 185 | (run {:uri "/test/foo" 186 | :request-method :post})) 187 | => {:body "post" 188 | :headers {"Content-Type" "application/octet-stream"} 189 | :status 200} 190 | 191 | "has to at least take a valid (but empty) :routes & :handlers" 192 | (-> {:routes ["" {}], :handlers {}} 193 | make-handler 194 | (run {:uri "/"}) 195 | (dissoc :body)) 196 | => {:headers {"Content-Type" "text/html"} 197 | :status 200}))) 198 | 199 | (behavior "calling (get/set)-(pre/fallback)-hook can modify the ring handler stack" 200 | (letfn [(make-test-system [] 201 | (.start (component/system-map 202 | :config {} 203 | :logger {} 204 | :handler (h/build-handler (constantly nil) {}))))] 205 | (assertions 206 | "the pre-hook which can short-circuit before the extra-routes, wrap-resource, or /api" 207 | (let [{:keys [handler]} (make-test-system)] 208 | (h/set-pre-hook! handler (fn [h] 209 | (fn [req] {:status 200 210 | :headers {"Content-Type" "text/text"} 211 | :body "pre-hook"}))) 212 | 213 | (:body ((:middleware handler) {}))) 214 | => "pre-hook" 215 | 216 | "the fallback hook will only get called if all other handlers do nothing" 217 | (let [{:keys [handler]} (make-test-system)] 218 | (h/set-fallback-hook! handler (fn [h] 219 | (fn [req] {:status 200 220 | :headers {"Content-Type" "text/text"} 221 | :body "fallback-hook"}))) 222 | (:body ((:middleware handler) {:uri "/i/should/fail"}))) 223 | => "fallback-hook" 224 | 225 | "get-(pre/fallback)-hook returns whatever hook is currently installed" 226 | (let [{:keys [handler]} (make-test-system)] 227 | (h/set-pre-hook! handler (fn [h] '_)) 228 | (h/get-pre-hook handler)) 229 | =fn=> #(= '_ (%1 nil)) 230 | (let [{:keys [handler]} (make-test-system)] 231 | (h/set-fallback-hook! handler (fn [h] '_)) 232 | (h/get-fallback-hook handler)) 233 | =fn=> #(= '_ (%1 nil)))))) 234 | -------------------------------------------------------------------------------- /specs/untangled/server/impl/components/web_server_spec.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.impl.components.web-server-spec 2 | (:require [untangled-spec.core :refer 3 | [specification component behavior assertions when-mocking provided]] 4 | [com.stuartsierra.component :as component] 5 | [untangled.server.impl.components.web-server :as src] 6 | [untangled.server.core :refer [make-web-server]] 7 | [org.httpkit.server :refer [run-server]] 8 | [taoensso.timbre :as timbre] 9 | [clojure.test :as t])) 10 | 11 | (t/use-fixtures 12 | :once #(timbre/with-merged-config 13 | {:ns-blacklist ["untangled.server.impl.components.web-server"]} 14 | (%))) 15 | 16 | (def dflt-cfg {:port 1337}) 17 | 18 | (defn make-test-system 19 | ([] (make-test-system dflt-cfg)) 20 | ([cfg] 21 | (component/system-map 22 | :config {:value cfg} 23 | :handler {:middleware :fake/all-routes} 24 | :web-server (make-web-server :handler)))) 25 | 26 | (specification "WebServer" 27 | (component "start" 28 | (behavior "correctly grabs the port & all-routes, and returns the started server under :server" 29 | (when-mocking 30 | (run-server :fake/all-routes {:port 1337}) => :ok 31 | (assertions 32 | (-> (make-test-system) .start :web-server :server) => :ok))) 33 | (behavior "only allows http-kit-opts to be passed to the server" 34 | (let [ok-cfg (zipmap src/http-kit-opts (mapv (constantly 42) src/http-kit-opts)) 35 | ok-cfg+bad (merge ok-cfg {:not-in/http-kit-opts :bad/value})] 36 | (when-mocking 37 | (run-server :fake/all-routes opts) => (do (assertions opts => ok-cfg) :ok) 38 | (assertions 39 | (-> (make-test-system ok-cfg+bad) .start :web-server :server) => :ok)))))) 40 | -------------------------------------------------------------------------------- /specs/untangled/server/impl/protocol_support_spec.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.impl.protocol-support-spec 2 | (:require [untangled-spec.core :refer [specification assertions behavior]] 3 | [untangled.server.impl.protocol-support :as ips] 4 | [om.tempid :as omt] 5 | [clojure.test :as t] 6 | [taoensso.timbre :as timbre])) 7 | 8 | (specification "helper functions" 9 | (assertions 10 | "collect-om-tempids" 11 | (ips/collect-om-tempids [{:id :om.tempid/qwack :foo :om.tempid/asdf} {:datomic.id/asdf :id}]) 12 | => #{:om.tempid/qwack :om.tempid/asdf} 13 | 14 | "extract-tempids" 15 | (ips/extract-tempids {'survey/add-question {:tempids {:om.tempid/inst-id0 17592186045460}}, 16 | :surveys 17 | [{:artifact/display-title 18 | "Survey Zero"}]}) 19 | => [{'survey/add-question {}, 20 | :surveys 21 | [{:artifact/display-title 22 | "Survey Zero"}]} 23 | {:om.tempid/inst-id0 17592186045460}] 24 | 25 | "nested-sort sorts collections recursively" 26 | (ips/recursive-sort-by hash {'foo {:bar [{:db/id 3} {:db/id 1 :foo [1 0 4 2 3]}]}}) 27 | => {'foo {:bar [{:db/id 1 :foo [3 2 4 0 1]} {:db/id 3}]}}) 28 | 29 | (let [[with-om-tempids omt->fake-omt] (ips/rewrite-om-tempids [:om.tempid/asdf :datomic.id/qwer :foo/bar])] 30 | (assertions "rewrite-om-tempids" 31 | (-> omt->fake-omt vals set) => #{:om.tempid/asdf} 32 | (first with-om-tempids) =fn=> omt/tempid? 33 | (drop 1 with-om-tempids) => [:datomic.id/qwer :foo/bar]))) 34 | 35 | (specification "rewrite-tempids" 36 | (behavior "rewrites tempids according to the supplied map" 37 | (assertions 38 | (ips/rewrite-tempids {:k :datomic.id/a} {:datomic.id/a 42}) => {:k 42} 39 | (ips/rewrite-tempids {:k {:db/id :datomic.id/a}} {:datomic.id/a 42}) => {:k {:db/id 42}} 40 | (ips/rewrite-tempids {:k [{:db/id :datomic.id/a}]} {:datomic.id/a 42}) => {:k [{:db/id 42}]})) 41 | (behavior "ignores keywords that are not tempids in mapping" 42 | (assertions 43 | (ips/rewrite-tempids {:k :a} {:a 42}) => {:k :a})) 44 | (behavior "leaves tempids in place if map entry is missing" 45 | (assertions 46 | (ips/rewrite-tempids {:k :datomic.id/a} {}) => {:k :datomic.id/a} 47 | (ips/rewrite-tempids {:k [{:db/id :datomic.id/a}]} {}) => {:k [{:db/id :datomic.id/a}]}))) 48 | -------------------------------------------------------------------------------- /specs/untangled/server/impl/util_spec.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.impl.util-spec 2 | (:require [untangled-spec.core :refer [specification behavior assertions]] 3 | [untangled.server.impl.util :as n] 4 | [taoensso.timbre :refer [debug info fatal error]] 5 | [clojure.tools.namespace.find :refer [find-namespaces]] 6 | [clojure.java.classpath :refer [classpath]])) 7 | 8 | (specification "strip-parameters" 9 | (behavior "removes all parameters from" 10 | (assertions 11 | "parameterized prop reads" 12 | (n/strip-parameters `[(:some/key {:arg :foo})]) => [:some/key] 13 | 14 | "parameterized join reads" 15 | (n/strip-parameters `[({:some/key [:sub/key]} {:arg :foo})]) => [{:some/key [:sub/key]}] 16 | 17 | "nested parameterized join reads" 18 | (n/strip-parameters 19 | `[{:some/key [({:sub/key [:sub.sub/key]} {:arg :foo})]}]) => [{:some/key [{:sub/key [:sub.sub/key]}]}] 20 | 21 | "multiple parameterized reads" 22 | (n/strip-parameters 23 | `[(:some/key {:arg :foo}) 24 | :another/key 25 | {:non-parameterized [:join]} 26 | {:some/other [{:nested [(:parameterized {:join :just-for-fun})]}]}]) 27 | => 28 | [:some/key :another/key {:non-parameterized [:join]} {:some/other [{:nested [:parameterized]}]}] 29 | 30 | "parameterized mutations" 31 | (n/strip-parameters ['(fire-missiles! {:arg :foo})]) => '[fire-missiles!] 32 | 33 | "multiple parameterized mutations" 34 | (n/strip-parameters ['(fire-missiles! {:arg :foo}) 35 | '(walk-the-plank! {:right :now})]) => '[fire-missiles! walk-the-plank!]))) 36 | 37 | -------------------------------------------------------------------------------- /specs/untangled/server/protocol_support_spec.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.protocol-support-spec 2 | (:require 3 | [clojure.test :as t] 4 | [com.stuartsierra.component :as component] 5 | [datomic.api :as d] 6 | [om.next.server :as om] 7 | [taoensso.timbre :as timbre] 8 | [untangled-spec.core :refer [specification behavior provided component assertions]] 9 | [untangled.datomic.core :refer [resolve-ids build-database]] 10 | [untangled.datomic.protocols :as udb] 11 | [untangled.datomic.test-helpers :refer [make-seeder]] 12 | [untangled.server.core :as core] 13 | [untangled.server.protocol-support :as ps])) 14 | 15 | (t/use-fixtures 16 | :once #(timbre/with-merged-config 17 | {:ns-blacklist ["untangled.datomic.*" 18 | "untangled.server.protocol-support" 19 | "untangled.server.impl.components.handler" 20 | "untangled.server.impl.components.config"]} 21 | (%))) 22 | 23 | (defn make-old-one [id name madness] 24 | {:db/id id 25 | :old-one/name name 26 | :old-one/madness madness}) 27 | 28 | (def protocol-support-data 29 | {:seed-data {:db [(make-old-one :datomic.id/cthulhu "UNSPEAKABLE 1" 13.37)]} 30 | :server-tx [{:old-one [:old-one/name]}] 31 | :response {:old-one [{:old-one/name "UNSPEAKABLE 1"}]}}) 32 | 33 | (def bad-protocol-support-data 34 | {:seed-data {:db [(make-old-one :datomic.id/cthulhu "UNSPEAKABLE 2" 13.37)] 35 | :db2 [(make-old-one :datomic.id/cthulhu "UNSPEAKABLE" 13.37)] 36 | :db3 [(make-old-one :datomic.id/yog-sothoth "UNSPEAKABLE" 13.37)]} 37 | :server-tx [{:old-one [:old-one/name]}] 38 | :response {:old-one [{:old-one/name "UNSPEAKABLE 2"}]}}) 39 | 40 | (def mutate-protocol-support-data 41 | {:seed-data {:db [(make-old-one :datomic.id/cthulhu "lululululu" 3.14159)]} 42 | :server-tx '[(old-one/add-follower {:old-one-id :datomic.id/cthulhu 43 | :follower-id :om.tempid/follower1 44 | :follower-name "Follower Won" 45 | :follower-devotion 42.0}) 46 | {:old-one [:old-one/name :old-one/followers :db/id]}] 47 | :response {'old-one/add-follower {} 48 | :old-one [{:old-one/name "lululululu", 49 | :old-one/followers [{:db/id :om.tempid/follower1}] 50 | :db/id :datomic.id/cthulhu}]}}) 51 | 52 | (defn api-read [{:keys [db query]} k params] 53 | ;(throw (ex-info "" {:db db})) 54 | (let [conn (:connection db)] 55 | (case k 56 | :old-one {:value (vec (flatten (d/q `[:find (~'pull ?e ~query) :where [?e :old-one/madness]] (d/db conn))))} 57 | nil))) 58 | 59 | (defn mutate [env k {:keys [old-one-id follower-id follower-name follower-devotion]}] 60 | (case k 61 | 'old-one/add-follower 62 | {:action (fn [] 63 | (let [connection (.get-connection (:db env)) 64 | follower-tid (d/tempid :db.part/user) 65 | omids->tempids {follower-id follower-tid}] 66 | (try 67 | (let [tx-data [{:db/id follower-tid 68 | :follower/name follower-name 69 | :follower/devotion follower-devotion} 70 | [:db/add old-one-id :old-one/followers follower-tid]] 71 | tempids->realids (:tempids @(d/transact connection tx-data)) 72 | omids->realids (resolve-ids (d/db connection) omids->tempids tempids->realids)] 73 | {:tempids omids->realids}) 74 | (catch Throwable e 75 | (throw e)))))} 76 | nil)) 77 | 78 | (defrecord TestApiHandler [] 79 | core/Module 80 | (system-key [_] ::api-handler) 81 | (components [_] {}) 82 | core/APIHandler 83 | (api-read [_] api-read) 84 | (api-mutate [_] mutate)) 85 | (defn api-handler [deps] 86 | (component/using 87 | (map->TestApiHandler {}) 88 | deps)) 89 | 90 | (def test-system 91 | (core/untangled-system 92 | {:components {:db (build-database :protocol-support) 93 | :config (core/new-config "test.edn") 94 | ::ps/seeder (make-seeder (:seed-data protocol-support-data))} 95 | :modules [(api-handler [:db])]})) 96 | 97 | (def bad-test-system 98 | (core/untangled-system 99 | {:modules [(api-handler [:db :db2 :db3])] 100 | :components {:db (build-database :protocol-support) 101 | :db2 (build-database :protocol-support-2) 102 | :db3 (build-database :protocol-support-3) 103 | :config (core/new-config "test.edn") 104 | ::ps/seeder (make-seeder (:seed-data bad-protocol-support-data))}})) 105 | 106 | (def mutate-test-system 107 | (core/untangled-system 108 | {:modules [(api-handler [:db])] 109 | :components {:db (build-database :protocol-support) 110 | :config (core/new-config "test.edn") 111 | ::ps/seeder (make-seeder (:seed-data mutate-protocol-support-data))}})) 112 | 113 | (specification "test server response (untangled-system)" 114 | (behavior "test server response w/ protocol data" 115 | (ps/check-response-to-client test-system protocol-support-data)) 116 | (behavior "test server response w/ bad protocol data" 117 | (assertions 118 | (ps/check-response-to-client bad-test-system bad-protocol-support-data) 119 | =throws=> (AssertionError #"seed data tempids must have no overlap"))) 120 | (behavior "test server response w/ mutate protocol data" 121 | (ps/check-response-to-client mutate-test-system mutate-protocol-support-data 122 | :on-success (fn [system resp] 123 | (assertions 124 | (set (keys system)) => #{:config :db ::api-handler 125 | ::core/api-handler :remap-fn 126 | ::ps/seeder} 127 | "seed data is put inside each database" 128 | (keys (:seed-result (udb/get-info (:db system)))) 129 | => [:datomic.id/cthulhu]))))) 130 | 131 | ;; ======= TESTING BACKWARDS COMPATABILITY (make-untangled-test-server) ======= 132 | 133 | (def test-server 134 | (core/make-untangled-test-server 135 | :parser (om/parser {:read api-read}) 136 | :parser-injections #{:db} 137 | :components {:db (build-database :protocol-support) 138 | :seeder (make-seeder (:seed-data protocol-support-data))})) 139 | 140 | (def bad-test-server 141 | (core/make-untangled-test-server 142 | :parser (om/parser {:read api-read}) 143 | :parser-injections #{:db :db2 :db3} 144 | :components {:db (build-database :protocol-support) 145 | :db2 (build-database :protocol-support-2) 146 | :db3 (build-database :protocol-support-3) 147 | :seeder (make-seeder (:seed-data bad-protocol-support-data))})) 148 | 149 | (def mutate-test-server 150 | (core/make-untangled-test-server 151 | :parser (om/parser {:read api-read :mutate mutate}) 152 | :parser-injections #{:db} 153 | :components {:db (build-database :protocol-support) 154 | :seeder (make-seeder (:seed-data mutate-protocol-support-data))})) 155 | 156 | (specification "test server response (make-untangled-test-server)" 157 | (behavior "test server response w/ protocol data" 158 | (ps/check-response-to-client test-server protocol-support-data)) 159 | (behavior "test server response w/ bad protocol data" 160 | (assertions 161 | (ps/check-response-to-client bad-test-server bad-protocol-support-data) 162 | =throws=> (AssertionError #"seed data tempids must have no overlap"))) 163 | (behavior "test server response w/ mutate protocol data" 164 | (ps/check-response-to-client mutate-test-server mutate-protocol-support-data 165 | :on-success (fn [system resp] 166 | (assertions 167 | (set (keys system)) => #{:config :db :handler :remap-fn :seeder} 168 | "seed data is put inside each database" 169 | (keys (:seed-result (udb/get-info (:db system)))) 170 | => [:datomic.id/cthulhu]))))) 171 | -------------------------------------------------------------------------------- /src/untangled/server/core.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.core 2 | (:require 3 | [com.stuartsierra.component :as component] 4 | [clojure.set :as set] 5 | [clojure.spec :as s] 6 | [om.next.server :as om] 7 | [untangled.server.impl.components.web-server :as web-server] 8 | [untangled.server.impl.components.handler :as handler] 9 | [untangled.server.impl.components.config :as config])) 10 | 11 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12 | ;; Mutation Helpers 13 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14 | 15 | (defn arg-assertion [mutation & args] 16 | "The function will throw an assertion error if any args are nil." 17 | (assert (every? (comp not nil?) args) (str "All parameters to " mutation " mutation must be provided."))) 18 | 19 | (defn assert-user [req] 20 | "Throws and AssertionError if the user credentials are missing from the request." 21 | (assert (:user req) "Request has no user credentials!")) 22 | 23 | (defn transitive-join 24 | "Takes a map from a->b and a map from b->c and returns a map a->c." 25 | [a->b b->c] 26 | (reduce (fn [result k] (assoc result k (->> k (get a->b) (get b->c)))) {} (keys a->b))) 27 | 28 | (defn augment-response 29 | "Augments the Ring response that's returned from the handler. 30 | 31 | Use this function when you need to add information into the handler response, for 32 | example when you need to add cookies or session data. Example: 33 | 34 | (defmethod my-mutate 'user/sign-in [_ _ _] 35 | {:action 36 | (fn [] 37 | (augment-response 38 | {:uid 42} ; your regular response 39 | #(assoc-in % [:session :user-id] 42) ; a function resp -> resp 40 | ))}) 41 | 42 | If your parser has multiple responses with `augment-response`, they will be applied 43 | in order, the first one will receive an empty map as input. Only top level values 44 | of your response will be checked for augmented response." 45 | [core-response ring-response-fn] 46 | (assert (instance? clojure.lang.IObj core-response) "Scalar values can't be augmented.") 47 | (with-meta core-response {::augment-response ring-response-fn})) 48 | 49 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 50 | ;; Component Constructor Functions 51 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 52 | 53 | (defn make-web-server 54 | "Builds a web server with an optional argument that 55 | specifies which component to get `:middleware` from, 56 | defaults to `:handler`." 57 | [& [handler]] 58 | (component/using 59 | (component/using 60 | (web-server/map->WebServer {}) 61 | [:config]) 62 | {:handler (or handler :handler)})) 63 | 64 | (defn raw-config 65 | "Creates a configuration component using the value passed in, 66 | it will NOT look for any config files." 67 | [value] (config/map->Config {:value value})) 68 | 69 | (defn new-config 70 | "Create a new configuration component. It will load the application defaults from config/defaults.edn 71 | (using the classpath), then look for an override file in either: 72 | 1) the file specified via the `config` system property 73 | 2) the file at `config-path` 74 | and merge anything it finds there over top of the defaults. 75 | 76 | This function can override a number of the above defaults with the parameters: 77 | - `config-path`: The location of the disk-based configuration file. 78 | " 79 | [config-path] 80 | (config/map->Config {:config-path config-path})) 81 | 82 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 83 | ;; Server Construction 84 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 85 | 86 | (defn make-untangled-server 87 | "Make a new untangled server. 88 | 89 | Parameters: 90 | *`config-path` OPTIONAL, a string of the path to your configuration file on disk. 91 | The system property -Dconfig=/path/to/conf can also be passed in from the jvm. 92 | 93 | *`components` OPTIONAL, a map of Sierra component instances keyed by their desired names in the overall system component. 94 | These additional components will merged with the untangled-server components to compose a new system component. 95 | 96 | *`parser` REQUIRED, an om parser function for parsing requests made of the server. To report errors, the 97 | parser must throw an ExceptionInfo with a map with keys `:status`, `:headers`, and `:body`. 98 | This map will be converted into the response sent to the client. 99 | 100 | *`parser-injections` a vector of keywords which represent components which will be injected as the om parsing env. 101 | 102 | *`extra-routes` OPTIONAL, a map containing `:routes` and `:handlers`, 103 | where routes is a bidi routing data structure, 104 | and handlers are map from handler name to a function of type :: Env -> BidiMatch -> Res 105 | see `handler/wrap-extra-routes` & handler-spec for more. 106 | 107 | *`app-name` OPTIONAL, a string that will turn \"\\api\" into \"\\api\" 108 | 109 | Returns a Sierra system component. 110 | " 111 | [& {:keys [app-name parser parser-injections config-path components extra-routes] 112 | :or {config-path "/usr/local/etc/untangled.edn"} 113 | :as params}] 114 | {:pre [(some-> parser fn?) 115 | (or (nil? components) (map? components)) 116 | (or (nil? extra-routes) 117 | (and (map? extra-routes) 118 | (:routes extra-routes) 119 | (map? (:handlers extra-routes)))) 120 | (or (nil? parser-injections) 121 | (and (set? parser-injections) 122 | (every? keyword? parser-injections)))]} 123 | (let [handler (handler/build-handler parser parser-injections 124 | :extra-routes extra-routes 125 | :app-name app-name) 126 | built-in-components [:config (new-config config-path) 127 | :handler handler 128 | :server (make-web-server)] 129 | all-components (flatten (concat built-in-components components))] 130 | (apply component/system-map all-components))) 131 | 132 | (defn make-untangled-test-server 133 | "Make sure to inject a :seeder component in the group of components that you pass in!" 134 | [& {:keys [parser parser-injections components]}] 135 | (let [handler (handler/build-handler parser parser-injections) 136 | built-in-components [:config (new-config "test.edn") 137 | :handler handler] 138 | all-components (flatten (concat built-in-components components))] 139 | (apply component/system-map all-components))) 140 | 141 | ;;==================== NEW (& IMPROVED) UNTANGLED SERVER SYSTEM ==================== 142 | 143 | (defprotocol Module 144 | (system-key [this] 145 | "Should return the key under which the module will be located in the system map. 146 | Unique-ness is checked and will be asserted.") 147 | (components [this] 148 | "Should return a map of components that this Module needs to bring in to work. 149 | Unique-ness is checked and will be asserted.")) 150 | 151 | (defprotocol APIHandler 152 | (api-read [this] 153 | "Returns an untangled read emitter for parsing read queries, ie: `(fn [env k params] ...)`. 154 | The emitter can return an untruthy value (`nil` or `false`), 155 | which tells the untangled api-handler to try the next `Module` in the `:modules` chain.") 156 | (api-mutate [this] 157 | "Returns an untangled mutate emitter for parsing mutations, ie: `(fn [env k params] ...)`. 158 | The emitter can return an untruthy value (`nil` or `false`), 159 | which tells the untangled api-handler to try the next `Module` in the `:modules` chain.")) 160 | 161 | (defn- chain 162 | "INTERNAL use only, use `untangled-system` instead." 163 | [F api-fn module] 164 | (if-not (satisfies? APIHandler module) F 165 | (let [parser-fn (api-fn module)] 166 | (fn [env k p] 167 | (or (parser-fn (merge module env) k p) 168 | (F env k p)))))) 169 | 170 | (defn- comp-api-modules 171 | "INTERNAL use only, use `untangled-system` instead." 172 | [{:as this :keys [modules]}] 173 | (reduce 174 | (fn [r+m module-key] 175 | (let [module (get this module-key)] 176 | (-> r+m 177 | (update :read chain api-read module) 178 | (update :mutate chain api-mutate module)))) 179 | {:read (constantly nil) 180 | :mutate (constantly nil)} 181 | (rseq modules))) 182 | 183 | (defrecord UntangledApiHandler [app-name modules] 184 | component/Lifecycle 185 | (start [this] 186 | (let [api-url (cond->> "/api" app-name (str "/" app-name)) 187 | api-parser (om/parser (comp-api-modules this)) 188 | make-response 189 | (fn [parser env query] 190 | (handler/generate-response 191 | (let [parse-result (try (handler/raise-response 192 | (parser env query)) 193 | (catch Exception e e))] 194 | (if (handler/valid-response? parse-result) 195 | {:status 200 :body parse-result} 196 | (handler/process-errors parse-result))))) 197 | api-handler (fn [env query] 198 | (make-response api-parser env query))] 199 | (assoc this 200 | :handler api-handler 201 | :middleware 202 | (fn [h] 203 | (fn [req] 204 | (if-let [resp (and (= (:uri req) api-url) 205 | (api-handler {:request req} (:transit-params req)))] 206 | resp (h req))))))) 207 | (stop [this] (dissoc this :middleware))) 208 | 209 | (defn- api-handler 210 | "INTERNAL use only, use `untangled-system` instead." 211 | [opts] 212 | (let [module-keys (mapv system-key (:modules opts))] 213 | (component/using 214 | (map->UntangledApiHandler 215 | (assoc opts :modules module-keys)) 216 | module-keys))) 217 | 218 | (defn- merge-with-no-duplicates! 219 | "INTERNAL use only, for checking that a merge doesn't override anything silently." 220 | [ctx & maps] 221 | (when (some identity maps) 222 | (let [merge-entry 223 | (fn [m e] 224 | (let [[k v] ((juxt key val) e)] 225 | (if-not (contains? m k) (assoc m k v) 226 | (throw (ex-info (str "Duplicate entries for key <" k "> found for " ctx ", see ex-data.") 227 | {:key k :prev-value (get m k) :new-value v})))))] 228 | (reduce (fn [m1 m2] (reduce merge-entry (or m1 {}) (seq m2))) maps)))) 229 | 230 | (defn untangled-system 231 | "More powerful variant of `make-untangled-server` that allows for libraries to provide 232 | components and api methods (by implementing `components` and `APIHandler` respectively). 233 | However note that `untangled-system` does not include any components for you, 234 | so you'll have to include things like a web-server (eg: `make-web-server`), middleware, 235 | config, etc... 236 | 237 | Takes a map with keys: 238 | * `:api-handler-key` - OPTIONAL, Where to place the api-handler in the system-map, will have `:middleware` 239 | and is a (fn [h] (fn [req] resp)) that handles /api requests. 240 | Should only really be of use if you want to embed an untangled-server inside 241 | some other application or language, eg: java servlet (or jvm hosted language). 242 | Defaults to `::api-handler`. 243 | * `:app-name` - OPTIONAL, a string that will turn \"/api\" into \"//api\". 244 | * `:components` - A `com.stuartsierra.component/system-map`. 245 | * `:modules` - A vector of implementations of Module (& optionally APIHandler), 246 | that will be composed in the order they were passed in. 247 | Eg: [mod1 mod2 ...] => mod1 will be tried first, mod2 next, etc... 248 | This should be used to compose libraries api methods with your own, 249 | with full control over execution order. 250 | 251 | NOTE: Stores the key api-handler is located in the meta data under `::api-handler-key`. 252 | Currently used by protocol support to test your api methods without needing networking." 253 | [{:keys [api-handler-key modules] :as opts}] 254 | (-> (apply component/system-map 255 | (apply concat 256 | (merge-with-no-duplicates! "untangled-system" 257 | (:components opts) 258 | (apply merge-with-no-duplicates! "Module/system-key" 259 | (map (comp (partial apply hash-map) (juxt system-key identity)) modules)) 260 | (apply merge-with-no-duplicates! "Module/components" 261 | (map components modules)) 262 | {(or api-handler-key ::api-handler) 263 | (api-handler opts)}))) 264 | (vary-meta assoc ::api-handler-key (or api-handler-key ::api-handler)))) 265 | -------------------------------------------------------------------------------- /src/untangled/server/fixtures/dont_require_me.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.fixtures.dont-require-me 2 | "For use in untangled.server.impl.components.config-spec ONLY") 3 | 4 | (def stahp :stop-it) 5 | -------------------------------------------------------------------------------- /src/untangled/server/impl/components/config.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.impl.components.config 2 | (:require [com.stuartsierra.component :as component] 3 | [clojure.java.classpath :as cp] 4 | [clojure.java.io :as io] 5 | [clojure.edn :as edn] 6 | [taoensso.timbre :as log] 7 | [clojure.walk :as walk]) 8 | (:import (java.io File))) 9 | 10 | (defn- get-system-prop [prop-name] 11 | (System/getProperty prop-name)) 12 | 13 | (defn- deep-merge [& xs] 14 | "Recursively merge maps. 15 | If the args are ever not all maps, 16 | the last value wins" 17 | (if (every? map? xs) 18 | (apply merge-with deep-merge xs) 19 | (last xs))) 20 | 21 | (defn load-edn 22 | "If given a relative path, looks on classpath (via class loader) for the file, reads the content as EDN, and returns it. 23 | If the path is an absolute path, it reads it as EDN and returns that. 24 | If the resource is not found, returns nil." 25 | [^String file-path] 26 | (let [?edn-file (io/file file-path)] 27 | (if-let [edn-file (and (.isAbsolute ?edn-file) 28 | (.exists ?edn-file) 29 | (io/file file-path))] 30 | (-> edn-file slurp edn/read-string) 31 | (some-> file-path io/resource .openStream slurp edn/read-string)))) 32 | 33 | (defn- open-config-file 34 | "Calls load-edn on `file-path`, 35 | and throws an ex-info if that failed." 36 | [file-path] 37 | (or (some-> file-path load-edn) 38 | (throw (ex-info (str "Invalid config file at '" file-path "'") 39 | {:file-path file-path})))) 40 | 41 | (def get-defaults open-config-file) 42 | (def get-config open-config-file) 43 | 44 | (defn- resolve-symbol [sym] 45 | {:pre [(namespace sym)] 46 | :post [(not (nil? %))]} 47 | (or (resolve sym) 48 | (do (-> sym namespace symbol require) 49 | (resolve sym)))) 50 | 51 | (defn- get-system-env [var-name] 52 | (System/getenv var-name)) 53 | 54 | (defn load-config 55 | "Entry point for config loading, pass it a map with k-v pairs indicating where 56 | it should look for configuration in case things are not found. 57 | Eg: 58 | - config-path is the location of the config file in case there was no system property 59 | " 60 | ([] (load-config {})) 61 | ([{:keys [config-path]}] 62 | (let [defaults (get-defaults "config/defaults.edn") 63 | config (get-config (or (get-system-prop "config") config-path))] 64 | (->> (deep-merge defaults config) 65 | (walk/prewalk #(cond-> % (symbol? %) resolve-symbol 66 | (and (keyword? %) (namespace %) 67 | (re-find #"^env.*" (namespace %))) 68 | (-> name get-system-env 69 | (cond-> (= "env.edn" (namespace %)) 70 | (edn/read-string))))))))) 71 | 72 | (defrecord Config [value config-path] 73 | component/Lifecycle 74 | (start [this] 75 | (let [config (or value (load-config {:config-path config-path}))] 76 | (assoc this :value config))) 77 | (stop [this] this)) 78 | -------------------------------------------------------------------------------- /src/untangled/server/impl/components/handler.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.impl.components.handler 2 | (:require 3 | [clojure.set :as set] 4 | [clojure.java.io :as io] 5 | [bidi.bidi :as bidi] 6 | [com.stuartsierra.component :as component] 7 | [ring.middleware.content-type :refer [wrap-content-type]] 8 | [ring.middleware.not-modified :refer [wrap-not-modified]] 9 | [ring.middleware.resource :refer [wrap-resource]] 10 | [ring.middleware.gzip :refer [wrap-gzip]] 11 | [ring.util.response :refer [resource-response]] 12 | [ring.util.response :as rsp :refer [response file-response resource-response]] 13 | [untangled.server.impl.middleware :as middleware] 14 | [taoensso.timbre :as timbre]) 15 | (:import (clojure.lang ExceptionInfo))) 16 | 17 | (defn index [req] 18 | (assoc (resource-response (str "index.html") {:root "public"}) 19 | :headers {"Content-Type" "text/html"})) 20 | 21 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 22 | ;;; API Helper Functions 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 24 | 25 | (defn serialize-exception 26 | "Convert exception data to string form for network transit." 27 | [ex] 28 | {:pre [(instance? Exception ex)]} 29 | (let [message (.getMessage ex) 30 | type (str (type ex)) 31 | serialized-data {:type type :message message}] 32 | (if (instance? ExceptionInfo ex) 33 | (assoc serialized-data :data (ex-data ex)) 34 | serialized-data))) 35 | 36 | (defn unknow-error->response [error] 37 | (let [serialized-data (serialize-exception error)] 38 | {:status 500 39 | :body serialized-data})) 40 | 41 | (defn parser-read-error->response 42 | "Determines if ex-data from ExceptionInfo has headers matching the Untangled Server API. 43 | Returns ex-map if the ex-data matches the API, otherwise returns the whole exception." 44 | [ex] 45 | (let [valid-response-keys #{:status :headers :body} 46 | ex-map (ex-data ex)] 47 | (if (every? valid-response-keys (keys ex-map)) 48 | ex-map 49 | (unknow-error->response ex)))) 50 | 51 | (defn parser-mutate-error->response 52 | [mutation-result] 53 | (let [raise-error-data (fn [item] 54 | (if (and (map? item) (contains? item :om.next/error)) 55 | (let [exception-data (serialize-exception (get-in item [:om.next/error]))] 56 | (assoc item :om.next/error exception-data)) 57 | item)) 58 | mutation-errors (clojure.walk/prewalk raise-error-data mutation-result)] 59 | 60 | {:status 400 :body mutation-errors})) 61 | 62 | (defn process-errors [error] 63 | (let [error-response (cond 64 | (instance? ExceptionInfo error) (parser-read-error->response error) 65 | (instance? Exception error) (unknow-error->response error) 66 | :else (parser-mutate-error->response error))] 67 | (timbre/error error "Parser error:\n" (with-out-str (clojure.pprint/pprint error-response))) 68 | error-response)) 69 | 70 | (defn valid-response? [result] 71 | (and 72 | (not (instance? Exception result)) 73 | (not (some (fn [[_ {:keys [om.next/error]}]] (some? error)) result)))) 74 | 75 | (defn raise-response 76 | "For om mutations, converts {'my/mutation {:result {...}}} to {'my/mutation {...}}" 77 | [resp] 78 | (reduce (fn [acc [k v]] 79 | (if (and (symbol? k) (not (nil? (:result v)))) 80 | (assoc acc k (:result v)) 81 | (assoc acc k v))) 82 | {} resp)) 83 | 84 | (defn augment-map 85 | "Parses response the top level values processing the augmented response. This function 86 | expects the parser mutation results to be raised (use the raise-response function)." 87 | [response] 88 | (->> (keep #(some-> (second %) meta :untangled.server.core/augment-response) response) 89 | (reduce (fn [response f] (f response)) {}))) 90 | 91 | (defn api 92 | "The /api Request handler. The incoming request will have a database connection, parser, and error handler 93 | already injected. This function should be fairly static, in that it calls the parser, and if the parser 94 | does not throw and exception it wraps the return value in a transit response. If the parser throws 95 | an exception, then it calls the injected error handler with the request and the exception. Thus, 96 | you can define the handling of all API requests via system injection at startup." 97 | [{:keys [transit-params parser env] :as req}] 98 | (let [parse-result (try (raise-response (parser env transit-params)) (catch Exception e e))] 99 | (if (valid-response? parse-result) 100 | (merge {:status 200 :body parse-result} (augment-map parse-result)) 101 | (process-errors parse-result)))) 102 | 103 | (defn generate-response 104 | "Generate a response containing status code, headers, and body. 105 | The content type will always be 'application/transit+json', 106 | and this function will assert if otherwise." 107 | [{:keys [status body headers] :or {status 200} :as input}] 108 | {:pre [(not (contains? headers "Content-Type")) 109 | (and (>= status 100) (< status 600))]} 110 | (-> (assoc input :status status :body body) 111 | (update :headers assoc "Content-Type" "application/transit+json"))) 112 | 113 | (def default-api-key "/api") 114 | 115 | (defn app-namify-api [default-routes app-name] 116 | (if app-name 117 | (update default-routes 1 (fn [m] 118 | (let [api-val (get m default-api-key)] 119 | (-> m 120 | (dissoc default-api-key) 121 | (assoc (str "/" app-name default-api-key) api-val))))) 122 | default-routes)) 123 | 124 | (def default-routes 125 | ["" {"/" :index 126 | default-api-key {:get :api 127 | :post :api}}]) 128 | 129 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 130 | ;; Handler Code 131 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 132 | 133 | (defn route-handler [req] 134 | (let [routes (app-namify-api default-routes (:app-name req)) 135 | match (bidi/match-route routes (:uri req) 136 | :request-method (:request-method req))] 137 | (case (:handler match) 138 | ;; explicit handling of / as index.html. wrap-resources does the rest 139 | :index (index req) 140 | :api (generate-response (api req)) 141 | nil))) 142 | 143 | (defn wrap-connection 144 | "Ring middleware function that invokes the general handler with the parser and parsing environgment on the request." 145 | [handler route-handler api-parser om-parsing-env app-name] 146 | (fn [req] 147 | (if-let [res (route-handler (assoc req 148 | :parser api-parser 149 | :env (assoc om-parsing-env :request req) 150 | :app-name app-name))] 151 | res 152 | (handler req)))) 153 | 154 | (defn wrap-extra-routes [dflt-handler {:as extra-routes :keys [routes handlers]} om-parsing-env] 155 | (if-not extra-routes dflt-handler 156 | (do (assert (and routes handlers) extra-routes) 157 | (fn [req] 158 | (let [match (bidi/match-route routes (:uri req) :request-method (:request-method req))] 159 | (if-let [bidi-handler (get handlers (:handler match))] 160 | (bidi-handler (assoc om-parsing-env :request req) match) 161 | (dflt-handler req))))))) 162 | 163 | (defn not-found-handler [] 164 | (fn [req] 165 | {:status 404 166 | :headers {"Content-Type" "text/html"} 167 | :body (io/file (io/resource "public/not-found.html"))})) 168 | 169 | (defn handler 170 | "Create a web request handler that sends all requests through an Om parser. The om-parsing-env of the parses 171 | will include any components that were injected into the handler. 172 | 173 | Returns a function that handles requests." 174 | [api-parser om-parsing-env extra-routes app-name pre-hook fallback-hook] 175 | ;; NOTE: ALL resources served via wrap-resources (from the public subdirectory). The BIDI route maps / -> index.html 176 | (-> (not-found-handler) 177 | (fallback-hook) 178 | (wrap-connection route-handler api-parser om-parsing-env app-name) 179 | (middleware/wrap-transit-params) 180 | (middleware/wrap-transit-response) 181 | (wrap-resource "public") 182 | (wrap-extra-routes extra-routes om-parsing-env) 183 | (pre-hook) 184 | (wrap-content-type) 185 | (wrap-not-modified) 186 | (wrap-gzip))) 187 | 188 | (defprotocol IHandler 189 | (set-pre-hook! [this pre-hook] 190 | "Sets the handler before any important handlers are run.") 191 | (get-pre-hook [this] 192 | "Gets the current pre-hook handler.") 193 | (set-fallback-hook! [this fallback-hook] 194 | "Sets the fallback handler in case nothing else returned.") 195 | (get-fallback-hook [this] 196 | "Gets the current fallback-hook handler.")) 197 | 198 | (defrecord Handler [stack api-parser injected-keys extra-routes app-name pre-hook fallback-hook] 199 | component/Lifecycle 200 | (start [component] 201 | (assert (every? (set (keys component)) injected-keys) 202 | (str "You asked to inject " injected-keys 203 | " but " (set/difference injected-keys (set (keys component))) 204 | " do not exist.")) 205 | (timbre/info "Creating web server handler.") 206 | (let [om-parsing-env (select-keys component injected-keys) 207 | req-handler (handler api-parser om-parsing-env extra-routes app-name 208 | @pre-hook @fallback-hook)] 209 | (reset! stack req-handler) 210 | (assoc component :env om-parsing-env 211 | :middleware (fn [req] (@stack req))))) 212 | (stop [component] 213 | (timbre/info "Tearing down web server handler.") 214 | (assoc component :middleware nil :stack nil :pre-hook nil :fallback-hook nil)) 215 | 216 | IHandler 217 | (set-pre-hook! [this new-pre-hook] 218 | (reset! pre-hook new-pre-hook) 219 | (reset! stack 220 | (handler api-parser (select-keys this injected-keys) 221 | extra-routes app-name @pre-hook @fallback-hook)) 222 | this) 223 | (get-pre-hook [this] 224 | @pre-hook) 225 | (set-fallback-hook! [this new-fallback-hook] 226 | (reset! fallback-hook new-fallback-hook) 227 | (reset! stack 228 | (handler api-parser (select-keys this injected-keys) 229 | extra-routes app-name @pre-hook @fallback-hook)) 230 | this) 231 | (get-fallback-hook [this] 232 | @fallback-hook)) 233 | 234 | (defn build-handler 235 | "Build a web request handler. 236 | 237 | Parameters: 238 | - `api-parser`: An Om AST Parser that can interpret incoming API queries, and return the proper response. Return is the response when no exception is thrown. 239 | - `injections`: A vector of keywords to identify component dependencies. Components injected here can be made available to your parser. 240 | - `extra-routes`: See `make-untangled-server` 241 | - `app-name`: See `make-untangled-server` 242 | " 243 | [api-parser injections & {:keys [extra-routes app-name]}] 244 | (component/using 245 | (map->Handler {:api-parser api-parser 246 | :injected-keys injections 247 | :stack (atom nil) 248 | :pre-hook (atom identity) 249 | :fallback-hook (atom identity) 250 | :extra-routes extra-routes 251 | :app-name app-name}) 252 | (vec (into #{:config} injections)))) 253 | -------------------------------------------------------------------------------- /src/untangled/server/impl/components/web_server.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.impl.components.web-server 2 | (:require [org.httpkit.server :refer [run-server]] 3 | [taoensso.timbre :as timbre] 4 | [com.stuartsierra.component :as component]) 5 | (:gen-class)) 6 | 7 | (def http-kit-opts 8 | [:ip :port :thread :worker-name-prefix 9 | :queue-size :max-body :max-line]) 10 | 11 | (defrecord WebServer [port handler server] 12 | component/Lifecycle 13 | (start [this] 14 | (try 15 | (let [server-opts (select-keys (-> this :config :value) http-kit-opts) 16 | port (:port server-opts) 17 | started-server (run-server (:middleware handler) server-opts)] 18 | (timbre/info "Web server started successfully. With options:" server-opts) 19 | (assoc this :port port :server started-server)) 20 | (catch Exception e 21 | (timbre/fatal "Failed to start web server " e) 22 | (throw e)))) 23 | (stop [this] 24 | (if-not server this 25 | (do (server) 26 | (timbre/info "web server stopped.") 27 | (assoc this :server nil))))) 28 | -------------------------------------------------------------------------------- /src/untangled/server/impl/components/wrap_defaults.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.impl.components.wrap-defaults 2 | (:require [com.stuartsierra.component :as component] 3 | [ring.middleware.defaults :refer [wrap-defaults site-defaults]] 4 | [untangled.server.impl.components.handler :as handler :refer [get-pre-hook set-pre-hook!]])) 5 | 6 | (defrecord WrapDefaults [handler defaults-config] 7 | component/Lifecycle 8 | (start [this] 9 | (let [pre-hook (get-pre-hook handler)] 10 | ;; We want wrap-defaults to take precedence. 11 | (set-pre-hook! handler (comp #(wrap-defaults % defaults-config) pre-hook)) 12 | this)) 13 | (stop [this] this)) 14 | 15 | (defn make-wrap-defaults 16 | "Create a component that adds `ring.middleware.defaults/wrap-defaults` to the middleware in the prehook. 17 | 18 | - `defaults-config` - (Optional) The configuration passed to `wrap-defaults`. 19 | The 0 arity will use `ring.middleware.defaults/site-defaults`." 20 | ([] 21 | (make-wrap-defaults site-defaults)) 22 | ([defaults-config] 23 | (component/using 24 | (map->WrapDefaults {:defaults-config defaults-config}) 25 | [:handler]))) 26 | -------------------------------------------------------------------------------- /src/untangled/server/impl/middleware.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.impl.middleware 2 | (:require [ring.util.response :refer :all] 3 | [om.next.server :as om] 4 | [cognitect.transit :as transit]) 5 | (:import [java.io ByteArrayOutputStream])) 6 | 7 | (defn- write [x t opts] 8 | (let [baos (ByteArrayOutputStream.) 9 | w (om/writer baos opts) 10 | _ (transit/write w x) 11 | ret (.toString baos)] 12 | (.reset baos) 13 | ret)) 14 | 15 | (defn- transit-request? [request] 16 | (if-let [type (:content-type request)] 17 | (let [mtch (re-find #"^application/transit\+(json|msgpack)" type)] 18 | [(not (empty? mtch)) (keyword (second mtch))]))) 19 | 20 | (defn- read-transit [request {:keys [opts]}] 21 | (let [[res _] (transit-request? request)] 22 | (if res 23 | (if-let [body (:body request)] 24 | (let [rdr (om/reader body opts)] 25 | (try 26 | [true (transit/read rdr)] 27 | (catch Exception ex 28 | [false nil]))))))) 29 | 30 | (def ^{:doc "The default response to return when a Transit request is malformed."} 31 | default-malformed-response 32 | {:status 400 33 | :headers {"Content-Type" "text/plain"} 34 | :body "Malformed Transit in request body."}) 35 | 36 | (defn wrap-transit-body 37 | "Middleware that parses the body of Transit request maps, and replaces the :body 38 | key with the parsed data structure. Requests without a Transit content type are 39 | unaffected. 40 | Accepts the following options: 41 | :keywords? - true if the keys of maps should be turned into keywords 42 | :opts - a map of options to be passed to the transit reader 43 | :malformed-response - a response map to return when the JSON is malformed" 44 | {:arglists '([handler] [handler options])} 45 | [handler & [{:keys [malformed-response] 46 | :or {malformed-response default-malformed-response} 47 | :as options}]] 48 | (fn [request] 49 | (if-let [[valid? transit] (read-transit request options)] 50 | (if valid? 51 | (handler (assoc request :body transit)) 52 | malformed-response) 53 | (handler request)))) 54 | 55 | (defn- assoc-transit-params [request transit] 56 | (let [request (assoc request :transit-params transit)] 57 | (if (map? transit) 58 | (update-in request [:params] merge transit) 59 | request))) 60 | 61 | (defn wrap-transit-params 62 | "Middleware that parses the body of Transit requests into a map of parameters, 63 | which are added to the request map on the :transit-params and :params keys. 64 | Accepts the following options: 65 | :malformed-response - a response map to return when the JSON is malformed 66 | :opts - a map of options to be passed to the transit reader 67 | Use the standard Ring middleware, ring.middleware.keyword-params, to 68 | convert the parameters into keywords." 69 | {:arglists '([handler] [handler options])} 70 | [handler & [{:keys [malformed-response] 71 | :or {malformed-response default-malformed-response} 72 | :as options}]] 73 | (fn [request] 74 | (if-let [[valid? transit] (read-transit request options)] 75 | (if valid? 76 | (handler (assoc-transit-params request transit)) 77 | malformed-response) 78 | (handler request)))) 79 | 80 | (defn wrap-transit-response 81 | "Middleware that converts responses with a map or a vector for a body into a 82 | Transit response. 83 | Accepts the following options: 84 | :encoding - one of #{:json :json-verbose :msgpack} 85 | :opts - a map of options to be passed to the transit writer" 86 | {:arglists '([handler] [handler options])} 87 | [handler & [{:as options}]] 88 | (let [{:keys [encoding opts] :or {encoding :json}} options] 89 | (assert (#{:json :json-verbose :msgpack} encoding) "The encoding must be one of #{:json :json-verbose :msgpack}.") 90 | (fn [request] 91 | (let [response (handler request)] 92 | (if (coll? (:body response)) 93 | (let [transit-response (update-in response [:body] write encoding opts)] 94 | (if (contains? (:headers response) "Content-Type") 95 | transit-response 96 | (content-type transit-response (format "application/transit+%s; charset=utf-8" (name encoding))))) 97 | response))))) 98 | -------------------------------------------------------------------------------- /src/untangled/server/impl/protocol_support.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.impl.protocol-support 2 | (:require 3 | [clojure.walk :as walk] 4 | [clojure.set :as set] 5 | [untangled-spec.core :refer [specification behavior provided component assertions]] 6 | [untangled.server.impl.components.handler :as h] 7 | [om.tempid :as omt])) 8 | 9 | (defn set-namespace [kw new-ns] 10 | (keyword new-ns (name kw))) 11 | 12 | (defn namespace-match-generator [nspace] 13 | (fn [x] 14 | (and (keyword? x) (= nspace (namespace x))))) 15 | 16 | (def datomic-id? 17 | (namespace-match-generator "datomic.id")) 18 | 19 | (def om-tempid? 20 | (namespace-match-generator "om.tempid")) 21 | 22 | (defn walk+state [f x & [init-state]] 23 | (let [state (atom (or init-state {}))] 24 | (clojure.walk/postwalk 25 | #(let [state' (f @state %)] 26 | (reset! state state') 27 | %) 28 | x) 29 | @state)) 30 | 31 | (defn collect-om-tempids [x] 32 | (walk+state (fn [state node] 33 | (if (om-tempid? node) 34 | (conj state node) 35 | state)) 36 | x #{})) 37 | 38 | (defn rewrite-tempids 39 | "Rewrite tempid keywords in the given state using the tid->rid map. 40 | Leaves the keyword alone if the map does not contain an entry for it. 41 | Only considers things that match `prefix-p` or tempid?" 42 | [state tid->rid & [prefix-p]] 43 | (walk/prewalk #(if ((or prefix-p datomic-id?) %) 44 | (get tid->rid % %) %) 45 | state)) 46 | 47 | (defn uuid [] (str (java.util.UUID/randomUUID))) 48 | 49 | (defn rewrite-om-tempids [server-tx] 50 | (let [om-tempids (collect-om-tempids server-tx) 51 | fake-omt->real-omt (into {} (map #(vector % (omt/tempid (uuid))) om-tempids))] 52 | [(rewrite-tempids server-tx fake-omt->real-omt om-tempid?) 53 | (set/map-invert fake-omt->real-omt)])) 54 | 55 | (defn extract-tempids 56 | "returns a tuple where the second element is a set of all the mutation tempids 57 | and the first is stuff without the :tempids k-v pair in the mutation values" 58 | [stuff] 59 | (let [tempids (atom {})] 60 | [(into {} 61 | (map 62 | (fn [[k v]] 63 | (if (symbol? k) 64 | (do 65 | (swap! tempids merge (:tempids v)) 66 | [k (dissoc v :tempids)]) 67 | [k v])) 68 | stuff)) 69 | @tempids])) 70 | 71 | (defn recursive-sort-by [f x] 72 | (walk/prewalk 73 | #(if (and (sequential? %) (not (map-entry? %))) 74 | (into (empty %) (sort-by f %)) 75 | %) 76 | x)) 77 | -------------------------------------------------------------------------------- /src/untangled/server/impl/util.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.impl.util 2 | (:require 3 | om.tempid 4 | [clojure.tools.namespace.find :refer [find-namespaces]] 5 | [clojure.java.classpath :refer [classpath]] 6 | [om.next.impl.parser :as omp])) 7 | 8 | (defn deep-merge [& xs] 9 | (if (every? map? xs) 10 | (apply merge-with deep-merge xs) 11 | (last xs))) 12 | 13 | (defn strip-parameters 14 | "Removes parameters from the query, e.g. for PCI compliant logging." 15 | [query] 16 | (-> (clojure.walk/prewalk #(if (map? %) (dissoc % :params) %) (omp/query->ast query)) (omp/ast->expr true))) 17 | -------------------------------------------------------------------------------- /src/untangled/server/protocol_support.clj: -------------------------------------------------------------------------------- 1 | (ns untangled.server.protocol-support 2 | (:require 3 | [clojure.test] 4 | [clojure.walk :as walk] 5 | [com.stuartsierra.component :as component] 6 | [om.tempid :as omt] 7 | [taoensso.timbre :as timbre] 8 | [untangled-spec.core :refer [specification behavior provided component assertions]] 9 | [untangled.server.impl.components.handler :as h] 10 | [untangled.server.impl.protocol-support :as impl])) 11 | 12 | (defn process-tx 13 | "For backwards compatability between make-untangled-test-server & untangled-system" 14 | [system tx] 15 | (let [mock-user-claims (get-in system 16 | (if (:openid-config system) 17 | [:openid-config :value] 18 | [:test-openid-mock :openid-mock/claims])) 19 | api-handler-key (:untangled.server.core/api-handler-key (meta system)) 20 | {:keys [env handler]} (if api-handler-key 21 | {:env {} :handler (:handler (get system api-handler-key))} 22 | (let [{:keys [api-parser env]} (:handler system)] 23 | {:env env :handler (fn [env tx] 24 | (h/api {:parser api-parser :env env :transit-params tx}))})) 25 | env (cond-> env mock-user-claims (assoc-in [:request :user] mock-user-claims))] 26 | (:body (handler env tx)))) 27 | 28 | (defn check-response-to-client 29 | "Tests that the server responds to a client transaction as specificied by the passed-in protocol data. 30 | See Protocol Testing README. 31 | 32 | 1. `app`: an instance of UntangledSystem injected with a `::seeder` component. See Protocol Testing README. 33 | 2. `data`: a map with `server-tx`, the transaction sent from the client to execute on the server, and `response`, 34 | the expected return value when the server runs the transaction 35 | 3. Optional named parameters 36 | `on-success`: a function of 2 arguments, taking the parsing environment and the server response for extra validation. 37 | `prepare-server-tx`: allows you to modify the transaction recevied from the client before running it, using the 38 | seed result to remap seeded tempids." 39 | [app {:keys [server-tx response] :as data} & {:keys [on-success prepare-server-tx which-db]}] 40 | (let [system (component/start app)] 41 | (try 42 | (let [;; for backwards compatability 43 | seeder ((some-fn ::seeder :seeder) system) 44 | _ (assert (or (not seeder) 45 | (contains? seeder :seed-result)) 46 | (str "Seeder component was not of expected type: <" seeder "> in system w/ keys: " (keys system))) 47 | 48 | seeder-result (get seeder :seed-result) 49 | _ (timbre/debug :seeder-result seeder-result) 50 | _ (when (= :disjoint seeder-result) 51 | (component/stop system) 52 | (assert false "seed data tempids must have no overlap")) 53 | 54 | datomic-tid->rid (if which-db 55 | (or (get seeder-result which-db) 56 | (throw (ex-info "Invalid which-db" 57 | {:which-db which-db 58 | :valid-options (keys seeder-result)}))) 59 | (apply merge (vals seeder-result))) 60 | _ (timbre/debug :datomic-tid->rid datomic-tid->rid) 61 | prepare-server-tx+ (if prepare-server-tx 62 | #(prepare-server-tx % datomic-tid->rid) 63 | identity) 64 | [server-tx+ real-omt->fake-omt] (-> (impl/rewrite-tempids server-tx datomic-tid->rid) 65 | impl/rewrite-om-tempids 66 | (update 0 prepare-server-tx+)) 67 | _ (timbre/debug :server-tx server-tx+) 68 | 69 | ;; for backwards compatability 70 | server-response (process-tx system server-tx+) 71 | 72 | _ (timbre/debug :server-response server-response) 73 | [response-without-tempid-remaps om-tempid->datomic-id] (impl/extract-tempids server-response) 74 | rewrite-response #(-> % 75 | ;;datomic rid->tid 76 | (impl/rewrite-tempids 77 | (clojure.set/map-invert datomic-tid->rid) 78 | integer?) 79 | ;;datomic-tid -> om-tempid 80 | (impl/rewrite-tempids 81 | (clojure.set/map-invert om-tempid->datomic-id) 82 | integer?) 83 | ;; om-tempid -> fake-om-tempid 84 | (impl/rewrite-tempids 85 | real-omt->fake-omt 86 | omt/tempid?)) 87 | response-to-check (rewrite-response response-without-tempid-remaps) 88 | sorted-response-to-check (impl/recursive-sort-by hash response-to-check) 89 | _ (timbre/debug :response-to-check response-to-check) 90 | om-tempids-to-check (impl/rewrite-tempids 91 | (set (keys om-tempid->datomic-id)) 92 | real-omt->fake-omt 93 | omt/tempid?) 94 | om-tids (impl/collect-om-tempids server-tx) 95 | sorted-response (impl/recursive-sort-by hash response)] 96 | 97 | (behavior (str "Server response should contain tempid remappings for: " om-tids) 98 | (assertions 99 | om-tempids-to-check => om-tids)) 100 | 101 | (assertions 102 | "Server response should match data/response" 103 | sorted-response-to-check => sorted-response) 104 | 105 | (when on-success 106 | (let [env+seed-result (reduce (fn [env [db-name seed-result]] 107 | (assoc-in env [db-name :seed-result] seed-result)) 108 | system seeder-result)] 109 | (on-success (assoc env+seed-result :remap-fn rewrite-response) 110 | server-response)))) 111 | 112 | (finally 113 | (component/stop system))))) 114 | 115 | (defn with-behavior [_ value] value) 116 | --------------------------------------------------------------------------------