├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── codox-transforms.edn ├── doc ├── 01-req-resp-examples.md ├── 02-event-source-examples.md ├── 03-websocket-examples.md ├── assets │ ├── css │ │ └── docs.css │ └── kvlt.png └── notes.md ├── project.clj ├── src └── kvlt │ ├── chan.cljc │ ├── core.cljc │ ├── event_source.cljc │ ├── middleware.cljc │ ├── middleware │ ├── params.cljc │ └── util.cljc │ ├── platform │ ├── event_source.clj │ ├── event_source.cljs │ ├── http.clj │ ├── http.cljs │ ├── util.clj │ ├── util.cljs │ ├── websocket.clj │ ├── websocket.cljs │ └── xhr.cljs │ ├── util.cljc │ └── websocket.cljc └── test └── kvlt └── test ├── chan.cljc ├── core.cljc ├── middleware.cljc ├── middleware ├── params.cljc └── util.cljc ├── platform ├── event_source.cljc ├── http.cljc └── websocket.cljc ├── runner.cljs ├── server.clj └── util.cljc /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | out 11 | /repl.clj 12 | /node_modules 13 | /.repl 14 | /.cljs_node_repl 15 | travis.log 16 | generate-docs.sh 17 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | sudo: required 3 | dist: trusty 4 | jdk: 5 | - oraclejdk8 6 | env: 7 | global: 8 | - CHROME_BIN=chromium-browser 9 | - DISPLAY=:99.0 10 | addons: 11 | firefox: latest 12 | before_install: 13 | - nvm install 5 14 | - npm install -g karma karma-cli karma-chrome-launcher karma-firefox-launcher karma-cljs-test 15 | - sh -e /etc/init.d/xvfb start 16 | - wget https://raw.githubusercontent.com/technomancy/leiningen/stable/bin/lein && chmod +x lein 17 | - lein npm install 18 | - lein test-server & 19 | - while ! nc -q 1 localhost 5000 25 | 26 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ![Hail Satan](https://raw.githubusercontent.com/nervous-systems/kvlt/master/doc/assets/kvlt.png) [![Build Status](https://travis-ci.org/nervous-systems/kvlt.svg?branch=master)](https://travis-ci.org/nervous-systems/kvlt) 2 | 3 | Attempts to present a uniform, asychronous client interface for HTTP across JVM / Node / browsers. 4 | 5 | [Latest documentation / examples](//nervous.io/doc/kvlt) 6 | 7 | [![Clojars Project](http://clojars.org/io.nervous/kvlt/latest-version.svg)](http://clojars.org/io.nervous/kvlt) 8 | 9 | ### Features 10 | - Supports Clojure/JVM, Clojurescript/Node and Clojurescript/Browser 11 | - Individual deferred values are exposed via promises ([kvlt.core](//nervous.io/doc/kvlt/kvlt.core.html)), or asynchronous channels ([kvlt.chan](//nervous.io/doc/kvlt/kvlt.chan.html)) 12 | - `core.async`-based support for Websockets and Server-sent Events 13 | - Raw responses available as Javascript typed arrays (on Node, and in browsers with [XHR Level 2](https://www.w3.org/TR/XMLHttpRequest2/) support) 14 | - Ring-like API 15 | 16 | ### Requirements 17 | 18 | - Clojure use requires JDK8 19 | 20 | ### Todo / Notes 21 | - Automated/CI testing is currently limited to JVM, Node and recent Chrome & Firefox builds 22 | - No support for streamed requests/responses. Open to suggestions about how this might be handled across platforms 23 | - Young project, etc. - please file issues 24 | 25 | # Examples 26 | 27 | [kvlt.core/request!](//nervous.io/doc/kvlt/kvlt.core.html#var-request.21) 28 | returns a [promesa](https://github.com/funcool/promesa) promise, which 29 | can be manipulated using promise-specific (e.g. `promesa/then`) 30 | operations, or treated as a monad using the primitives from 31 | [cats](https://github.com/funcool/cats). Below, we're working with 32 | something like: 33 | 34 | ```clojure 35 | (ns kvlt.examples 36 | (:require [kvlt.core :as kvlt] 37 | [promesa.core :as p])) 38 | ``` 39 | 40 | The default `:method` is `:get`: 41 | 42 | ```clojure 43 | (p/alet [{:keys [status]} (p/await (kvlt/request! {:url url}))] 44 | (is (= status 200))) 45 | ``` 46 | 47 | ## Explicit Callback 48 | 49 | ```clojure 50 | (p/then 51 | (kvlt/request! {:url url}) 52 | (fn [{:keys [status]}] 53 | (is (= status 200)))) 54 | ``` 55 | 56 | ## core.async 57 | 58 | The [kvlt.chan](//nervous.io/doc/kvlt/kvlt.chan.html) namespace 59 | parallels the promise-driven `kvlt.core`, using asynchronous channels 60 | to communicate deferred values. 61 | 62 | ```clojure 63 | (go 64 | (let [{:keys [status]} (! ws {:climate :good, :bribery :tolerated}) 147 | (let [instructions (! ws "Behind_the_Wall_of_Sleep.wma") 15 | (is (= "OK" (! ws {:climate :good, :bribery :tolerated}) 31 | (let [instructions ( .anchor { 35 | margin-top: 0; 36 | } 37 | 38 | body h1, body h2, body h3, body h4 { 39 | font-family: Lato; 40 | font-weight: normal; 41 | } 42 | 43 | body .markdown pre, body .markdown pre > code, body pre.deps { 44 | background: none; 45 | border: none; 46 | font-size: inherit; 47 | } 48 | 49 | body .markdown code:not(.hljs) { 50 | margin: 0; 51 | background: none; 52 | } 53 | 54 | .project-name { 55 | text-transform: lowercase; 56 | } 57 | 58 | 59 | body .sidebar.primary, body .sidebar.secondary { 60 | background: none; 61 | border: none; 62 | } 63 | 64 | body .namespace-docs h3, body .namespace a, body code, body pre { 65 | font-family: "Droid Sans Mono", monospace; 66 | } 67 | 68 | .doc { 69 | margin-bottom: 0px; 70 | } 71 | 72 | body .public { 73 | border: none; 74 | } 75 | 76 | 77 | body a, body a span { 78 | color: #0096cc; 79 | text-decoration: none; 80 | } 81 | 82 | body .sidebar.secondary li.current a { 83 | border-color: #0096cc; 84 | } 85 | 86 | .github img { 87 | width: 160px; 88 | opacity: 0.5; 89 | } 90 | -------------------------------------------------------------------------------- /doc/assets/kvlt.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nervous-systems/kvlt/26fe43eb9de6d7cc7ad8a466953fa0ffe09889ca/doc/assets/kvlt.png -------------------------------------------------------------------------------- /doc/notes.md: -------------------------------------------------------------------------------- 1 | # API Notes 2 | 3 | ## Request Body 4 | 5 | Supported types for the `:body` value of a request are strings & byte arrays. 6 | In Clojurescript, byte arrays are expected to be represented as typed arrays 7 | (available on Node, and in [modern 8 | browsers](http://caniuse.com/#feat=typedarrays)). All request and response 9 | bodies are immediate - there is currently no partial/stream representation on 10 | either side. 11 | 12 | ## Response Body 13 | 14 | The baseline user-facing response `:body` representation is a UTF-8 encoded 15 | string. The `:as` request key can be used to change this behaviour. Helpful 16 | values include: 17 | 18 | ### `:byte-array` 19 | 20 | In Clojurescript, this'll be an `ArrayBuffer` (both in Node, and in browsers 21 | which support that API). It's _strongly_ suggested to use a byte array 22 | representation for non UTF-8 response bodies, if you find yourself doing that 23 | kind of thing - encoding strings in Javascript is no fun. 24 | 25 | ### `:auto` 26 | 27 | The `kvlt.middleware/from-content-type` multimethod will be deferred to, 28 | dispatching on the `:content-type` header of the response. There are default 29 | implementations for e.g. "application/edn", "application/json", 30 | "application/x-www-form-urlencoded" and so on. 31 | 32 | ### `:json`, `:edn`, `:x-www-form-urlencoded`, etc. 33 | 34 | These can be considered to force the response to be interpreted as with `:auto`, 35 | if the given value were the minor type of an assumed "application/" content 36 | type. E.g. `{:as :json}` - regardless of response content type - will behave 37 | like `{:as auto}` in the presence of an "application/json" response content 38 | type. 39 | 40 | ## Quirks 41 | 42 | ### `:form-param-encoding` 43 | 44 | In Clojurescript, if a value other than "UTF-8" is supplied for this key, 45 | a warning will be printed to the console and the encoding will be ignored. 46 | 47 | ### Accept-Encoding 48 | 49 | The XHR specification forbids clients to specify an `Accept-Encoding` header, 50 | and many (all) browsers quietly supply their own value, in line with the 51 | platform's decompression capabilities. 52 | 53 | - Clojure: `:accept-encoding` is always set to "gzip, deflate" 54 | - Clojurescript + browser: `:accept-encoding` is likely implicitly set to some superset of "gzip, deflate", depending on the environment 55 | - Clojurescript + Node: `:accept-encoding` is not ever set. This is due to the third-party Node XHR shim conforming to the specification, while also neglecting to convey an implicit value, as in the browser. Easily fixable, though the current behaviour is that Node will not ever request compressed output. 56 | 57 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject io.nervous/kvlt "0.1.4" 2 | :url "https://github.com/nervous-systems/kvlt" 3 | :description "Multi-target Clojure/script HTTP client" 4 | :license {:name "Unlicense" :url "http://unlicense.org/UNLICENSE"} 5 | :scm {:name "git" :url "https://github.com/nervous-systems/kvlt"} 6 | :codox 7 | {:source-paths ["src"] 8 | :metadata {:doc/format :markdown} 9 | :html 10 | {:transforms 11 | ~(read-string (slurp "codox-transforms.edn"))} 12 | :source-uri "https://github.com/nervous-systems/kvlt/blob/master/{filepath}#L{line}"} 13 | :source-paths ["src"] 14 | :dependencies [[org.clojure/clojure "1.8.0"] 15 | [org.clojure/clojurescript "1.8.51"] 16 | [org.clojure/core.async "0.2.395"] 17 | 18 | [funcool/promesa "1.6.0"] 19 | [funcool/cats "2.0.0"] 20 | [aleph "0.4.2-alpha8"] 21 | [com.taoensso/timbre "4.7.4"] 22 | [commons-codec/commons-codec "1.9"]] 23 | :plugins [[lein-npm "0.6.2"] 24 | [lein-cljsbuild "1.1.4"] 25 | [lein-doo "0.1.7"] 26 | [lein-codox "0.10.1"]] 27 | :npm {:dependencies [[request "2.72.0"] 28 | [websocket "1.0.22"] 29 | [eventsource "0.1.6"] 30 | [source-map-support "0.4.0"]]} 31 | :cljsbuild {:builds 32 | [{:id "node-test" 33 | :source-paths ["src" "test"] 34 | :compiler {:output-to "target/node-test/kvlt.js" 35 | :output-dir "target/node-test" 36 | :target :nodejs 37 | :optimizations :none 38 | :main kvlt.test.runner}} 39 | {:id "node-test-adv" 40 | :source-paths ["src" "test"] 41 | :compiler {:output-to "target/node-test-adv/kvlt.js" 42 | :output-dir "target/node-test-adv" 43 | :target :nodejs 44 | :optimizations :advanced 45 | :main kvlt.test.runner}} 46 | {:id "generic-test" 47 | :source-paths ["src" "test"] 48 | :compiler {:output-to "target/generic-test/kvlt.js" 49 | :optimizations :simple 50 | :main kvlt.test.runner}}]} 51 | :auto {"codox" {:file-pattern #"\.(clj[cs]?|md)$" 52 | :paths ["doc" "src"]}} 53 | :aliases {"test-server" ["run" "-m" "kvlt.test.server"]} 54 | :profiles {:dev {:source-paths ["test-server" "test"] 55 | :dependencies [[compojure "1.3.3"] 56 | [clj-http "2.0.0"]]}}) 57 | -------------------------------------------------------------------------------- /src/kvlt/chan.cljc: -------------------------------------------------------------------------------- 1 | (ns kvlt.chan 2 | (:require [#? (:clj clojure.core.async 3 | :cljs cljs.core.async) :as async] 4 | [kvlt.core :as kvlt] 5 | [promesa.core :as p])) 6 | 7 | (defn- promise->chan [p chan close?] 8 | (let [chan (or chan (async/chan)) 9 | done (fn [x] 10 | (async/put! chan x) 11 | (when close? 12 | (async/close! chan)))] 13 | (p/branch p done done) 14 | chan)) 15 | 16 | (defn request! 17 | "Channeled version of [[kvlt.core/request!]]. Behaviour is identical, however 18 | the response (or error) will be placed on the returned channel." 19 | [req & [{:keys [chan close?] :or {close? true}}]] 20 | (promise->chan (kvlt/request! req) chan close?)) 21 | 22 | (defn websocket! 23 | "Channeled version of [[kvlt.core/websocket!]]. Behaviour is identical, 24 | however the initial deferred value is represented as a channel on which the 25 | eventual websocket communication channel will be placed." 26 | [url & [ws-opts {:keys [chan close?] :or {close? true}}]] 27 | (promise->chan (kvlt/websocket! url ws-opts) chan close?)) 28 | -------------------------------------------------------------------------------- /src/kvlt/core.cljc: -------------------------------------------------------------------------------- 1 | (ns kvlt.core 2 | (:require [kvlt.platform.http :as platform.http] 3 | [kvlt.platform.websocket :as platform.websocket] 4 | [kvlt.platform.event-source :as platform.event-source] 5 | [kvlt.middleware :as mw] 6 | [kvlt.middleware.params :as mw.params] 7 | [taoensso.timbre :as log])) 8 | 9 | (def ^:no-doc default-middleware 10 | [mw/decompress 11 | mw/as 12 | 13 | mw.params/form 14 | mw.params/short-form 15 | mw.params/query 16 | mw.params/short-query 17 | 18 | mw/port 19 | mw/method 20 | mw/default-method 21 | mw/accept 22 | mw/accept-encoding 23 | mw/keyword-headers 24 | mw/lower-case-headers 25 | mw/content-type 26 | mw/default-content-type 27 | mw/body-type-hint 28 | mw/basic-auth 29 | mw/oauth-token 30 | mw/url 31 | 32 | mw/error]) 33 | 34 | (def ^:private request* (reduce #(%2 %1) platform.http/request! default-middleware)) 35 | 36 | (defn quiet! "Disable request/response logging" [] 37 | (log/merge-config! {:ns-blacklist ["kvlt.*"]})) 38 | 39 | (defn request! 40 | "Issues the HTTP request described by the given map, returning a 41 | promise resolving to a map describing the response, or rejected with 42 | an `ExceptionInfo` instance having a similar map associated with it. 43 | See [[kvlt.middleware/error]] for more details of the error 44 | conditions & behaviour. 45 | 46 | This function applies a variety of middleware to 47 | `kvlt.platform.http/request!`, in order to transform the input map 48 | into something Ring-like - and to perform similar transformations to 49 | the response." 50 | [req] 51 | (request* req)) 52 | 53 | (defn websocket! 54 | "Initiates a websocket connection with the given \"ws:\" or \"wss:\" 55 | URL and returns a promise resolving to a `core.async` channel. If a 56 | connection cannot be established, the promise'll be rejected with an 57 | `ExceptionInfo` instance. 58 | 59 | Reads and writes on the resulting channel are delegated to distinct 60 | read/write channels - the \"read\" side being by default an 61 | unbuffered channel populated with messages from the websocket, and 62 | the \"write\" side, also unbuffered, being drained into the 63 | websocket itself. The `read-chan` and `write-chan` options can be 64 | specified to e.g. apply a transducer to incoming/outgoing values. 65 | 66 | Platform specific options, such as `max-frame-payload` for Clojure, can be 67 | specified as keywords in the `kvlt.platform` namespace. 68 | 69 | Closing the returned channel terminates the websocket connection, 70 | and will close the underlying read & write channels (unless `close?` 71 | is false, in which event it'll close neither). The channel will be 72 | closed (and the same `close?` behaviour applied) if a transport 73 | error occurs after the connection has been established." 74 | [url & [{:keys [read-chan write-chan close? format] :as opts}]] 75 | (platform.websocket/request! url opts)) 76 | 77 | (defn event-source! 78 | "[Server-sent Events](https://html.spec.whatwg.org/multipage/comms.html#server-sent-events) client. 79 | 80 | Initiates a long-lived HTTP connection with `url`, placing maps 81 | representing incoming events onto a `core.async` channel. 82 | 83 | By default, only events of type `:message` will be considered (per 84 | spec). To listen to a set of specific event types, `events` (a set 85 | of keywords) may be specified. You may also specify `:*` to receive 86 | all events. 87 | 88 | The returned channel, when closed, will terminate the underlying SSE 89 | connection. By default, the channel is unbuffered - though an 90 | arbitrary channel can be passed in via `chan` - and will be closed 91 | when the connection channel closes (or on error), unless `close?` is 92 | false. On error, the connection will not be automatically 93 | re-established. 94 | 95 | `as` is some symbolic value (defaulting to `:string` - no-op) which 96 | is used as [[kvlt.event-source/format-event]]'s dispatch value. 97 | 98 | `options` is a map containing key/value options to pass to the 99 | underlying implementation. A cookie can be added to the request, 100 | for example, by setting `options` to: 101 | 102 | {:headers {\"Cookie\" \"test=test\"}} 103 | 104 | for the Clojure environment. The header names can be specified 105 | as strings or keywords. The accepted options vary by 106 | platform, with unknown options being silently ignored. 107 | Consult [browser](https://developer.mozilla.org/en-US/docs/Web/API/EventSource/EventSource) 108 | and [node](https://www.npmjs.com/package/eventsource) API 109 | specifications for details. 110 | " 111 | [url & [{:keys [events as chan close? options] 112 | :or {events #{:message} 113 | as :string 114 | close? true 115 | options {}}}]] 116 | (platform.event-source/request! 117 | url {:events events 118 | :format as 119 | :chan chan 120 | :close? close? 121 | :options options})) 122 | -------------------------------------------------------------------------------- /src/kvlt/event_source.cljc: -------------------------------------------------------------------------------- 1 | (ns kvlt.event-source 2 | (:require [#?(:clj clojure.edn :cljs cljs.reader) :as edn] 3 | [kvlt.platform.util :refer [parse-json]])) 4 | 5 | (defmulti format-event 6 | "Dispatching on the (first) `format` param (corresponding 7 | to [[kvlt.core/event-source!]]'s `:format` param), transform an incoming event 8 | prior to placement on the source's channel. 9 | 10 | Implementations receive (and are expected to return the event map) not only 11 | its body." 12 | (fn [format event] format)) 13 | 14 | (defmethod format-event :default [_ e] e) 15 | (defmethod format-event :edn [_ e] (edn/read-string e)) 16 | (defmethod format-event :json [_ e] (parse-json e)) 17 | -------------------------------------------------------------------------------- /src/kvlt/middleware.cljc: -------------------------------------------------------------------------------- 1 | (ns kvlt.middleware 2 | (:require [#?(:clj clojure.edn :cljs cljs.reader) :as edn] 3 | [kvlt.middleware.util :as util #? (:clj :refer :cljs :refer-macros) [defmw]] 4 | [kvlt.util #? (:clj :refer :cljs :refer-macros) [with-doc-examples!]] 5 | [kvlt.platform.util :as platform.util] 6 | [clojure.set :as set] 7 | [clojure.walk :as walk] 8 | [clojure.string :as str] 9 | [cats.core :as m] 10 | [kvlt.util :refer [map-keys]])) 11 | 12 | (defn ^:no-doc header 13 | ([{hs :headers :as resp} k] 14 | (and hs (some hs [k (name k)]))) 15 | ([m k v] 16 | (update m :headers 17 | (fn [h] 18 | (-> h 19 | (dissoc k (name k)) 20 | (assoc (name k) v)))))) 21 | 22 | (defn- body->string [{:keys [body] :as resp}] 23 | (platform.util/byte-array->str 24 | body (util/charset (header resp :content-type)))) 25 | 26 | (defmulti from-content-type 27 | "Used by [[as]] to transform an incoming response. Dispatches on 28 | `:content-type`' header, as a namespace-qualified 29 | keyword (e.g. `:application/edn`). The input and output are the 30 | top-level response map, not only the response body. 31 | 32 | The default implementation (i.e. unrecognized content-type) returns 33 | the response map unmodified." 34 | (fn [resp] 35 | (-> resp (header :content-type) util/->content-type keyword))) 36 | 37 | (defmethod from-content-type :default [resp] 38 | resp) 39 | (defmethod from-content-type :application/edn [resp] 40 | (assoc resp :body (edn/read-string (body->string resp)))) 41 | (defmethod from-content-type :application/json [{:keys [body] :as resp}] 42 | (assoc resp :body (platform.util/parse-json (body->string resp)))) 43 | 44 | (defn- hint->body-type [x] 45 | (when (and (keyword? x) (= "kvlt.body" (namespace x))) 46 | (keyword (name x)))) 47 | 48 | (defmw body-type-hint 49 | "Look for a body with a `:kvlt.body/`-prefixed metadata key, setting 50 | the request's `:type` and `:form-params` keys 51 | accordingly (e.g. `:body ^:kvlt/edn {:x 1}`)" 52 | ^{:has :body} 53 | (fn [{:keys [body] :as req}] 54 | (if-let [t (->> body meta keys (some hint->body-type))] 55 | (-> req 56 | (assoc :type (keyword t) :form-params body) 57 | (dissoc :body)) 58 | req))) 59 | 60 | (with-doc-examples! body-type-hint 61 | [{:method :post 62 | :body ^:kvlt.body/edn [1 2 3]} 63 | {:method :post 64 | :form-params [1 2 3] 65 | :type :edn}]) 66 | 67 | (defmw content-type 68 | "Turn request's `:content-type` (or `:type`), if any, and 69 | `:character-encoding`, if any, into a \"content-type\" header & leave 70 | top-level `:content-type` key in place. " 71 | (fn [{:keys [type body character-encoding] :as req}] 72 | (let [{:keys [content-type] :as req} 73 | (cond-> req type (assoc :content-type type))] 74 | (cond-> req 75 | content-type 76 | (header :content-type 77 | (util/->content-type content-type character-encoding)))))) 78 | 79 | (with-doc-examples! 80 | content-type 81 | [{:content-type "text/html" 82 | :character-encoding "US-ASCII"} 83 | {:headers {:content-type "text/html; charset=US-ASCII"} 84 | :content-type "text/html"}]) 85 | 86 | (defmw accept 87 | "Turn request's `:accept` value, if any, into an \"accept\" header & 88 | remove the top-level key." 89 | ^{:has :accept :removing :accept} 90 | (fn [{:keys [accept] :as req}] 91 | (header req :accept (util/->content-type accept)))) 92 | 93 | (with-doc-examples! accept 94 | [{:accept :edn} {:headers {"accept" "application/edn"}}]) 95 | 96 | (defn- as-key [resp] 97 | (-> resp meta :kvlt/request :as)) 98 | 99 | (defmulti ^:no-doc as-type as-key) 100 | (defmethod as-type :string [{:keys [body] :as resp}] 101 | #? (:clj 102 | (update resp :body platform.util/byte-array->str 103 | (util/charset (header resp :content-type))) 104 | :cljs resp)) 105 | 106 | (defmethod as-type :byte-array [{:keys [body] :as resp}] 107 | (assert 108 | (platform.util/byte-array? body) 109 | "For platform-specific reasons, :as :byte-array is special-cased in 110 | kvlt.platform.http/request") 111 | resp) 112 | (defmethod as-type :auto [resp] (from-content-type resp)) 113 | (defmethod as-type :default [{:keys [headers] :as resp}] 114 | (let [t (header resp :content-type) 115 | resp (assoc resp :orig-content-type t)] 116 | (from-content-type 117 | (header resp :content-type (util/->content-type (as-key resp)))))) 118 | 119 | (defn- parsing-error [resp e] 120 | (let [error (platform.util/exception->map 121 | e {:error :middleware-error 122 | :type :middleware-error})] 123 | (cond-> resp 124 | (not (resp :error)) (merge error)))) 125 | 126 | (defmw as 127 | "Response body type conversion --- `:string` `:byte-array` `:auto` `:json` `:edn` etc.. 128 | 129 | See [[from-content-type]] for custom conversions." 130 | #(merge {:as :string} %) 131 | (fn [resp] 132 | (try 133 | (as-type resp) 134 | (catch #? (:clj Exception :cljs js/Error) e 135 | (parsing-error resp e))))) 136 | 137 | (defmw accept-encoding 138 | "Convert the `:accept-encoding` option (keyword/str, or collection of) to an 139 | acceptable `Accept-Encoding` header. 140 | 141 | This middleware is not likely to have any effect in a browser 142 | environment." 143 | ^{:has :accept-encoding :removing :accept-encoding} 144 | (fn [{v :accept-encoding :as req}] 145 | (header 146 | req 147 | :accept-encoding 148 | (if (coll? v) 149 | (str/join ", " (map name v)) 150 | (name v))))) 151 | 152 | (with-doc-examples! accept-encoding 153 | [{:accept-encoding :origami} 154 | {:headers {:accept-encoding "origami"}}] 155 | [{:accept-encoding [:a :b]} 156 | {:headers {:accept-encoding "a, b"}}]) 157 | 158 | (defmw method 159 | "Rename request's `:method` key to `:request-method`" 160 | ^{:has :method :removing :method} 161 | (fn [{m :method :as req}] 162 | (assoc req :request-method m))) 163 | 164 | (defmw port 165 | "Rename request's `:port` key to `:server-port`" 166 | ^{:has :port :removing :port} 167 | (fn [{port :port :as req}] 168 | (assoc req :server-port port))) 169 | 170 | (with-doc-examples! method 171 | [{:method :get} {:request-method :get}]) 172 | 173 | (defmw url 174 | "Turn request's `:url` value, if any, into top-level `:scheme`, 175 | `:server-name`, `:server-port`, `:uri`, `:query-string`, and 176 | `:user-info` keys" 177 | ^{:has :url :removing :url} 178 | (fn [{url :url :as req}] 179 | (merge req (util/parse-url url)))) 180 | 181 | (with-doc-examples! url 182 | [{:url "ftp://localhost:9/x?x=1"} 183 | {:scheme :ftp 184 | :server-name "localhost" 185 | :server-port 9 186 | :uri "/x" 187 | :user-info nil 188 | :query-string "x=1"}]) 189 | 190 | (defmw default-content-type 191 | "Add `:content-type` key having value `:text/plain`, if no `:content-type` present. 192 | 193 | Assumes placement before [[content-type]]." 194 | (fn [req] 195 | (if (and (req :body) (not (or (req :content-type) (header req :content-type)))) 196 | (assoc req :content-type :text/plain) 197 | req))) 198 | 199 | (defmw keyword-headers 200 | "Convert keys within request's `:headers` value to strings, and 201 | response's `:headers` values to keywords. " 202 | [:headers walk/stringify-keys] 203 | [:headers walk/keywordize-keys]) 204 | 205 | (def ^:private lower-case 206 | #(cond-> (str/lower-case (name %)) (keyword? %) keyword)) 207 | 208 | (defmw lower-case-headers 209 | "Convert keys within request & response's `:headers` value to lower 210 | case." 211 | [:headers #(map-keys lower-case %)] 212 | [:headers #(map-keys lower-case %)]) 213 | 214 | (defmw basic-auth 215 | "Convert `:basic-auth` values (vector or map) into an 216 | `:authorization` header." 217 | ^{:has :basic-auth :removing :basic-auth} 218 | (fn [{:keys [basic-auth] :as req}] 219 | (header req :authorization (util/basic-auth basic-auth)))) 220 | 221 | (with-doc-examples! basic-auth 222 | [{:basic-auth ["user" "pass"]} {:headers {:authorization "Basic ..."}}] 223 | [{:basic-auth {:username "user" :password "pass"}} 224 | {:headers {:authorization "Basic ..."}}]) 225 | 226 | (defmw oauth-token 227 | "Convert `:oauth-token` value into an `:authorization` header" 228 | ^{:has :oauth-token :removing :oauth-token} 229 | (fn [{:keys [oauth-token] :as req}] 230 | (header req :authorization (str "Bearer " oauth-token)))) 231 | 232 | (with-doc-examples! oauth-token 233 | [{:oauth-token "xyz"} {:headers {:authorization "Bearer xyz"}}]) 234 | 235 | (defmw default-method 236 | "Merge request map with `{:method :get}`. 237 | 238 | Assumes placement before [[method]]." 239 | #(merge {:method :get} %)) 240 | 241 | (with-doc-examples! default-method 242 | [{} {:method :get}]) 243 | 244 | (defmulti decompress-body 245 | "Dispatch on the response's `:content-encoding` header value. 246 | Clojure implementations exist for \"gzip\" and \"deflate\"." 247 | (fn [resp] 248 | (and (:body resp) (header resp :content-encoding)))) 249 | 250 | (defn ^:no-doc lift-content-encoding [{{:strs [content-encoding]} :headers :as resp}] 251 | (-> resp 252 | (assoc :orig-content-encoding content-encoding) 253 | (update :headers dissoc "content-encoding"))) 254 | 255 | (defmethod decompress-body "gzip" [{:keys [body] :as resp}] 256 | (let [body (platform.util/gunzip body)] 257 | (lift-content-encoding (assoc resp :body body)))) 258 | 259 | (defmethod decompress-body "deflate" [{:keys [body] :as resp}] 260 | (let [body (platform.util/inflate body)] 261 | (lift-content-encoding (assoc resp :body body)))) 262 | 263 | (defmethod decompress-body :default [resp] 264 | (lift-content-encoding resp)) 265 | 266 | (defmw decompress 267 | "Response body decompression. Defaults request's \"Accept-Encoding\" header. 268 | Can be disabled per-request via `:decompress-body? false'" 269 | ^{:removing :accept-encoding} 270 | (fn [req] 271 | (cond-> req 272 | (and (not (false? (req :decompress-body?))) 273 | (not (header req :accept-encoding))) 274 | (header :accept-encoding "gzip, deflate"))) 275 | (fn [resp] 276 | #? (:clj (let [decomp? (-> resp meta :kvlt/request :decompress-body? false? not)] 277 | (cond-> resp (and decomp? (not-empty (resp :body))) decompress-body)) 278 | :cljs resp))) 279 | 280 | (def ^:no-doc unexceptional-status? 281 | #{200 201 202 203 204 205 206 207 300 301 302 303 304 307}) 282 | 283 | (def ^:no-doc status->reason 284 | {100 :continue 285 | 101 :switching-protocols 286 | 200 :ok 287 | 201 :created 288 | 202 :accepted 289 | 203 :non-authoritative-information 290 | 204 :no-content 291 | 205 :reset-content 292 | 206 :partial-content 293 | 300 :multiple-choices 294 | 301 :moved-permanently 295 | 302 :found 296 | 303 :see-other 297 | 304 :not-modified 298 | 305 :use-proxy 299 | 307 :temporary-redirect 300 | 400 :bad-request 301 | 401 :unauthorized 302 | 402 :payment-required ;; serious business 303 | 403 :forbidden 304 | 404 :not-found 305 | 405 :method-not-allowed 306 | 406 :not-acceptable 307 | 407 :proxy-authentication-required 308 | 408 :request-timeout 309 | 409 :conflict 310 | 410 :gone 311 | 411 :length-required 312 | 412 :precondition-failed 313 | 413 :request-entity-too-large 314 | 414 :request-uri-too-large 315 | 415 :unsupported-media-type 316 | 416 :requested-range-not-satisfiable 317 | 417 :expectation-failed 318 | 500 :internal-server-error 319 | 501 :not-implemented 320 | 502 :bad-gateway 321 | 503 :service-unavailable 322 | 504 :gateway-timeout 323 | 505 :http-version-not-supported}) 324 | 325 | (defmw error 326 | "Turn error responses into `ExceptionInfo` instances, with the full 327 | response map as the attached data. Additionally, a `:reason` 328 | value (e.g. `:service-unavailable`) will be used to augment the 329 | `:status` key. 330 | 331 | For uniformity, `:type` is provided as an alias for `:reason`, e.g." 332 | nil 333 | (fn [{:keys [message status cause error] :as resp}] 334 | (let [reason (status->reason status error)] 335 | (if (and (not error) (unexceptional-status? status)) 336 | (assoc resp :reason reason) 337 | (ex-info message 338 | (assoc resp 339 | :error (or error reason) 340 | :type reason 341 | :reason reason) 342 | cause))))) 343 | 344 | (with-doc-examples! error 345 | [{:status 500 346 | :reason :internal-server-error 347 | :type :internal-server-error 348 | :cause error? 349 | :headers ...}]) 350 | -------------------------------------------------------------------------------- /src/kvlt/middleware/params.cljc: -------------------------------------------------------------------------------- 1 | (ns kvlt.middleware.params 2 | (:require [clojure.string :as str] 3 | [kvlt.middleware.util :as util 4 | #? (:clj :refer :cljs :refer-macros) [defmw]] 5 | [kvlt.middleware.util :as util 6 | :refer [->mw ->content-type url-encode charset]] 7 | [kvlt.platform.util :refer [encode-json]])) 8 | 9 | (defn ^:no-doc query-string+encoding [params encoding] 10 | (str/join 11 | "&" 12 | (mapcat 13 | (fn [[k v]] 14 | (if (sequential? v) 15 | (map #(str (url-encode (name %1) encoding) 16 | "=" 17 | (url-encode (str %2) encoding)) 18 | (repeat k) v) 19 | [(str (url-encode (name k) encoding) 20 | "=" 21 | (url-encode (str v) encoding))])) 22 | params))) 23 | 24 | (defn ^:no-doc query-string [params & [content-type]] 25 | (let [encoding (charset content-type)] 26 | (query-string+encoding params encoding))) 27 | 28 | (defmw short-query 29 | "Rename request's `:query` key to `:query-params`" 30 | ^{:has :query :removing :query} 31 | (fn [{:keys [query] :as m}] 32 | (assoc m :query-params query))) 33 | 34 | (defmw query 35 | "Given a request having a `:query-params` map, append to the URL's 36 | query (`:query-string`) its URL-encoded string representation. " 37 | (fn [{:keys [query-params content-type] 38 | :or {content-type :x-www-form-urlencoded} :as req}] 39 | (cond-> req 40 | query-params 41 | (-> (dissoc :query-params) 42 | (update 43 | :query-string 44 | (fn [old new] (if-not (empty? old) (str old "&" new) new)) 45 | (query-string query-params (->content-type content-type))))))) 46 | 47 | (defmulti coerce-form-params 48 | "Turn a `:form-params` map into a string request body, dispatching 49 | on the qualified content type, as a namespaced 50 | keyword (e.g. `:application/edn`). 51 | 52 | The baseline implementation (for 53 | `:application/x-www-form-urlencoded`) looks at the request's 54 | `:form-param-encoding` to determine the character set of the output 55 | string, on platforms where this is supported." 56 | (fn [{:keys [content-type]}] 57 | (keyword (->content-type content-type)))) 58 | 59 | (defmethod coerce-form-params :application/x-www-form-urlencoded 60 | [{:keys [content-type form-params form-param-encoding]}] 61 | (if form-param-encoding 62 | (query-string+encoding form-params form-param-encoding) 63 | (query-string form-params (->content-type content-type)))) 64 | 65 | (defmethod coerce-form-params :application/edn [{:keys [form-params]}] 66 | (pr-str form-params)) 67 | 68 | (defmethod coerce-form-params :application/json [{:keys [form-params]}] 69 | (encode-json form-params)) 70 | 71 | (defmw short-form 72 | "Rename request's `:form` key to `:form-params`" 73 | ^{:has :form :removing :form} 74 | (fn [{:keys [form] :as m}] 75 | (assoc m :form-params form))) 76 | 77 | (defmw form 78 | "Given a request having a `:form-params` map and a method of `POST`, 79 | `PUT` or `PATCH`, use [[coerce-form-params]] to generate a request 80 | body. If no content type is supplied, a default of 81 | `application/x-www-form-urlencoded` is associated with the request, 82 | and passed to [[coerce-form-params]]. 83 | 84 | Assumes placement after [[kvlt.middleware/method]]" 85 | (fn [{:keys [form-params content-type request-method] 86 | :or {content-type :x-www-form-urlencoded} 87 | :as req}] 88 | (if (and form-params (#{:post :put :patch} request-method)) 89 | (let [content-type (->content-type content-type) 90 | req (assoc req :content-type content-type)] 91 | (assoc req :body (coerce-form-params req))) 92 | req))) 93 | -------------------------------------------------------------------------------- /src/kvlt/middleware/util.cljc: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc kvlt.middleware.util 2 | (:require [kvlt.platform.util :as platform.util] 3 | [cats.labs.promise] 4 | [clojure.string :as str] 5 | [cats.core :as m] 6 | [taoensso.timbre :as log] 7 | #? (:cljs [goog.crypt.base64 :as base64])) 8 | #? (:clj 9 | (:import [java.net URL URLEncoder URLDecoder] 10 | [org.apache.commons.codec.binary Base64]) 11 | :cljs 12 | (:require-macros [kvlt.middleware.util])) 13 | #? (:cljs (:import [goog.Uri]))) 14 | 15 | (defn ->content-type 16 | ([t] 17 | (if (keyword? t) 18 | (let [major (or (namespace t) :application)] 19 | (str (name major) "/" (name t))) 20 | t)) 21 | ([t charset] 22 | (cond-> (->content-type t) charset (str "; charset=" charset)))) 23 | 24 | (defn spec->fn [spec] 25 | (cond (nil? spec) identity 26 | (coll? spec) (let [[k f] spec] 27 | #(update % k f)) 28 | :else spec)) 29 | 30 | (defn- clean-req [r] 31 | (dissoc r 32 | :kvlt.middleware/request 33 | :kvlt.middleware/response 34 | :kvlt/trace)) 35 | 36 | (defn wrap-before [f] 37 | (let [{:keys [has removing]} (meta f) 38 | f (if has 39 | (fn [{v has :as req}] 40 | (cond-> req 41 | v f)) 42 | f)] 43 | (if removing 44 | (fn [req] 45 | (dissoc (f req) removing)) 46 | f))) 47 | 48 | (defn ->mw [helpful-name before & [after]] 49 | (let [after (spec->fn after) 50 | before (-> before spec->fn wrap-before)] 51 | (fn [issue!] 52 | (fn [{:keys [kvlt/trace] :as req}] 53 | (let [req (before req) 54 | req (cond-> req 55 | trace (update :kvlt.middleware/request 56 | (fnil conj []) 57 | [helpful-name (clean-req req)]))] 58 | (m/>>= 59 | (issue! req) 60 | (comp m/return after) 61 | (comp m/return 62 | #(cond-> % 63 | trace 64 | (update :kvlt.middleware/response 65 | (fnil conj []) 66 | [helpful-name (clean-req req)]))))))))) 67 | 68 | #? (:clj 69 | (defmacro defmw [varname doc before & [after]] 70 | `(def ~varname ~doc 71 | (->mw ~(keyword varname) ~before ~after)))) 72 | 73 | ;; More or less all from clj-http, with portability adjustments 74 | 75 | (defn url-decode [encoded & [encoding]] 76 | (let [encoding (or encoding "UTF-8")] 77 | #? (:clj 78 | (URLDecoder/decode encoded encoding) 79 | :cljs 80 | (do 81 | (when (not= "UTF-8" encoding) 82 | (log/warn "url-decode ignoring encoding" encoding)) 83 | (js/decodeURIComponent encoded))))) 84 | 85 | (defn url-encode [unencoded & [encoding]] 86 | (let [encoding (or encoding "UTF-8")] 87 | #? (:clj 88 | (URLEncoder/encode unencoded encoding) 89 | :cljs 90 | (do 91 | (when (not= "UTF-8" encoding) 92 | (log/warn "url-encode ignoring encoding" encoding)) 93 | (js/encodeURIComponent unencoded))))) 94 | 95 | (defn url-encode-illegal-characters 96 | "Takes a raw url path or query and url-encodes any illegal characters. 97 | Minimizes ambiguity by encoding space to %20." 98 | [path-or-query] 99 | (when path-or-query 100 | (-> path-or-query 101 | (str/replace " " "%20") 102 | (str/replace #"[^a-zA-Z0-9\.\-\_\~\!\$\&\'\(\)\*\+\,\;\=\:\@\/\%\?]" 103 | url-encode)))) 104 | 105 | (defn parse-content-type 106 | "Parse `s` as an RFC 2616 media type." 107 | [s] 108 | (if-let [m (re-matches #"\s*(([^/]+)/([^ ;]+))\s*(\s*;.*)?" (str s))] 109 | {:content-type (keyword (nth m 1)) 110 | :content-type-params 111 | (->> (str/split (str (nth m 4)) #"\s*;\s*") 112 | (identity) 113 | (remove str/blank?) 114 | (map #(str/split % #"=")) 115 | (mapcat (fn [[k v]] [(keyword (str/lower-case k)) (str/trim v)])) 116 | (apply hash-map))})) 117 | 118 | (let [pattern #"(?i)charset\s*=\s*([^\s]+)"] 119 | (defn charset 120 | [content-type & [{:keys [fallback]}]] 121 | (let [charset (some->> content-type name (re-find pattern) second)] 122 | (or charset fallback "UTF-8")))) 123 | 124 | (defn string->base64 [x] 125 | #? (:clj 126 | (-> x (.getBytes "UTF-8") Base64/encodeBase64 (String. "UTF-8")) 127 | :cljs 128 | (base64/encodeString x))) 129 | 130 | (defn basic-auth [v] 131 | (let [[user pass] 132 | (if (map? v) 133 | [(v :username) (v :password)] 134 | v)] 135 | (str "Basic " (string->base64 (str user ":" pass))))) 136 | 137 | (defn ^:no-doc parse-url [url] 138 | (let [url #? (:clj (java.net.URL. url) :cljs (goog.Uri. url))] 139 | {:scheme (-> url #? (:clj .getProtocol :cljs .getScheme) keyword) 140 | :server-name (.. url #? (:clj getHost :cljs getDomain)) 141 | :server-port (when-let [port (.getPort url)] 142 | (when (pos? port) port)) 143 | :uri (some-> url .getPath url-encode-illegal-characters) 144 | :query-string (some-> url .getQuery not-empty url-encode-illegal-characters) 145 | :user-info (some-> url .getUserInfo not-empty url-decode)})) 146 | -------------------------------------------------------------------------------- /src/kvlt/platform/event_source.clj: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc kvlt.platform.event-source 2 | (:require [kvlt.util :as util] 3 | [kvlt.event-source :refer [format-event]] 4 | [kvlt.platform.http :refer [default-request required-middleware]] 5 | [aleph.http :as http] 6 | [taoensso.timbre :as log] 7 | [manifold.stream :as s] 8 | [manifold.deferred :as d] 9 | [clojure.string :as str] 10 | [byte-streams] 11 | [clojure.core.async :as async] 12 | [clojure.walk :as walk])) 13 | 14 | (defn span->kv [lines] 15 | (for [line lines 16 | :let [[h t] (str/split (str/trim-newline line) #":[ ]?" 2) 17 | k (keyword h)] 18 | :when (and (not-empty h) t)] 19 | [k t])) 20 | 21 | (defn kv->event [event-kv] 22 | (let [event 23 | (reduce 24 | (fn [m [k v]] 25 | (case k 26 | :data (update m :data conj v) 27 | :event (assoc m :type (keyword v)) 28 | :retry (assoc m k (Integer/parseInt v)) 29 | :id (assoc m k v) 30 | m)) 31 | {:type :message :data []} 32 | event-kv)] 33 | (update event :data #(not-empty (str/join "\n" %))))) 34 | 35 | (defn span->event [span format] 36 | (some->> span span->kv kv->event (format-event format))) 37 | 38 | (defn split-after-newline [s] 39 | (-> s (str/replace #"\r\n|\r" "\n") (str/split #"(?<=\n)"))) 40 | 41 | (defn- http-response->events [{:keys [body status]} events format] 42 | (let [out (s/stream) 43 | lines (s/mapcat (comp split-after-newline byte-streams/to-string) body) 44 | output! (fn [{:keys [type id] :as e} last-id] 45 | (if (and e (or (events type) (contains? events :*))) 46 | (s/put! out (assoc e :id (or id last-id))) 47 | (d/success-deferred true)))] 48 | (d/loop [last-id nil span [] line nil] 49 | (-> (s/take! lines) 50 | (d/chain 51 | (util/fn-when [chunk] 52 | (cond 53 | (= \newline (first chunk)) ;; Blank 54 | (let [{:keys [id] :as e} (span->event span format)] 55 | (-> (output! e last-id) 56 | (d/chain (util/fn-when [_] 57 | (d/recur (or id last-id) [] nil))))) 58 | 59 | (not= \newline (last chunk)) ;; Partial 60 | (d/recur last-id span (str line chunk)) 61 | 62 | :else 63 | (d/recur last-id (conj span (str line chunk)) nil)))))) 64 | out)) 65 | 66 | (def ^:private insecure-sse-pool 67 | (http/connection-pool {:connection-options {:insecure? true} 68 | :middleware required-middleware})) 69 | 70 | (def ^:private sse-pool 71 | (http/connection-pool {:middleware required-middleware})) 72 | 73 | (defn sse-req [url {:keys [headers :kvlt.platform/insecure?] :as options}] 74 | (default-request 75 | {:url url 76 | :raw-stream? true 77 | :request-method :get 78 | :headers (merge {"cache-control" "no-cache" 79 | "accept" "text/event-stream" 80 | "connection" "keep-alive"} 81 | (walk/stringify-keys headers))} 82 | (if insecure? insecure-sse-pool sse-pool))) 83 | 84 | (defn request! 85 | [url & [{:keys [events format chan close? options] 86 | :or {events #{:message} format :default close? true}}]] 87 | (let [events (cond->> events (coll? events) (into #{})) 88 | stream (s/stream) 89 | chan (or chan (async/chan))] 90 | (s/connect stream chan {:downstream? close? :upstream? true}) 91 | (d/on-realized 92 | (http/request (sse-req url options)) 93 | (fn [resp] 94 | (let [events (http-response->events resp events format)] 95 | (s/on-closed stream #(s/close! (:body resp))) 96 | (s/connect events stream))) 97 | (fn [err] 98 | (log/error err "SSE error, closing channel" url) 99 | (s/close! stream))) 100 | (util/read-proxy-chan chan #(s/close! stream) {:close? close?}))) 101 | -------------------------------------------------------------------------------- /src/kvlt/platform/event_source.cljs: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc kvlt.platform.event-source 2 | (:require [kvlt.event-source :refer [format-event]] 3 | [cljs.core.async :as async] 4 | [taoensso.timbre :as log] 5 | [kvlt.util :as util])) 6 | 7 | ;; delay the require so that code running in browsers without 8 | ;; EventSource (SSE) will fail only if it actually tries to use SSE. 9 | (def eventsource-node (delay (js/require "eventsource"))) 10 | 11 | (defn event-source [url options] 12 | (let [js-options (clj->js options)] 13 | (if (exists? js/EventSource) 14 | (js/EventSource. url js-options) 15 | (try 16 | (let [es @eventsource-node] 17 | (es. url js-options)) 18 | (catch js/Error e 19 | (log/error "EventSource is not available") 20 | (throw e)))))) 21 | 22 | (defn event->map [e format] 23 | (format-event 24 | format 25 | {:id (not-empty (.. e -lastEventId)) 26 | :data (.. e -data) 27 | :type (keyword (.. e -type))})) 28 | 29 | (defn add-listeners! [source chan types format] 30 | (doseq [t types] 31 | (.addEventListener 32 | source 33 | (name t) 34 | (fn [e] 35 | (when-not (async/put! chan (event->map e format)) 36 | (.close source)))))) 37 | 38 | (defn request! 39 | [url & [{:keys [events format chan close? options] 40 | :or {events #{:message} format :string close? true options {}}}]] 41 | (let [chan (or chan (async/chan)) 42 | source (event-source url options)] 43 | (add-listeners! source chan events format) 44 | (set! (.. source -onerror) 45 | (fn [_] 46 | (log/warn "SSE error, closing source" url) 47 | (.close source) 48 | (when close? 49 | (async/close! chan)))) 50 | (util/read-proxy-chan chan #(.close source) {:close? close?}))) 51 | -------------------------------------------------------------------------------- /src/kvlt/platform/http.clj: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc kvlt.platform.http 2 | (:require 3 | [kvlt.middleware :as mw] 4 | [kvlt.util :refer [pprint-str]] 5 | [kvlt.platform.util :refer [exception->map]] 6 | [clojure.string :as str] 7 | [aleph.http :as http] 8 | [aleph.http.client-middleware] 9 | [manifold.deferred :as deferred] 10 | [byte-streams] 11 | [promesa.core :as p] 12 | [taoensso.timbre :as log])) 13 | 14 | (defn- handle-response [m req] 15 | (let [m (-> m 16 | (update :body byte-streams/to-byte-array) 17 | (update :headers (partial into {})) 18 | (vary-meta assoc :kvlt/request req))] 19 | (log/debug "Received response\n" 20 | (pprint-str (assoc m :body "(byte array omitted)"))) 21 | m)) 22 | 23 | (defn required-middleware [client] 24 | #(client (aleph.http.client-middleware/wrap-url %))) 25 | 26 | (def ^:private insecure-connection-pool 27 | (http/connection-pool {:connection-options {:insecure? true} 28 | :middleware required-middleware})) 29 | 30 | (def ^:private boring-connection-pool 31 | (http/connection-pool {:middleware required-middleware})) 32 | 33 | (defn default-request [{:keys [server-name server-port] :as req} & [pool]] 34 | (merge {:pool (or pool 35 | (req :kvlt.platform/pool) 36 | (when (req :kvlt.platform/insecure?) 37 | insecure-connection-pool) 38 | boring-connection-pool) 39 | :host server-name 40 | :port server-port} req)) 41 | 42 | (defn request! [req] 43 | (log/debug "Issuing request\n" (pprint-str req)) 44 | (let [req (default-request req)] 45 | (p/promise 46 | (fn [resolve reject] 47 | (try 48 | (deferred/on-realized 49 | (http/request req) 50 | #(resolve (handle-response % req)) 51 | (comp resolve exception->map)) 52 | (catch Exception e 53 | (resolve (exception->map e)))))))) 54 | -------------------------------------------------------------------------------- /src/kvlt/platform/http.cljs: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc kvlt.platform.http 2 | (:require [cljs.core.async :as async] 3 | [taoensso.timbre :as log] 4 | [clojure.string :as str] 5 | [kvlt.util :as util] 6 | [promesa.core :as p] 7 | [kvlt.platform.xhr :as xhr] 8 | [kvlt.middleware.util :refer [charset]])) 9 | (defn ->response [req m] 10 | (vary-meta m assoc :kvlt/request req)) 11 | 12 | (defn error->map [e] 13 | (let [code (or (keyword (.. e -code)) :unknown)] 14 | {:type code 15 | :error code 16 | :message (.. e -message) 17 | :status 0})) 18 | 19 | (defn- compose-url [{:keys [query-string server-port] :as req}] 20 | (str (name (req :scheme)) 21 | "://" 22 | (req :server-name) 23 | (when server-port 24 | (str ":" server-port)) 25 | (req :uri) 26 | (when query-string 27 | (str "?" query-string)))) 28 | 29 | (defn req->node [{:keys [body kvlt.platform/timeout kvlt.platform/insecure?] :as req}] 30 | (cond-> 31 | {:uri (compose-url req) 32 | :method (-> req :request-method name str/upper-case) 33 | :headers (req :headers) 34 | :encoding nil 35 | :gzip true} 36 | body (assoc :body body) 37 | timeout (assoc :timeout timeout) 38 | insecure? (assoc :rejectUnauthorized false))) 39 | 40 | (defn- maybe-encode [buffer as headers] 41 | (if (= as :byte-array) 42 | buffer 43 | (let [cs (-> headers :content-type charset)] 44 | (.toString buffer cs)))) 45 | 46 | (when (= *target* "nodejs") 47 | (let [request! (js/require "request")] 48 | (defn request-node! [req] 49 | (p/promise 50 | (fn [resolve _] 51 | (let [respond (comp resolve #(->response req %))] 52 | (request! 53 | (clj->js (req->node req)) 54 | (fn [error node-resp buffer] 55 | (if error 56 | (respond (error->map error)) 57 | (let [headers (js->clj (.. node-resp -headers) :keywordize-keys true) 58 | resp {:headers headers 59 | :status (.. node-resp -statusCode) 60 | :body (maybe-encode buffer (req :as) headers)}] 61 | (log/debug "Received response\n" (util/pprint-str resp)) 62 | (respond resp))))))))))) 63 | 64 | (defn request! [req] 65 | (log/debug "Issuing request\n" (util/pprint-str req)) 66 | (if (= *target* "nodejs") 67 | (request-node! req) 68 | (xhr/request! req))) 69 | -------------------------------------------------------------------------------- /src/kvlt/platform/util.clj: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc kvlt.platform.util 2 | (:require [byte-streams] 3 | [clojure.string :as str] 4 | [clojure.java.io :as io]) 5 | (:import [java.io ByteArrayInputStream BufferedInputStream] 6 | [java.util.zip DeflaterInputStream GZIPInputStream InflaterInputStream])) 7 | 8 | (defn- exception->keyword [^Class class] 9 | (let [t (-> class .getSimpleName (str/replace #"Exception$" "") 10 | (->> (re-seq #"[A-Z]+[^A-Z]*") 11 | (map str/lower-case) 12 | (str/join "-")))] 13 | (or (not-empty t) :generic))) 14 | 15 | (defn- unwrap-exception [e] 16 | (if-let [{:keys [status] :as data} (ex-data e)] 17 | {:type status 18 | :error status 19 | :status status 20 | :kvlt.platform/error e} 21 | (let [{:keys [class message]} (bean e) 22 | type (exception->keyword class)] 23 | {:status 0 24 | :type :http-error 25 | :error :http-error 26 | :kvlt.platform/error type}))) 27 | 28 | (defn exception->map [e & [hints]] 29 | (merge (unwrap-exception e) hints)) 30 | 31 | (def json-enabled? 32 | (try 33 | (require 'cheshire.core) 34 | true 35 | (catch Throwable _ false))) 36 | 37 | (defn gunzip "Returns a gunzip'd version of the given byte array." [b] 38 | (-> b ByteArrayInputStream. GZIPInputStream. byte-streams/to-byte-array)) 39 | 40 | (defn inflate [b] 41 | (let [s (-> b ByteArrayInputStream. BufferedInputStream.)] 42 | (.mark s 512) 43 | (let [readable? 44 | (try 45 | (.read (InflaterInputStream. s)) 46 | true 47 | (catch java.util.zip.ZipException _ 48 | false))] 49 | (.reset s) 50 | (byte-streams/to-byte-array 51 | (if readable? 52 | (InflaterInputStream. s) 53 | (InflaterInputStream. s (java.util.zip.Inflater. true))))))) 54 | 55 | (defn- array-ctor->type-checker [t] 56 | (partial instance? (type (t [])))) 57 | 58 | (def byte-array? (array-ctor->type-checker byte-array)) 59 | 60 | (defn byte-array->str [ba encoding] 61 | (if (byte-array? ba) 62 | (String. ^"[B" ba encoding) 63 | ba)) 64 | 65 | (defn parse-json [s] 66 | {:pre [json-enabled?]} 67 | ((ns-resolve (symbol "cheshire.core") (symbol "parse-string")) s keyword)) 68 | 69 | (defn encode-json [x] 70 | {:pre [json-enabled?]} 71 | ((ns-resolve (symbol "cheshire.core") (symbol "generate-string")) x)) 72 | -------------------------------------------------------------------------------- /src/kvlt/platform/util.cljs: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc kvlt.platform.util 2 | (:require [clojure.walk :as walk])) 3 | 4 | (defn exception->map [e & [hints]] 5 | (merge {:message (.. e -message) 6 | :type :http-error 7 | :error :http-error} hints)) 8 | 9 | ;; These functions oughtn't be invoked currently - accept-encoding 10 | ;; isn't ever set on Node, and in the browser, the response will be 11 | ;; silently decompressed. 12 | (defn gunzip [s] s) 13 | (defn inflate [s] s) 14 | 15 | (defn byte-array? [x] 16 | (or (and (exists? js/ArrayBuffer) (= (type x) js/ArrayBuffer)) 17 | (and (exists? js/Buffer) (= (type x) js/Buffer)))) 18 | 19 | (defn byte-array->str [ba encoding] 20 | (if (and (exists? js/Buffer) (= (type ba) js/Buffer)) 21 | (.toString ba encoding) 22 | ba)) 23 | 24 | (defn parse-json [s] 25 | (walk/keywordize-keys (js->clj (.parse js/JSON s)))) 26 | 27 | (defn encode-json [x] 28 | (.stringify js/JSON (clj->js x))) 29 | -------------------------------------------------------------------------------- /src/kvlt/platform/websocket.clj: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc kvlt.platform.websocket 2 | (:require [aleph.http :as http] 3 | [clojure.core.async :as async] 4 | [kvlt.platform.util :refer [exception->map]] 5 | [kvlt.util :as util] 6 | [kvlt.websocket :refer [format-incoming format-outgoing]] 7 | [manifold.deferred :as deferred] 8 | [manifold.stream :as s] 9 | [promesa.core :as p])) 10 | 11 | (defn- connect-chans [stream r w format close?] 12 | (s/connect-via w #(s/put! stream (format-outgoing format %)) stream) 13 | (s/connect 14 | (s/map #(format-incoming format %) stream) 15 | r 16 | {:downstream? close?})) 17 | 18 | (defn request! [url & [{:keys [read-chan write-chan close? format kvlt.platform/max-frame-payload] 19 | :or {close? true}}]] 20 | (let [read (or read-chan (async/chan)) 21 | write (or write-chan (async/chan)) 22 | ws-opts (merge {} 23 | (when max-frame-payload 24 | {:max-frame-payload max-frame-payload}))] 25 | (p/promise 26 | (fn [resolve reject] 27 | (deferred/on-realized 28 | (http/websocket-client url ws-opts) 29 | (fn [stream] 30 | (let [chan (util/bidirectional-chan 31 | read write 32 | {:on-close #(manifold.stream/close! stream) 33 | :close? close?})] 34 | (connect-chans stream read write format close?) 35 | (-> chan 36 | (vary-meta assoc :kvlt.platform/stream stream) 37 | resolve))) 38 | (fn [e] 39 | (let [{:keys [message] :as e} (exception->map e)] 40 | (reject (ex-info message e))))))))) 41 | -------------------------------------------------------------------------------- /src/kvlt/platform/websocket.cljs: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc kvlt.platform.websocket 2 | (:require [cljs.core.async :as async] 3 | [kvlt.util :as util] 4 | [kvlt.websocket :refer [format-outgoing format-incoming]] 5 | [taoensso.timbre :as log] 6 | [promesa.core :as p]) 7 | (:require-macros [cljs.core.async.macros :refer [go]])) 8 | 9 | ;; delay the require so that code running in browsers without 10 | ;; WebSocket will fail only if it actually tries to use it. 11 | (def websocket-node (delay (.. (js/require "websocket") -w3cwebsocket))) 12 | 13 | (defn websocket [url] 14 | (if (exists? js/WebSocket) 15 | (js/WebSocket. url) 16 | (try 17 | (let [ws @websocket-node] 18 | (ws. url)) 19 | (catch js/Error e 20 | (log/error "WebSocket is not available") 21 | (throw e))))) 22 | 23 | (defn- ws->chan! [ws chan format] 24 | (set! (.. ws -onmessage) #(async/put! chan (format-incoming format (.. % -data))))) 25 | 26 | (defn- chan->ws! [chan ws format] 27 | (go 28 | (loop [] 29 | (when-let [msg (maybe-error [ev] 34 | (when-not (.. ev -wasClean) 35 | (let [reason (.. ev -reason) 36 | code (.. ev -code)] 37 | (ex-info reason {:message reason :error code :type code :status 0})))) 38 | 39 | (defn request! [url & [{:keys [read-chan format write-chan close?] :or {close? true}}]] 40 | (let [ws (websocket url) 41 | in (or read-chan (async/chan)) 42 | out (or write-chan (async/chan)) 43 | chan (util/bidirectional-chan in out {:on-close #(.close ws) :close? close?}) 44 | resolved? (atom false)] 45 | (p/promise 46 | (fn [resolve reject] 47 | (ws->chan! ws in format) 48 | (chan->ws! out ws format) 49 | 50 | (set! (.. ws -onopen) 51 | (fn [] 52 | (reset! resolved? true) 53 | (resolve chan))) 54 | 55 | (set! (.. ws -onclose) 56 | (fn [event] 57 | (when-let [error (close-event->maybe-error event)] 58 | (log/error "Websocket onclose error" error) 59 | (when-not @resolved? 60 | (reject error)) 61 | (async/close! chan)))))))) 62 | -------------------------------------------------------------------------------- /src/kvlt/platform/xhr.cljs: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc kvlt.platform.xhr 2 | (:require [cljs.core.async :as async] 3 | [taoensso.timbre :as log] 4 | [clojure.string :as str] 5 | [kvlt.util :as util] 6 | [promesa.core :as p]) 7 | (:import [goog.Uri] 8 | [goog.net XmlHttp XmlHttpFactory EventType ErrorCode XhrIo])) 9 | 10 | (defn- tidy-http-error [{:keys [error-code error-text status] :as m}] 11 | (-> m 12 | (dissoc :error-text :error-code) 13 | (assoc 14 | :type error-code 15 | :error error-code 16 | :message error-text))) 17 | 18 | (defn req->url [{:keys [scheme server-name server-port uri query-string]}] 19 | (str (doto (goog.Uri.) 20 | (.setScheme (name (or scheme :http))) 21 | (.setDomain server-name) 22 | (.setPort server-port) 23 | (.setPath uri) 24 | (.setQuery query-string true)))) 25 | 26 | (defn req->xhr 27 | [{:keys [kvlt.platform/credentials? timeout as] 28 | :or {timeout 0} :as request}] 29 | (let [xhr (doto (XhrIo.) 30 | (.setTimeoutInterval timeout) 31 | (.setWithCredentials credentials?))] 32 | (when (= as :byte-array) 33 | (.setResponseType xhr (.. XhrIo -ResponseType -ARRAY_BUFFER))) 34 | xhr)) 35 | 36 | (def code->error 37 | {0 :no-error 38 | 1 :access-denied 39 | 2 :file-not-found 40 | 3 :ff-silent-error 41 | 4 :custom-error 42 | 5 :exception 43 | 6 :http-error 44 | 7 :abort 45 | 8 :timeout 46 | 9 :offline}) 47 | 48 | (defn headers->map [headers] 49 | (reduce 50 | #(let [[k v] (str/split %2 #":\s+")] 51 | (if (or (str/blank? k) (str/blank? v)) 52 | %1 (assoc %1 (str/lower-case k) v))) 53 | {} (str/split (or headers "") #"(\n)|(\r)|(\r\n)|(\n\r)"))) 54 | 55 | (defn response->map [resp req] 56 | (let [{:keys [status] :as m} 57 | {:status (.getStatus resp) 58 | :success (.isSuccess resp) 59 | :body (.getResponse resp) 60 | :headers (headers->map (.getAllResponseHeaders resp)) 61 | :error-code (code->error (.getLastErrorCode resp)) 62 | :error-text (.getLastError resp)} 63 | m (-> m 64 | (cond-> (= status 0) tidy-http-error) 65 | (vary-meta assoc :kvlt/request req))] 66 | (log/debug "Received response\n" (util/pprint-str m)) 67 | m)) 68 | 69 | (defn filter-headers [m] 70 | (into {} 71 | (for [[k v] m 72 | :when (not (#{:accept-encoding "accept-encoding"} k))] 73 | [k v]))) 74 | 75 | (defn request! [{:keys [request-method headers body credentials?] :as req}] 76 | (let [url (req->url req) 77 | method (name (or request-method :get)) 78 | headers (clj->js (filter-headers headers)) 79 | xhr (req->xhr req)] 80 | (p/promise 81 | (fn [resolve reject] 82 | (.listen xhr EventType.COMPLETE 83 | #(resolve (response->map (.. % -target) req))) 84 | (.send xhr url method body headers))))) 85 | -------------------------------------------------------------------------------- /src/kvlt/util.cljc: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc kvlt.util 2 | (:require 3 | [clojure.string :as str] 4 | #? (:clj [clojure.core.async.impl.protocols :as p] 5 | :cljs [cljs.core.async.impl.protocols :as p]) 6 | #? (:clj [clojure.pprint :as pprint] 7 | :cljs [cljs.pprint :as pprint])) 8 | #? (:cljs (:require-macros [kvlt.util]))) 9 | 10 | (defn map-keys [f m] 11 | (into {} (for [[k v] m] [(f k) v]))) 12 | 13 | (defn map-vals [f m] 14 | (into {} (for [[k v] m] [k (f v)]))) 15 | 16 | ;; Taken from Plumbing 17 | (let [+none+ ::none] 18 | (defn update-when [m key f & args] 19 | (let [found (m key +none+)] 20 | (if-not (identical? +none+ found) 21 | (assoc m key (apply f found args)) 22 | m)))) 23 | 24 | ;; Taken from Chord, more or less 25 | (defn bidirectional-chan 26 | [read-ch write-ch & [{:keys [on-close close?] :or {close? true}}]] 27 | (reify 28 | p/ReadPort 29 | (take! [_ handler] 30 | (p/take! read-ch handler)) 31 | 32 | p/WritePort 33 | (put! [_ msg handler] 34 | (p/put! write-ch msg handler)) 35 | 36 | p/Channel 37 | (close! [_] 38 | (when close? 39 | (p/close! read-ch) 40 | (p/close! write-ch)) 41 | (when on-close 42 | (on-close))))) 43 | 44 | (defn read-proxy-chan [read-ch on-close & [{:keys [close?] :or {close? true}}]] 45 | (reify 46 | p/ReadPort 47 | (take! [_ handler] 48 | (p/take! read-ch handler)) 49 | 50 | p/Channel 51 | (close! [_] 52 | (on-close) 53 | (when close? 54 | (p/close! read-ch))))) 55 | 56 | (defn pprint-str [x] 57 | (str/trimr (with-out-str (pprint/pprint x)))) 58 | 59 | (defn examples->str [examples] 60 | (str "\n\n```clojure\n" 61 | (str/join 62 | "\n\n" 63 | (for [[before after] examples] 64 | (cond-> (pprint-str before) 65 | after (str "\n =>\n" (pprint-str after))))) 66 | "\n```")) 67 | 68 | (defn doc-examples! [vvar examples] 69 | (alter-meta! vvar update :doc str (examples->str examples))) 70 | 71 | #? (:clj 72 | (defmacro fn-when [[binding] & body] 73 | `(fn [~binding] 74 | (when ~binding 75 | ~@body)))) 76 | 77 | #? (:clj 78 | (defmacro with-doc-examples! [vvar & examples] 79 | `(alter-meta! #'~vvar update :doc str ~(examples->str examples)))) 80 | -------------------------------------------------------------------------------- /src/kvlt/websocket.cljc: -------------------------------------------------------------------------------- 1 | (ns kvlt.websocket 2 | (:require [#?(:clj clojure.edn :cljs cljs.reader) :as edn] 3 | [kvlt.platform.util :as util])) 4 | 5 | (defmulti format-outgoing 6 | "Transform outgoing websocket messages. 7 | 8 | Symbolic format name + arbitrary message -> String" 9 | (fn [format msg] format)) 10 | (defmethod format-outgoing :default [_ x] x) 11 | (defmethod format-outgoing :edn [_ x] (pr-str x)) 12 | (defmethod format-outgoing :json [_ x] (util/encode-json x)) 13 | 14 | (defmulti format-incoming 15 | "Transform incoming websocket messages. 16 | 17 | Symbolic format name + string -> arbitrary message" 18 | (fn [format msg] format)) 19 | 20 | (defmethod format-incoming :default [_ x] x) 21 | (defmethod format-incoming :edn [_ x] (edn/read-string x)) 22 | (defmethod format-incoming :json [_ x] (util/parse-json x)) 23 | -------------------------------------------------------------------------------- /test/kvlt/test/chan.cljc: -------------------------------------------------------------------------------- 1 | (ns kvlt.test.chan 2 | (:require [kvlt.chan :as chan] 3 | #? (:clj [clojure.core.async :as async :refer [go]]) 4 | #? (:cljs [cljs.core.async :as async]) 5 | [kvlt.test.util :as util #?(:clj :refer :cljs :refer-macros) [deftest is=]]) 6 | #? (:cljs (:require-macros [cljs.core.async.macros :refer [go]]))) 7 | 8 | (deftest request! 9 | (let [chan (async/chan 1 (map (fn [{{x :body} :body}] [x "World"])))] 10 | (util/with-result 11 | (util/channel-promise 12 | (chan/request! 13 | {:url (str "http://localhost:" util/local-port "/echo") 14 | :body "Hello" 15 | :as :edn} 16 | {:chan chan})) 17 | #(is= ['Hello "World"] %)))) 18 | 19 | (deftest websocket! 20 | (util/with-result 21 | (util/channel-promise 22 | (chan/websocket! 23 | (str "ws://localhost:" util/local-port "/ws-echo"))) 24 | (fn [ch] 25 | (util/channel-promise 26 | (go 27 | (async/>! ch "OK") 28 | (is= "OK" (async/! #? (:clj go)]] 15 | [promesa.core :as p])) 16 | 17 | 18 | (deftest error-middleware-cooperates 19 | (util/with-result 20 | (p/branch (kvlt/request! 21 | {:url (str "http://localhost:" util/local-port "/echo") 22 | :query-params {:status 400}}) 23 | (constantly nil) 24 | ex-data) 25 | (fn [{:keys [status headers]}] 26 | (is= 400 status) 27 | (is (some keyword? (keys headers)))))) 28 | 29 | (defn edn-req [m] 30 | (util/with-result 31 | (kvlt/request! 32 | (merge 33 | {:url (str "http://localhost:" util/local-port "/echo") 34 | :method :post 35 | :accept-encoding "gzip" 36 | :content-type :edn 37 | :form {:hello 'world}} 38 | m)) 39 | (fn [{:keys [status reason headers body] :as resp}] 40 | (is= 200 status) 41 | (is= :ok reason) 42 | (is= "application/edn" (headers :content-type)) 43 | (is= {:hello 'world} (:body body))))) 44 | 45 | (deftest edn-as-edn 46 | (edn-req {:as :edn})) 47 | (deftest edn-as-auto 48 | (edn-req {:as :auto})) 49 | 50 | (defn un-byte-array [x] 51 | #? (:clj (map identity x) 52 | :cljs (if (= *target* "nodejs") 53 | (for [i (range (.. x -length))] 54 | (.readInt8 x i)) 55 | (let [x (js/Int8Array. x)] 56 | (for [i (range (.. x -length))] 57 | (aget x i)))))) 58 | 59 | (def hexagram-bytes [-2 -1 -40 52 -33 6]) 60 | (def hexagram-byte-array 61 | #? (:clj (byte-array hexagram-bytes) 62 | :cljs (if (= *target* "nodejs") 63 | (js/Buffer. (clj->js hexagram-bytes)) 64 | (js/Int8Array. (clj->js hexagram-bytes))))) 65 | 66 | (def byte-req 67 | {:url (str "http://localhost:" util/local-port "/echo/body?encoding=UTF-16") 68 | :method :post 69 | :content-type "text/plain" 70 | :character-encoding "UTF-16" 71 | :body hexagram-byte-array}) 72 | 73 | (deftest ^{:kvlt/skip #{:phantom}} bytes->bytes 74 | (util/with-result 75 | (kvlt/request! (assoc byte-req :as :byte-array)) 76 | (fn [{:keys [body] :as resp}] 77 | (is= (un-byte-array body) hexagram-bytes)))) 78 | 79 | (deftest jumbled-middleware 80 | (util/with-result 81 | (kvlt/request! 82 | {:headers {"X-HI" "OK" :x-garbage "text/"} 83 | :url (str "http://localhost:" util/local-port "/echo") 84 | :accept :text/plain 85 | :basic-auth ["moe@nervous.io" "TOP_SECRET"] 86 | :query {:Q :two} 87 | :as :auto}) 88 | (fn [{:keys [body] :as resp}] 89 | (let [{:keys [headers] :as req} (keywordize-keys body)] 90 | (is (headers :authorization)) 91 | (is= "OK" (headers :x-hi)) 92 | (is= "text/plain" (headers :accept)) 93 | (is= {:Q ":two"} (req :query-params)))))) 94 | 95 | #? (:clj 96 | (deftest deflate 97 | (util/with-result 98 | (kvlt/request! 99 | {:url (str "http://localhost:" util/local-port "/echo") 100 | :accept-encoding :deflate 101 | :body "Hello" 102 | :type :edn 103 | :method :post 104 | :as :edn}) 105 | (fn [{{:keys [headers body]} :body}] 106 | (is= "deflate" (headers "accept-encoding")) 107 | (is= 'Hello body))))) 108 | 109 | (defn json-req [] 110 | (kvlt/request! 111 | {:url (str "http://localhost:" util/local-port "/echo/body") 112 | :method :post 113 | :body "{\"x\": 1}" 114 | :as :json})) 115 | 116 | #? (:clj 117 | (deftest json-without 118 | (is (try 119 | @(json-req) 120 | nil 121 | (catch Exception e 122 | true))))) 123 | 124 | #? (:clj 125 | (deftest json-with 126 | (with-redefs [kvlt.platform.util/parse-json (constantly {:x 1})] 127 | (is= {:x 1} (:body @(json-req))))) 128 | :cljs 129 | (deftest json-with 130 | (util/with-result (json-req) 131 | (fn [{:keys [body]}] 132 | (is= {:x 1} body))))) 133 | 134 | (defn responder [resp] 135 | (reduce 136 | #(%2 %1) 137 | (fn [req] 138 | (p/resolved 139 | (with-meta resp {:kvlt/request req}))) 140 | kvlt/default-middleware)) 141 | 142 | (defmethod kvlt.middleware/as-type :xxx [_] 143 | (throw #? (:clj (Exception. "LOL JVM") :cljs (js/Error. "OK JS")))) 144 | 145 | (deftest parse-error-preserves-existing 146 | (let [request! (responder {:status 400 :body "..." :error :http-error})] 147 | (util/with-result 148 | (p/branch 149 | (request! {:url "http://localhost" 150 | :as :xxx}) 151 | (constantly nil) 152 | ex-data) 153 | (fn [{e :error}] 154 | (is= e :http-error))))) 155 | 156 | (deftest parse-error 157 | (let [request! (responder {:status 200 :body "..."})] 158 | (util/with-result 159 | (p/branch 160 | (request! {:url "http://localhost" 161 | :as :xxx}) 162 | (constantly nil) 163 | ex-data) 164 | (fn [{e :error}] 165 | (is= e :middleware-error))))) 166 | 167 | (deftest non-empty-head 168 | (let [request! (responder 169 | {:status 200 170 | :body #? (:clj (byte-array []) :cljs "") 171 | :headers {:content-length 200 172 | :content-encoding "gzip"}})] 173 | (util/with-result (request! {:url "http://rofl" :method :head}) 174 | (fn [resp] 175 | (is (empty? (resp :body))) 176 | (is= (resp :status) 200))))) 177 | -------------------------------------------------------------------------------- /test/kvlt/test/middleware.cljc: -------------------------------------------------------------------------------- 1 | (ns kvlt.test.middleware 2 | (:require 3 | #? (:clj [clojure.test :refer [is deftest]] 4 | :cljs [cljs.test :refer-macros [is deftest]]) 5 | [kvlt.test.middleware.util :refer [mw-req]] 6 | [kvlt.middleware.util :as mw.util] 7 | [kvlt.middleware :as mw :refer [header]] 8 | [kvlt.test.util :as util #?(:clj :refer :cljs :refer-macros) [is=]] 9 | [promesa.core :as p] 10 | #? (:clj [kvlt.test.server]))) 11 | 12 | (def url->parsed 13 | {(str "http://www.amazon.com/Songs-Dreamer-Grimscribe-Thomas-Ligotti/" 14 | "dp/0143107763/ref=sr_1_1?s=books&ie=UTF8&qid=1449962054&sr=1-1&" 15 | "keywords=ligotti") 16 | {:scheme :http, 17 | :server-name "www.amazon.com", 18 | :server-port nil, 19 | :uri "/Songs-Dreamer-Grimscribe-Thomas-Ligotti/dp/0143107763/ref=sr_1_1", 20 | :user-info nil, 21 | :query-string "s=books&ie=UTF8&qid=1449962054&sr=1-1&keywords=ligotti"} 22 | 23 | "https://カタ:ro@www.urgh/_?x=&x=&x=y%20%26=lol" 24 | {:scheme :https, 25 | :server-name "www.urgh", 26 | :server-port nil, 27 | :uri "/_", 28 | :user-info "カタ:ro", 29 | :query-string "x=&x=&x=y%20%26=lol"} 30 | 31 | "ftp://localhost:9" 32 | {:scheme :ftp, 33 | :server-name "localhost", 34 | :server-port 9, 35 | :uri "", 36 | :user-info nil, :query-string nil}}) 37 | 38 | (deftest url-parsing 39 | (doseq [[in out] url->parsed] 40 | (is= out (mw.util/parse-url in)))) 41 | 42 | (deftest url 43 | (doseq [[in out] url->parsed] 44 | (is= out (mw-req mw/url :url in)))) 45 | 46 | (deftest method 47 | (is= :put (:request-method (mw-req mw/method :method :put))) 48 | (is= :put (:request-method (mw-req mw/method :request-method :put)))) 49 | 50 | (deftest keyword-headers 51 | (is= {:x-revolting "yes" 52 | :x-dangerous "medium"} (:headers 53 | (mw-req mw/keyword-headers 54 | :headers 55 | {"x-revolting" "yes" 56 | "x-dangerous" "medium"}))) 57 | (is= {:x-revolting "yes" 58 | :x-dangerous "medium"} (:headers 59 | (mw-req mw/keyword-headers 60 | :headers 61 | {:x-revolting "yes" 62 | :x-dangerous "medium"}))) 63 | (is= {"x-revolting" "yes" 64 | "x-dangerous" "medium"} 65 | (-> (mw-req mw/keyword-headers 66 | :headers 67 | {"x-revolting" "yes" 68 | "x-dangerous" "medium"}) 69 | meta 70 | :kvlt/request 71 | :headers)) 72 | (is= {"x-revolting" "yes" 73 | "x-dangerous" "medium"} 74 | (-> (mw-req mw/keyword-headers 75 | :headers 76 | {:x-revolting "yes" 77 | :x-dangerous "medium"}) 78 | meta 79 | :kvlt/request 80 | :headers))) 81 | 82 | (def input-headers (comp :headers :kvlt/request meta)) 83 | 84 | (deftest accept 85 | (let [accept #(-> (mw-req mw/accept :accept %) (header :accept))] 86 | (is= "application/edn" (accept :edn)) 87 | (is= "application/edn" (accept :application/edn)) 88 | (is= "text/plain" (accept "text/plain")) 89 | (is (not (contains? ((mw-req mw/accept) :headers) :accept))))) 90 | 91 | (deftest accept-encoding 92 | (let [encoding #(-> (mw-req mw/accept-encoding :accept-encoding %) 93 | (header :accept-encoding))] 94 | (is (nil? (encoding nil))) 95 | (is (= "gzip" (encoding :gzip))) 96 | (is (= "gzip" (encoding [:gzip]))) 97 | (is (= "deflate, gzip" (encoding [:deflate "gzip"]))))) 98 | 99 | (deftest lower-case-headers 100 | (is= {"x-ok" "Yes"} 101 | (:headers (mw-req mw/lower-case-headers :headers {"X-Ok" "Yes"}))) 102 | (is= {"x-ok" "Yes"} 103 | (-> (mw-req mw/lower-case-headers :headers {"X-Ok" "Yes"}) 104 | input-headers))) 105 | 106 | (defmethod mw/from-content-type :application/rtcw [{:keys [body] :as req}] 107 | (assoc req :body (str "Let's play RTCW, " body))) 108 | 109 | (deftest default-content-type 110 | (is= :text/plain ((mw-req mw/default-content-type :body "") :content-type)) 111 | (is (not (contains? (mw-req mw/default-content-type) :content-type)))) 112 | 113 | (deftest content-type 114 | (is= "text/html" 115 | (-> (mw-req mw/content-type :content-type "text/html") 116 | (header :content-type))) 117 | (is= "text/html; charset=US-ASCII" 118 | (-> (mw-req mw/content-type 119 | :content-type "text/html" 120 | :character-encoding "US-ASCII") 121 | (header :content-type)))) 122 | 123 | (deftest basic-auth 124 | (let [[u p] ["basic-auth-user" "rofl"] 125 | expected (str "Basic " (mw.util/string->base64 (str u ":" p)))] 126 | (is= expected (-> (mw-req mw/basic-auth :basic-auth {:username u :password p}) 127 | (header :authorization))) 128 | (is= expected (-> (mw-req mw/basic-auth :basic-auth [u p]) 129 | (header :authorization))))) 130 | 131 | (deftest oauth-token 132 | (let [token "TOKEN"] 133 | (is= (str "Bearer " token) 134 | (-> (mw-req mw/oauth-token :oauth-token token) 135 | (header :authorization))) 136 | (let [resp (mw-req mw/oauth-token)] 137 | (is (not (header resp :authorization)))))) 138 | 139 | (deftest default-method 140 | (is= :get (-> (mw-req mw/default-method) 141 | :method)) 142 | (is= :post (-> (mw-req mw/default-method :method :post) 143 | :method))) 144 | 145 | (deftest error 146 | (let [statuses (keys mw/status->reason) 147 | [unexceptional] (filter mw/unexceptional-status? statuses) 148 | [exceptional] (filter (complement mw/unexceptional-status?) statuses) 149 | 150 | error (ex-data (mw-req mw/error :status exceptional)) 151 | reason (mw/status->reason exceptional)] 152 | 153 | (is= reason (:reason error)) 154 | (is= reason (:type error)) 155 | (is= exceptional (:status error)) 156 | 157 | (let [resp (mw-req mw/error :status unexceptional)] 158 | (is= unexceptional (:status resp)) 159 | (is= (mw/status->reason unexceptional) (:reason resp)) 160 | (is (nil? (:type resp)))))) 161 | 162 | #? (:clj 163 | (let [body (kvlt.test.server/gzip "OMFG") 164 | headers {"content-encoding" "gzip"}] 165 | (deftest gzip 166 | (is= "OMFG" 167 | (-> (mw-req mw/decompress :body body :headers headers) 168 | :body String.))))) 169 | 170 | ;; Interactions 171 | 172 | (defn keyword+lower-case-headers* [mw] 173 | (let [{:keys [headers] :as resp} 174 | (mw-req mw :headers {:X-YY "OK" "X-YZ" "SURE"})] 175 | (is= {:x-yy "OK" :x-yz "SURE"} headers) 176 | (is= {"x-yy" "OK" "x-yz" "SURE"} (-> resp meta :kvlt/request :headers)))) 177 | 178 | (deftest keyword+lower-case-headers 179 | (keyword+lower-case-headers* (comp mw/lower-case-headers mw/keyword-headers)) 180 | (keyword+lower-case-headers* (comp mw/keyword-headers mw/lower-case-headers))) 181 | 182 | (deftest default-method+method 183 | (let [req (partial mw-req (comp mw/default-method mw/method))] 184 | (is (= :get (:request-method (req)))) 185 | (is (= :put (:request-method (req :method :put)))))) 186 | -------------------------------------------------------------------------------- /test/kvlt/test/middleware/params.cljc: -------------------------------------------------------------------------------- 1 | (ns kvlt.test.middleware.params 2 | (:require [kvlt.test.middleware.util :refer [mw-req]] 3 | [kvlt.middleware.params :as params] 4 | #? (:clj [clojure.test :refer [deftest is]] 5 | :cljs [cljs.test :refer-macros [deftest is]]) 6 | [kvlt.test.util #?(:clj :refer :cljs :refer-macros) [is=]])) 7 | 8 | (deftest query-params 9 | (is (nil? (-> (mw-req params/query) :query-string))) 10 | 11 | (let [qp (comp 12 | :query-string 13 | (partial mw-req params/query :query-params))] 14 | 15 | (is= "qux=quux" (qp {:qux "quux"})) 16 | (is= "qux=quux" (qp {"qux" "quux"})) 17 | (is= "a=b&c=d" (qp (into (sorted-map) {"a" "b" "c" "d"}))) 18 | (is= "a=b&c=%3C" (qp {:c "<"} :query-string "a=b")) 19 | 20 | (is= "x=%E3%82%AB" (qp {:x "カ"})) 21 | #? (:clj 22 | (is= "x=%3F" 23 | (qp {:x "カ"} :content-type "text/plain;charset=US-ASCII"))))) 24 | 25 | (deftest form-params 26 | (is (nil? (:body (mw-req params/form)))) 27 | 28 | (let [fp (comp 29 | #(select-keys % #{:body :content-type}) 30 | (partial mw-req params/form 31 | :request-method :post 32 | :form-params))] 33 | 34 | (is (nil? (:body (fp {:x 1} :request-method :get)))) 35 | 36 | (doseq [method [:post :put :patch]] 37 | (is (:body (fp {:x 1} :request-method method)))) 38 | 39 | (is= {:body "qux=quux" 40 | :content-type "application/x-www-form-urlencoded"} 41 | (fp {:qux "quux"})) 42 | 43 | (is= {:body "{:x 1}" 44 | :content-type "application/edn"} 45 | (fp {:x 1} :content-type :edn)) 46 | 47 | (is= "x=%E3%82%AB" (:body (fp {:x "カ"}))) 48 | 49 | #? (:clj 50 | (is= "x=%3F" (:body (fp {:x "カ"} 51 | :form-param-encoding "US-ASCII")))))) 52 | -------------------------------------------------------------------------------- /test/kvlt/test/middleware/util.cljc: -------------------------------------------------------------------------------- 1 | (ns kvlt.test.middleware.util 2 | (:require [cats.core :as m] 3 | [cats.monad.identity :as monad.identity])) 4 | 5 | (defn mw-req [mw & kvs] 6 | (let [req (if kvs (apply assoc nil kvs) {})] 7 | (m/extract 8 | ((mw (fn [in] 9 | (monad.identity/identity 10 | (vary-meta in assoc :kvlt/request in)))) req)))) 11 | -------------------------------------------------------------------------------- /test/kvlt/test/platform/event_source.cljc: -------------------------------------------------------------------------------- 1 | (ns kvlt.test.platform.event-source 2 | (:require #? (:clj [clojure.test :refer [is]] 3 | :cljs [cljs.test :refer-macros [is]]) 4 | [kvlt.platform.event-source :as event-source] 5 | [kvlt.test.util :as util 6 | #?(:clj :refer :cljs :refer-macros) [deftest is= after->]] 7 | #? (:clj [clojure.core.async :as async] 8 | :cljs [cljs.core.async :as async :refer [>! 46 | (util/channel-promise 47 | (event-source/request! 48 | (util/local-url "redirect?status=301&location=http://localhost:5000/events") 49 | {:events #{:even}})) 50 | :id 51 | (is= "0"))) 52 | -------------------------------------------------------------------------------- /test/kvlt/test/platform/http.cljc: -------------------------------------------------------------------------------- 1 | (ns kvlt.test.platform.http 2 | (:require [#? (:clj clojure.edn :cljs cljs.reader) :as edn] 3 | #? (:clj [clojure.test :refer [is]] 4 | :cljs [cljs.test :refer-macros [is]]) 5 | [clojure.string :as str] 6 | [kvlt.platform.http :as http] 7 | [kvlt.platform.util :as platform.util] 8 | [kvlt.test.util :as util #?(:clj :refer :cljs :refer-macros) [deftest after-> is=]] 9 | [cats.core :as m] 10 | [#? (:clj 11 | clojure.core.async 12 | :cljs 13 | cljs.core.async) :as async :refer [!]] 14 | [promesa.core :as p] 15 | #? (:clj [manifold.stream]))) 16 | 17 | (defn url [& [m]] 18 | (merge {:scheme :http 19 | :server-name "localhost" 20 | :server-port util/local-port} m)) 21 | 22 | (defn body [m] 23 | (-> m :body (platform.util/byte-array->str "UTF-8"))) 24 | 25 | (defn throw-error [{:keys [error message] :as m}] 26 | (when error 27 | (throw (ex-info message m))) 28 | m) 29 | 30 | (defn echo! [& [req]] 31 | (after-> (http/request! (merge {:request-method :get} (url {:uri "/echo"}) req)) 32 | throw-error 33 | body 34 | edn/read-string)) 35 | 36 | (defn echo-header! [h v] 37 | (after-> (echo! {:headers {h v}}) :headers (get h))) 38 | 39 | (deftest headers 40 | (after-> (echo-header! "x-greeting" "Hello") 41 | (is= "Hello"))) 42 | 43 | (deftest post 44 | (after-> (echo! 45 | {:request-method :post 46 | :headers {"content-type" "application/edn"} 47 | :body "[:html]"}) 48 | :body 49 | (is= [:html]))) 50 | 51 | (deftest server-error 52 | (after-> (http/request! 53 | (assoc (url {:uri "/echo"}) 54 | :request-method :get 55 | :query-string "status=500")) 56 | throw-error 57 | :status 58 | (is= 500))) 59 | 60 | (deftest ^{:kvlt/skip #{:phantom}} redirect 61 | (after-> (http/request! 62 | (assoc (url {:uri "/redirect"}) 63 | :request-method :get 64 | :query-string (str "status=302&location=" (util/local-url "ok")))) 65 | throw-error 66 | body 67 | (is= "OK"))) 68 | 69 | (deftest streamed 70 | (after-> (http/request! 71 | (assoc (url {:uri "/numbers"}) 72 | :request-method :get :query-string "cnt=10")) 73 | throw-error 74 | body 75 | (is= (str (str/join "\n" (range 10)) "\n")))) 76 | 77 | (deftest http-error 78 | (util/is-http-error 79 | (http/request! 80 | (assoc (url {:server-name "rofl"}) 81 | :request-method :get 82 | :kvlt.platform/timeout 2000)))) 83 | -------------------------------------------------------------------------------- /test/kvlt/test/platform/websocket.cljc: -------------------------------------------------------------------------------- 1 | (ns kvlt.test.platform.websocket 2 | (:require #? (:clj [clojure.test :refer [is]] 3 | :cljs [cljs.test :refer-macros [is]]) 4 | [kvlt.platform.websocket :as websocket] 5 | [kvlt.test.util :as util #?(:clj :refer :cljs :refer-macros) [deftest is=]] 6 | [#? (:clj 7 | clojure.core.async 8 | :cljs 9 | cljs.core.async) :as async :refer [! #? (:clj go)]] 10 | [promesa.core :as p] 11 | #? (:clj [manifold.stream])) 12 | #? (:cljs (:require-macros [cljs.core.async.macros :refer [go]]))) 13 | 14 | (deftest websocket 15 | (util/with-result 16 | (websocket/request! 17 | (str "ws://localhost:" util/local-port "/ws-echo")) 18 | (fn [ch] 19 | (let [numbers (map str (range 10))] 20 | (util/channel-promise 21 | (go 22 | (! write-chan "hello") 38 | (is= "hello" (! ch {:ok 1}) 50 | (is= {:ok 1} (! ch "longer than one") 88 | (! go]] 3 | [aleph.http :as http] 4 | [manifold.stream :as stream] 5 | [manifold.time] 6 | [manifold.deferred :as d] 7 | [clojure.walk :as walk] 8 | [compojure.core :as compojure] 9 | [compojure.route :as route] 10 | [byte-streams] 11 | [ring.middleware.params :refer [wrap-params]] 12 | [clojure.edn :as edn] 13 | [clojure.pprint :as pprint]) 14 | (:import [java.util.zip GZIPOutputStream DeflaterInputStream] 15 | [java.io ByteArrayOutputStream ByteArrayInputStream]) 16 | (:gen-class)) 17 | 18 | (defn handler-numbers 19 | [{{:strs [cnt] :or {cnt "100"}} :params}] 20 | (let [cnt (Integer/parseInt cnt)] 21 | {:status 200 22 | :headers {"content-type" "application/octet-stream"} 23 | :body (let [sent (atom -1)] 24 | (->> (stream/periodically 100 #(str (swap! sent inc) "\n")) 25 | (stream/transform (take cnt))))})) 26 | 27 | (defn gzip [s] 28 | (let [stream (ByteArrayOutputStream.)] 29 | (doto (GZIPOutputStream. stream) 30 | (.write (.getBytes s "UTF-8")) 31 | (.close)) 32 | (.toByteArray stream))) 33 | 34 | (defn deflate [s] 35 | (-> (.getBytes s "UTF-8") 36 | ByteArrayInputStream. 37 | DeflaterInputStream.)) 38 | 39 | (defn gzip? [{:strs [accept-encoding]}] 40 | (when accept-encoding 41 | (re-find #"gzip" accept-encoding))) 42 | (defn deflate? [{:strs [accept-encoding]}] 43 | (when accept-encoding 44 | (re-find #"deflate" accept-encoding))) 45 | 46 | (defn handler-sse [req] 47 | (let [stream (stream/stream) 48 | send! #(stream/put! stream (apply str %&))] 49 | (send! "data: A bunch of\r\ndata: ") 50 | (send! " events \n\nHorseshit\n\n") 51 | (when-let [x-kvlt-test (get-in req [:headers "x-kvlt-test"])] 52 | (send! "event: header\n") 53 | (send! "data: " x-kvlt-test "\r\n\r\n")) 54 | (d/loop [i 0] 55 | (if (< i 100) 56 | (do 57 | (send! "event: ") 58 | (send! (if (odd? i) "odd" "even") "\n") 59 | (send! "id: " i "\r") 60 | (send! "data: " (pr-str {:index i}) "\r\n\r\n") 61 | (-> (d/deferred) 62 | (d/timeout! 100 (inc i)) 63 | (d/chain d/recur))) 64 | (stream/close! stream))) 65 | {:status 200 66 | :headers {"content-type" "text/event-stream" 67 | "cache-control" "no-cache" 68 | "connection" "keep-alive"} 69 | :body stream})) 70 | 71 | (defn handler-echo 72 | [{{:strs [status] :or {status "200"}} :params :keys [body headers] :as req}] 73 | (let [body-in (some-> body 74 | (byte-streams/convert String) 75 | clojure.edn/read-string) 76 | body-out (pr-str (cond-> req body-in (assoc :body body-in))) 77 | [encoding body-out] 78 | (cond 79 | (gzip? headers) ["gzip" (gzip body-out)] 80 | (deflate? headers) ["deflate" (deflate body-out)] 81 | :else [nil body-out])] 82 | {:status (or (:response-code body) (Integer/parseInt status)) 83 | :body body-out 84 | :headers (merge 85 | {"content-type" "application/edn"} 86 | (when encoding 87 | {"content-encoding" encoding}) 88 | (walk/stringify-keys (:response-headers body-in)))})) 89 | 90 | (defn handler-echo-body 91 | [{{:strs [encoding] :or {encoding "UTF-8"}} :params :keys [body] :as req}] 92 | {:status 200 93 | :headers {"content-type" (str "text/plain; charset=" encoding)} 94 | :body (if body 95 | (byte-streams/to-byte-array body {:encoding encoding}) 96 | "")}) 97 | 98 | (defn handler-ws-echo [req] 99 | (if-let [socket (try 100 | @(http/websocket-connection req) 101 | (catch Exception e 102 | (clojure.pprint/pprint e) 103 | nil))] 104 | (stream/connect-via 105 | socket 106 | (fn [msg] 107 | (println "Echoing websocket message:" msg) 108 | (stream/put! socket msg)) 109 | socket) 110 | {:status 400 111 | :body "Expected a websocket request."})) 112 | 113 | (defn handler-redirect [{{:strs [location status] :or {status "302"}} :params}] 114 | {:status (Integer/parseInt status) 115 | :headers {"location" location} 116 | :body ""}) 117 | 118 | (defn handler-ok 119 | [req] 120 | {:status 200 :body "OK"}) 121 | 122 | (defn cors-headers 123 | [{{:strs [access-control-request-headers] 124 | :or {access-control-request-headers 125 | "Accept, Content-Type, Authorization"}} :headers}] 126 | {:access-control-allow-origin "*" 127 | :access-control-allow-headers access-control-request-headers 128 | :access-control-allow-methods "GET, PUT, POST, DELETE, OPTIONS, PATCH"}) 129 | 130 | (defn wrap-suicidal-cors [handler] 131 | (fn [{:keys [request-method] :as req}] 132 | (let [resp (if (= request-method :options) 133 | {:status 200} 134 | (handler req))] 135 | (some-> 136 | resp 137 | (d/chain 138 | #(update % :headers (partial merge (cors-headers req)))))))) 139 | 140 | (def handler 141 | (-> (compojure/routes 142 | (compojure/GET "/numbers" [] handler-numbers) 143 | (compojure/GET "/echo" [] handler-echo) 144 | (compojure/POST "/echo" [] handler-echo) 145 | (compojure/POST "/echo/body" [] handler-echo-body) 146 | (compojure/GET "/ws-echo" [] handler-ws-echo) 147 | (compojure/GET "/redirect" [] handler-redirect) 148 | (compojure/GET "/ok" [] handler-ok) 149 | (compojure/GET "/events" [] handler-sse) 150 | (route/not-found "Oops!")) 151 | wrap-suicidal-cors 152 | wrap-params)) 153 | 154 | (defn start! [& [port]] 155 | (http/start-server handler {:port (or port 5000)})) 156 | 157 | (defn -main [& [port]] 158 | (aleph.netty/wait-for-close (start! (when port (Integer/parseInt port))))) 159 | -------------------------------------------------------------------------------- /test/kvlt/test/util.cljc: -------------------------------------------------------------------------------- 1 | (ns kvlt.test.util 2 | (:require [promesa.core :as p] 3 | [cats.core] 4 | #? (:clj [clojure.test :refer [is]] 5 | :cljs [cljs.test :refer-macros [is]]) 6 | #? (:clj [clojure.core.async :as async :refer [ ~t-name var meta :kvlt/skip any-env?)] 43 | (println "Skipping" ~(str t-name) "on" env#) 44 | (cljs.test/async 45 | done# 46 | (p/branch 47 | (promise* (do ~@forms)) 48 | #(done#) 49 | (fn [e#] 50 | (println (.. e# -stack)) 51 | (cljs.test/is (nil? e#)) 52 | (done#)))))) 53 | `(clojure.test/deftest ~t-name 54 | (-> (do ~@forms) promise* deref))))) 55 | 56 | (defn channel-promise [ch] 57 | (p/promise 58 | (fn [resolve reject] 59 | (go 60 | (let [timeout (async/timeout (* 20 1000)) 61 | result (alt! timeout ::timeout ch ([v] v))] 62 | (async/close! ch) 63 | (if (= result ::timeout) 64 | (reject (ex-info "timeout" {})) 65 | (resolve result))))))) 66 | 67 | (defn with-result [m f] 68 | #? (:clj 69 | (-> m p/promise deref f) 70 | :cljs 71 | (p/then (p/promise m) f))) 72 | 73 | #? (:clj 74 | (defmacro after-> [m & forms] 75 | (if (:ns &env) 76 | `(cats.core/>>= ~m ~@(map (fn [form] `#(-> % ~form)) forms)) 77 | `(-> ~m p/promise deref ~@forms)))) 78 | 79 | #? (:clj 80 | (defmacro is= [x y & [msg]] 81 | (if (:ns &env) 82 | `(cljs.test/is (= ~x ~y) ~msg) 83 | `(clojure.test/is (= ~x ~y) ~msg)))) 84 | 85 | (defn is-http-error [p] 86 | (with-result p 87 | (fn [{:keys [status type error] :as m}] 88 | (is= status 0) 89 | (is= type error :http-error) 90 | #? (:clj (is (m :kvlt.platform/error)))))) 91 | --------------------------------------------------------------------------------