├── .clj-kondo ├── config.edn └── imports │ ├── babashka │ └── fs │ │ └── config.edn │ ├── http-kit │ └── http-kit │ │ ├── config.edn │ │ └── httpkit │ │ └── with_channel.clj │ ├── lread │ └── status-line │ │ └── config.edn │ ├── rewrite-clj │ └── rewrite-clj │ │ └── config.edn │ └── taoensso │ └── encore │ ├── config.edn │ └── taoensso │ └── encore.clj ├── .github ├── CODEOWNERS └── workflows │ ├── publish.yml │ ├── shared-setup │ └── action.yml │ └── tests.yml ├── .gitignore ├── CHANGELOG.adoc ├── ORIGINATOR ├── README.adoc ├── bb.edn ├── build.clj ├── build └── build_shared.clj ├── deps.edn ├── doc ├── 01-user-guide.adoc ├── 02-developer-guide.adoc ├── 03-maintainer-guide.adoc └── cljdoc.edn ├── pom.xml ├── script ├── ci_publish.clj ├── download_deps.clj ├── lint.clj ├── publish.clj └── test_jvm.clj ├── src └── clj_http │ └── lite │ ├── client.clj │ ├── core.clj │ ├── links.clj │ └── util.clj ├── test-resources ├── keystore └── logback.xml └── test └── clj_http └── lite ├── client_sanity_test.clj ├── client_test.clj ├── integration_test.clj ├── links_test.clj └── test_util ├── http_server.clj ├── server_process.clj ├── server_state.clj └── test_report.clj /.clj-kondo/config.edn: -------------------------------------------------------------------------------- 1 | ;; don't adopt any user preferences 2 | {:config-paths ^:replace []} 3 | -------------------------------------------------------------------------------- /.clj-kondo/imports/babashka/fs/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as {babashka.fs/with-temp-dir clojure.core/let}} 2 | -------------------------------------------------------------------------------- /.clj-kondo/imports/http-kit/http-kit/config.edn: -------------------------------------------------------------------------------- 1 | 2 | {:hooks 3 | {:analyze-call {org.httpkit.server/with-channel httpkit.with-channel/with-channel}}} 4 | -------------------------------------------------------------------------------- /.clj-kondo/imports/http-kit/http-kit/httpkit/with_channel.clj: -------------------------------------------------------------------------------- 1 | (ns httpkit.with-channel 2 | (:require [clj-kondo.hooks-api :as api])) 3 | 4 | (defn with-channel [{node :node}] 5 | (let [[request channel & body] (rest (:children node))] 6 | (when-not (and request channel) (throw (ex-info "No request or channel provided" {}))) 7 | (when-not (api/token-node? channel) (throw (ex-info "Missing channel argument" {}))) 8 | (let [new-node 9 | (api/list-node 10 | (list* 11 | (api/token-node 'let) 12 | (api/vector-node [channel (api/vector-node [])]) 13 | request 14 | body))] 15 | 16 | {:node new-node}))) 17 | -------------------------------------------------------------------------------- /.clj-kondo/imports/lread/status-line/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as {lread.status-line/line clojure.tools.logging/infof 2 | lread.status-line/die clojure.tools.logging/infof}} 3 | -------------------------------------------------------------------------------- /.clj-kondo/imports/rewrite-clj/rewrite-clj/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as 2 | {rewrite-clj.zip/subedit-> clojure.core/-> 3 | rewrite-clj.zip/subedit->> clojure.core/->> 4 | rewrite-clj.zip/edit-> clojure.core/-> 5 | rewrite-clj.zip/edit->> clojure.core/->>}} 6 | -------------------------------------------------------------------------------- /.clj-kondo/imports/taoensso/encore/config.edn: -------------------------------------------------------------------------------- 1 | {:hooks 2 | {:analyze-call 3 | {taoensso.encore/defalias taoensso.encore/defalias 4 | taoensso.encore/defn-cached taoensso.encore/defn-cached 5 | taoensso.encore/defonce taoensso.encore/defonce}}} 6 | -------------------------------------------------------------------------------- /.clj-kondo/imports/taoensso/encore/taoensso/encore.clj: -------------------------------------------------------------------------------- 1 | (ns taoensso.encore 2 | "I don't personally use clj-kondo, so these hooks are 3 | kindly authored and maintained by contributors. 4 | PRs very welcome! - Peter Taoussanis" 5 | (:refer-clojure :exclude [defonce]) 6 | (:require 7 | [clj-kondo.hooks-api :as hooks])) 8 | 9 | (defn defalias 10 | [{:keys [node]}] 11 | (let [[sym-raw src-raw] (rest (:children node)) 12 | src (or src-raw sym-raw) 13 | sym (if src-raw sym-raw (symbol (name (hooks/sexpr src))))] 14 | {:node 15 | (with-meta 16 | (hooks/list-node 17 | [(hooks/token-node 'def) 18 | (hooks/token-node (hooks/sexpr sym)) 19 | (hooks/token-node (hooks/sexpr src))]) 20 | (meta src))})) 21 | 22 | (defn defn-cached 23 | [{:keys [node]}] 24 | (let [[sym _opts binding-vec & body] (rest (:children node))] 25 | {:node 26 | (hooks/list-node 27 | (list 28 | (hooks/token-node 'def) 29 | sym 30 | (hooks/list-node 31 | (list* 32 | (hooks/token-node 'fn) 33 | binding-vec 34 | body))))})) 35 | 36 | (defn defonce 37 | [{:keys [node]}] 38 | ;; args = [sym doc-string? attr-map? init-expr] 39 | (let [[sym & args] (rest (:children node)) 40 | [doc-string args] (if (and (hooks/string-node? (first args)) (next args)) [(hooks/sexpr (first args)) (next args)] [nil args]) 41 | [attr-map init-expr] (if (and (hooks/map-node? (first args)) (next args)) [(hooks/sexpr (first args)) (fnext args)] [nil (first args)]) 42 | 43 | attr-map (if doc-string (assoc attr-map :doc doc-string) attr-map) 44 | sym+meta (if attr-map (with-meta sym attr-map) sym) 45 | rewritten 46 | (hooks/list-node 47 | [(hooks/token-node 'clojure.core/defonce) 48 | sym+meta 49 | init-expr])] 50 | 51 | {:node rewritten})) 52 | -------------------------------------------------------------------------------- /.github/CODEOWNERS: -------------------------------------------------------------------------------- 1 | # Code owners are auto-invited to review PRs including files matching specified pattern(s). 2 | # We opt out of this by only matching the CODEOWNERS file itself. 3 | .github/CODEOWNERS @borkdude @lread @martinklepsch @slipset 4 | -------------------------------------------------------------------------------- /.github/workflows/publish.yml: -------------------------------------------------------------------------------- 1 | name: publish 2 | on: 3 | push: 4 | tags: 5 | - 'v\d+.*' 6 | 7 | jobs: 8 | test: 9 | uses: ./.github/workflows/tests.yml 10 | 11 | publish: 12 | environment: publish 13 | runs-on: ubuntu-latest 14 | needs: [test] 15 | 16 | steps: 17 | - name: Checkout 18 | uses: actions/checkout@v4 19 | 20 | - name: Setup 21 | uses: ./.github/workflows/shared-setup 22 | with: 23 | jdk: '8' 24 | 25 | - name: Deploy to clojars 26 | env: 27 | CLOJARS_USERNAME: ${{ secrets.CLOJARS_USERNAME }} 28 | CLOJARS_PASSWORD: ${{ secrets.CLOJARS_PASSWORD }} 29 | run: bb -ci-clojars-deploy 30 | 31 | - name: Create GitHub Release 32 | env: 33 | GH_TOKEN: ${{ secrets.GITHUB_TOKEN }} 34 | run: bb -ci-github-create-release 35 | 36 | - name: Inform Cljdoc 37 | run: bb -ci-cljdoc-request-build 38 | -------------------------------------------------------------------------------- /.github/workflows/shared-setup/action.yml: -------------------------------------------------------------------------------- 1 | name: 'shared setup' 2 | inputs: 3 | jdk: 4 | description: 'jdk version' 5 | required: true 6 | shell: 7 | # shell must be specified for run:s for composite actions 8 | description: 'which shell to use' 9 | required: false 10 | default: bash 11 | 12 | runs: 13 | using: 'composite' 14 | 15 | steps: 16 | - name: Clojure deps cache 17 | uses: actions/cache@v4 18 | with: 19 | path: | 20 | ~/.m2/repository 21 | ~/.deps.clj 22 | ~/.gitlibs 23 | key: cljdeps-${{ hashFiles('deps.edn', 'bb.edn') }} 24 | restore-keys: cljdeps- 25 | 26 | - name: Setup Java 27 | uses: actions/setup-java@v4 28 | with: 29 | distribution: 'temurin' 30 | java-version: ${{ inputs.jdk }} 31 | 32 | - name: Install Clojure Tools 33 | uses: DeLaGuardo/setup-clojure@13.4 34 | with: 35 | cli: 'latest' 36 | bb: 'latest' 37 | 38 | - name: Tools Versions 39 | shell: ${{ inputs.shell }} 40 | run: | 41 | echo "java -version" 42 | java -version 43 | echo "bb --version" 44 | bb --version 45 | echo "clojure --version" 46 | clojure --version 47 | 48 | - name: Download Clojure Dependencies 49 | shell: ${{ inputs.shell }} 50 | run: bb download-deps 51 | -------------------------------------------------------------------------------- /.github/workflows/tests.yml: -------------------------------------------------------------------------------- 1 | name: tests 2 | on: 3 | # allow this workflow to be called from other workflows, namely: publish 4 | workflow_call: 5 | push: 6 | branches: [ "master" ] 7 | pull_request: 8 | branches: [ "master" ] 9 | 10 | jobs: 11 | lint: 12 | runs-on: ubuntu-latest 13 | 14 | steps: 15 | - name: Checkout 16 | uses: actions/checkout@v4 17 | 18 | - name: Setup 19 | uses: ./.github/workflows/shared-setup 20 | with: 21 | jdk: '24' 22 | 23 | - name: Lint 24 | run: bb lint 25 | 26 | test-jvm: 27 | runs-on: ${{ matrix.os.name }}-latest 28 | strategy: 29 | fail-fast: false 30 | matrix: 31 | os: [{name: 'windows', shell: 'pwsh'}, {name: 'ubuntu', shell: 'bash'}] 32 | clojure-version: ["1.8", "1.9", "1.10", "1.11", "1.12"] 33 | jdk: ['8', '11', '17', '21', '24'] 34 | 35 | name: ${{ matrix.os.name }} clj-${{ matrix.clojure-version }} jdk${{ matrix.jdk }} 36 | 37 | steps: 38 | - name: Checkout 39 | uses: actions/checkout@v4 40 | 41 | - name: Setup 42 | uses: ./.github/workflows/shared-setup 43 | with: 44 | jdk: ${{ matrix.jdk }} 45 | shell: ${{ matrix.os.shell }} 46 | 47 | - name: Run tests 48 | run: bb test:jvm --clj-version ${{ matrix.clojure-version }} 49 | 50 | test-bb: 51 | runs-on: ${{ matrix.os.name }}-latest 52 | strategy: 53 | fail-fast: false 54 | matrix: 55 | os: [{name: 'windows', shell: 'pwsh'}, {name: 'ubuntu', shell: 'bash'}] 56 | 57 | name: ${{ matrix.os.name }} bb 58 | 59 | steps: 60 | - name: Checkout 61 | uses: actions/checkout@v4 62 | 63 | - name: Setup 64 | uses: ./.github/workflows/shared-setup 65 | with: 66 | jdk: '11' 67 | shell: ${{ matrix.os.shell }} 68 | 69 | - name: Run tests 70 | run: bb test:bb 71 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | target 2 | lib 3 | *.dot 4 | 5 | # use glob syntax. 6 | syntax: glob 7 | creds.clj 8 | Manifest.txt 9 | aws.clj 10 | *.ser 11 | *.class 12 | *.jar 13 | *~ 14 | *.bak 15 | *.off 16 | *.old 17 | .DS_Store 18 | *.#* 19 | *#* 20 | *.classpath 21 | *.project 22 | *.settings 23 | *.pyc 24 | .lein-failures 25 | /.lein-deps-sum 26 | .cache 27 | .cpcache 28 | .idea 29 | *.iml 30 | -------------------------------------------------------------------------------- /CHANGELOG.adoc: -------------------------------------------------------------------------------- 1 | = Changelog 2 | 3 | A release with known breaking changes is marked with: 4 | 5 | * [breaking] you probably need to change your code 6 | * [minor breaking] you likely don't need to change your code 7 | 8 | // DO NOT EDIT: the "Unreleased" section header is automatically updated by bb publish 9 | // bb publish will fail on any of: 10 | // - unreleased section not found, 11 | // - unreleased section empty 12 | // - optional attribute is not [breaking] or [minor breaking] 13 | // (adjust these in publish.clj as you see fit) 14 | == Unreleased 15 | 16 | == v1.0.13 - 2022-09-29 [[v1.0.13]] 17 | 18 | * If specified, request’s body encoding is now applied, else defaults to UTF-8 (https://github.com/clj-commons/clj-http-lite/issues/18[#18]) (https://github.com/lread[@lread]) 19 | * User info from request URL now applied to basic auth (https://github.com/clj-commons/clj-http-lite/issues/34[#34]) (https://github.com/lread[@lread]) 20 | * Nested query and form parameters are now automatically flattened (https://github.com/clj-commons/clj-http-lite/issues/43[#43]) (https://github.com/lread[@lread]) 21 | * The `:insecure?` option is now applied only to the current request (https://github.com/clj-commons/clj-http-lite/issues/45[#45]) (https://github.com/lread[@lread]) 22 | * Docs 23 | ** Docstrings and README reviewed and updated (https://github.com/lread[@lread]) 24 | ** Guidance on mocking HTTP requests now makes sense (https://github.com/clj-commons/clj-http-lite/issues/51[#51]) (thanks https://github.com/anderseknert[@anderseknert]!) 25 | ** Move from Markdown to AsciiDoc (https://github.com/lread[@lread]) 26 | * Quality 27 | ** Automated CI testing added for Windows (https://github.com/clj-commons/clj-http-lite/issues/21[#21]) (https://github.com/lread[@lread]) 28 | ** Babashka now exercised under full test suite (https://github.com/clj-commons/clj-http-lite/issues/48[#48]) (https://github.com/lread[@lread]) 29 | 30 | https://github.com/clj-commons/clj-http-lite/compare/Release-0.4.392\...v1.0.13[commit log] 31 | 32 | == v0.4.392 - 2021-11-18 33 | 34 | * Support self-signed certificates via `:insecure? true` option 35 | * Remove dependency on slingshot 36 | * Move to `org.clj-commons` group 37 | * Add compatibility with https://babashka.org/[babashka] 38 | * *Feature:* Support for`:oauth-token` (https://github.com/martinklepsch/clj-http-lite/pull/7[#1]) 39 | 40 | == v0.4.3 - 2019-12-04 41 | 42 | * *Feature:* Parse link headers from response and put them under `:links` (https://github.com/martinklepsch/clj-http-lite/pull/1[#1]) 43 | 44 | == v0.4.1 - 2018-10-17 45 | 46 | * Add type hints for GraalVM (https://github.com/clj-commons/clj-http-lite/pull/2[#2]) 47 | 48 | == v0.4.0 - 2018-10-17 49 | 50 | * *Feature:* Java 9/10 Compatibility 51 | -------------------------------------------------------------------------------- /ORIGINATOR: -------------------------------------------------------------------------------- 1 | @hiredman 2 | -------------------------------------------------------------------------------- /README.adoc: -------------------------------------------------------------------------------- 1 | = `clj-http-lite` 2 | :project-src-coords: clj-commons/clj-http-lite 3 | :project-mvn-coords: org.clj-commons/clj-http-lite 4 | :url-doc: https://cljdoc.org/d/{project-mvn-coords} 5 | 6 | // Badges 7 | link:{url-doc}[image:https://cljdoc.org/badge/{project-mvn-coords}[Cljdoc]] 8 | https://github.com/{project-src-coords}/actions/workflows/tests.yml[image:https://github.com/{project-src-coords}/workflows/tests/badge.svg[GitHub Actions tests]] 9 | https://clojars.org/{project-mvn-coords}[image:https://img.shields.io/clojars/v/{project-mvn-coords}.svg[Clojars]] 10 | https://babashka.org[image:https://raw.githubusercontent.com/babashka/babashka/master/logo/badge.svg[bb compatible]] 11 | https://clojurians.slack.com/archives/C03UZ1Y8414[image:https://img.shields.io/badge/slack-join_chat-brightgreen.svg[Join chat]] 12 | 13 | A Clojure HTTP library similar to http://github.com/dakrone/clj-http[clj-http], but more lightweight. 14 | Compatible with Babashka and GraalVM. 15 | ____ 16 | This is a clj-commons maintained fork of the archived https://github.com/hiredman/clj-http-lite[`hiredman/clj-http-lite`] repo. 17 | ____ 18 | 19 | == Documentation 20 | 21 | * link:doc/01-user-guide.adoc[User Guide] 22 | * link:doc/02-developer-guide.adoc[Developer Guide] 23 | 24 | == Used In... 25 | Some project using clj-http-lite are: 26 | 27 | * https://github.com/clj-holmes/clj-holmes[clj-holmes] - Static application security tool for finding vulnerable Clojure code 28 | * https://cljdoc.org/[cljdoc site] (https://github.com/cljdoc/cljdoc[sources]) - A central documentation hub for the Clojure community 29 | * https://github.com/clj-commons/etaoin[Etaoin] - Pure Clojure WebDriver protocol implementation 30 | * https://github.com/djblue/portal[portal] (for tests) - A clojure tool to navigate through your data 31 | * https://github.com/sethtrain/raven-clj[raven-clj] - A Clojure interface to Sentry 32 | * https://github.com/epiccastle/spire[spire] - pragmatic provisioning using Clojure 33 | 34 | Don't see your project listed? Let us know, we'll be happy to include it! 35 | 36 | == People 37 | 38 | === Contributors 39 | 40 | A big thank you to all the people who have contributed directly to clj-http-lite! 41 | 42 | * https://github.com/katox[@katox] 43 | * https://github.com/sattvik[@sattvik] 44 | * https://github.com/AdamClements[@AdamClements] 45 | * https://github.com/ivarref[@ivarref] 46 | * https://github.com/imrekoszo[@imrekoszo] 47 | * https://github.com/avichalp[@avichalp] 48 | * https://github.com/arnaudbos[@arnaudbos] 49 | * https://github.com/gaberger[@gaberger] 50 | * https://github.com/vemv[@vemv] 51 | * https://github.com/deas[@deas] 52 | * https://github.com/anderseknert[@anderseknert] 53 | * https://github.com/mokshasoft[@mokshasoft] 54 | 55 | Don't see your name? Our apologies! Let us know and we'll add you in. 56 | 57 | === Founders 58 | 59 | * https://github.com/dakrone[@dakrone] - the creator of clj-http 60 | * https://github.com/hiredman[@hiredman] - the creator of clj-http-lite 61 | * https://github.com/martinklepsch[@martinklepsch] - maintainer of clj-http-lite 62 | 63 | === Current Active Maintainers 64 | 65 | * https://github.com/lread[@lread] 66 | * https://github.com/borkdude[@borkdude] 67 | 68 | == License 69 | We respect the original license at the time of forking from clj-http: 70 | 71 | Released under the MIT License: http://www.opensource.org/licenses/mit-license.php 72 | -------------------------------------------------------------------------------- /bb.edn: -------------------------------------------------------------------------------- 1 | {:paths ["script" "build"] 2 | :deps {lread/status-line {:git/url "https://github.com/lread/status-line.git" 3 | :sha "cf44c15f30ea3867227fa61ceb823e5e942c707f"} 4 | version-clj/version-clj {:mvn/version "2.0.3"}} 5 | :tasks {;; setup 6 | :requires ([babashka.fs :as fs] 7 | [clojure.string :as string] 8 | [lread.status-line :as status]) 9 | :enter (let [{:keys [name]} (current-task)] (status/line :head "TASK %s %s" name (string/join " " *command-line-args*))) 10 | :leave (let [{:keys [name]} (current-task)] (status/line :detail "\nTASK %s done." name)) 11 | 12 | ;; tasks 13 | clean 14 | {:doc "Delete any work/cache dirs" 15 | :task (doseq [dir ["target" ".cpcache"]] 16 | (if (fs/exists? dir) 17 | (do 18 | (status/line :detail "Deleting: %s" dir) 19 | (fs/delete-tree dir)) 20 | (status/line :detail "Does not exist: %s" dir)))} 21 | download-deps 22 | {:doc "Bring down all the clojure deps" 23 | :task download-deps/-main} 24 | test:jvm 25 | {:doc "Runs tests under JVM Clojure [--clj-version] (recognizes cognitect test-runner args)" 26 | :task test-jvm/-main} 27 | test:bb 28 | {:doc "Runs tests under babashka Clojure (recognizes cognitect test-runner args)" 29 | :extra-paths ["src" "test" "test-resources"] 30 | :extra-deps {io.github.cognitect-labs/test-runner 31 | {:git/tag "v0.5.1" :git/sha "dfb30dd"}} 32 | :requires ([cognitect.test-runner :as tr]) 33 | :task (apply tr/-main *command-line-args*)} 34 | lint 35 | {:doc "[--rebuild] Lint source code" 36 | :task lint/-main} 37 | outdated 38 | {:doc "Report on outdated dependencies" 39 | :task (clojure {:continue true} "-M:outdated")} 40 | pubcheck 41 | {:doc "run only publish checks (without publishing)" 42 | :task publish/pubcheck} 43 | publish 44 | {:doc "Trigger a release to clojars" 45 | :task publish/-main} 46 | neil ;; let's not rely on a random version of neil 47 | {:doc "Pinned version of babashka/neil (used in scripting)" 48 | :extra-deps {io.github.babashka/neil {:git/tag "v0.3.68" :git/sha "78ffab1"}} 49 | :task babashka.neil/-main} 50 | ;; hidden tasks, no need for folks to be trying these ci invoked tasks 51 | -ci-clojars-deploy 52 | {:doc "triggered on ci by release tag" 53 | :task ci-publish/clojars-deploy} 54 | -ci-github-create-release 55 | {:doc "triggered on ci by release tag" 56 | :task ci-publish/github-create-release} 57 | -ci-cljdoc-request-build 58 | {:doc "ask cljdoc to build docs for new release" 59 | :task ci-publish/cljdoc-request-build}}} 60 | -------------------------------------------------------------------------------- /build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:require [build-shared] 3 | [clojure.tools.build.api :as b])) 4 | 5 | (def version (build-shared/lib-version)) 6 | (def lib (build-shared/lib-artifact-name)) 7 | 8 | ;; build constants 9 | (def class-dir "target/classes") 10 | (def basis (b/create-basis {:project "deps.edn"})) 11 | (def jar-file (format "target/%s-%s.jar" (name lib) version)) 12 | 13 | (defn jar [_] 14 | (println "jarring version" version) 15 | (b/write-pom {:class-dir class-dir 16 | :lib lib 17 | :version version 18 | :scm {:tag (build-shared/version->tag version)} 19 | :basis basis 20 | :src-dirs ["src"]}) 21 | (b/copy-dir {:src-dirs ["src"] 22 | :target-dir class-dir}) 23 | (b/jar {:class-dir class-dir 24 | :jar-file jar-file})) 25 | 26 | (defn install [_] 27 | (jar {}) 28 | (println "installing version" version) 29 | (b/install {:basis basis 30 | :lib lib 31 | :version version ;; can't remember why we need to repeat version here, it is in jar-file 32 | :jar-file jar-file 33 | :class-dir class-dir})) 34 | 35 | (defn deploy [opts] 36 | (jar opts) 37 | (println "deploy") 38 | ((requiring-resolve 'deps-deploy.deps-deploy/deploy) 39 | (merge {:installer :remote 40 | :artifact jar-file 41 | :pom-file (b/pom-path {:lib lib :class-dir class-dir})} 42 | opts)) 43 | opts) 44 | -------------------------------------------------------------------------------- /build/build_shared.clj: -------------------------------------------------------------------------------- 1 | (ns build-shared 2 | "a few things that are both needed by bb script code and build.clj" 3 | (:require [clojure.string :as string] 4 | [clojure.edn :as edn])) 5 | 6 | (defn- project-info [] 7 | (-> (edn/read-string (slurp "deps.edn")) 8 | :aliases :neil :project)) 9 | 10 | (def version-tag-prefix "v") 11 | 12 | (defn lib-version [] 13 | (-> (project-info) :version)) 14 | 15 | (defn lib-artifact-name [] 16 | (-> (project-info) :name)) 17 | 18 | (defn version->tag [version] 19 | (str version-tag-prefix version)) 20 | 21 | (defn tag->version [ci-tag] 22 | (and (string/starts-with? ci-tag version-tag-prefix) 23 | (string/replace-first ci-tag version-tag-prefix ""))) 24 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src"] 2 | :deps {org.clojure/clojure {:mvn/version "1.8.0"}} 3 | :aliases 4 | {;; we use babashka/neil for project attributes 5 | ;; publish workflow references these values (and automatically bumps patch) 6 | :neil {:project {:version "1.0.13" 7 | :name org.clj-commons/clj-http-lite}} 8 | :1.8 {:override-deps {org.clojure/clojure {:mvn/version "1.8.0"}}} 9 | :1.9 {:override-deps {org.clojure/clojure {:mvn/version "1.9.0"}}} 10 | :1.10 {:override-deps {org.clojure/clojure {:mvn/version "1.10.3"}}} 11 | :1.11 {:override-deps {org.clojure/clojure {:mvn/version "1.11.4"}}} 12 | :1.12 {:override-deps {org.clojure/clojure {:mvn/version "1.12.1"}}} 13 | :build 14 | {:extra-paths ["build"] 15 | :deps {io.github.clojure/tools.build {:mvn/version "0.10.9"} 16 | slipset/deps-deploy {:mvn/version "0.2.2"}} 17 | :ns-default build} 18 | :http-server ;; used for to support integration tests 19 | {:extra-paths ["test" "test-resources"] 20 | :override-deps {org.clojure/clojure {:mvn/version "1.12.1"}} 21 | :extra-deps {babashka/fs {:mvn/version "0.5.25"} 22 | ring/ring-jetty-adapter {:mvn/version "1.10.0"} ;; stick with version that works on jdk8 23 | ch.qos.logback/logback-classic {:mvn/version "1.3.15" 24 | :exclusions [org.slf4j/slf4j-api]} 25 | org.slf4j/jcl-over-slf4j {:mvn/version "2.0.17"} 26 | org.slf4j/jul-to-slf4j {:mvn/version "2.0.17"} 27 | org.slf4j/log4j-over-slf4j {:mvn/version "2.0.17"}} 28 | :exec-fn clj-http.lite.test-util.http-server/run} 29 | :test 30 | {:extra-paths ["test"] 31 | :extra-deps {io.github.cognitect-labs/test-runner 32 | {:git/tag "v0.5.1" :git/sha "dfb30dd"}} 33 | :main-opts ["-m" "cognitect.test-runner"]} 34 | ;; for consistent linting we use a specific version of clj-kondo through the jvm 35 | :clj-kondo {:extra-deps {clj-kondo/clj-kondo {:mvn/version "2025.06.05"}} 36 | :override-deps {org.clojure/clojure {:mvn/version "1.12.1"}} 37 | :main-opts ["-m" "clj-kondo.main"]} 38 | :outdated {:extra-deps {com.github.liquidz/antq {:mvn/version "2.11.1276"} 39 | org.clojure/clojure {:mvn/version "1.12.1"} 40 | org.slf4j/slf4j-simple {:mvn/version "2.0.17"} ;; to rid ourselves of logger warnings 41 | } 42 | :main-opts ["-m" "antq.core" 43 | "--exclude=ch.qos.logback/logback-classic@1.4.x" ;; requires min jdk 11, we are jdk8 compatible 44 | "--exclude=ch.qos.logback/logback-classic@1.5.x" ;; requires min jdk 11, we are jdk8 compatible 45 | "--exclude=ring/ring-jetty-adapter@1.11.x" ;; requires jdk 11, we are jdk8 compatible 46 | "--exclude=ring/ring-jetty-adapter@1.12.x" ;; requires jdk 11, we are jdk8 compatible 47 | "--exclude=ring/ring-jetty-adapter@1.13.x" ;; requires jdk 11, we are jdk8 compatible 48 | "--exclude=ring/ring-jetty-adapter@1.14.x" ;; requires jdk 11, we are jdk8 compatible 49 | ]}}} 50 | -------------------------------------------------------------------------------- /doc/01-user-guide.adoc: -------------------------------------------------------------------------------- 1 | = User Guide 2 | :toclevels: 5 3 | :toc: 4 | // DO NOT EDIT: the lib-version parameter is automatically updated by bb publish 5 | :lib-version: 1.0.13 6 | 7 | == Introduction 8 | Clj-http-lite is a Clojure, Babashka and GraalVM compatible liteweight subset of http://github.com/dakrone/clj-http[clj-http]. 9 | 10 | === Differences from clj-http 11 | 12 | * Instead of Apache HttpClient, clj-http-lite uses HttpURLConnection 13 | * No automatic JSON decoding for response bodies 14 | * No automatic request body encoding beyond charset and url encoding of form params 15 | * No cookie support 16 | * No multipart form uploads 17 | * No persistent connection support 18 | * Fewer options 19 | * namespace rename `+clj-http.*+` -> `+clj-http.lite.*+` 20 | 21 | Like its namesake, clj-http-lite is light and simple, but ping us if there is some clj-http feature you’d like to see in clj-http-lite. 22 | We can discuss. 23 | 24 | === Supported Environments [[supported-envs]] 25 | 26 | * JDK 8, 11, 17, 21 27 | * Clojure 1.8 runtime and above 28 | * Babashka current release 29 | * Windows, Linux, macOS 30 | 31 | === History 32 | 33 | * Sep 2011 - https://github.com/dakrone/clj-http[dakrone/clj-http] created (and is still actively maintained) 34 | * Feb 2012 - https://github.com/hiredman/clj-http-lite[hiredman/clj-http-lite] (now archived) forked from `dakrone/clj-http` to use Java’s HttpURLConnection instead of Apache HttpClient. 35 | * Jul 2018 - `martinklepsch/clj-http-lite` forked from `hiredman/clj-http-lite` for new development and maintenance 36 | * Nov 2021 - Martin transfered his fork to `clj-commons/clj-http-lite` so it could get the ongoing love it needs from the Clojure community 37 | 38 | === Interesting Alternatives 39 | 40 | Maybe clj-http-lite is not your cup of tea? Some alternatives to explore: 41 | 42 | Clojure based: 43 | 44 | * http://github.com/dakrone/clj-http[clj-http] (jdk8+) - heavier than clj-http-lite, but has many more features 45 | 46 | Babashka compatible: 47 | 48 | * https://github.com/babashka/http-client[babashka/http-client] (jdk11+) - HTTP client for Clojure and Babashka built on java.net.http 49 | * https://github.com/schmee/java-http-clj[java-http-clj] (jdk11+) - Clojure wrapper for java.net.http with async, HTTP/2 and WebSockets 50 | * https://github.com/http-kit/http-kit[http-kit] (jdk8+?) - minimalist, event-driven, high-performance Clojure HTTP server/client library with WebSocket and asynchronous support 51 | * https://github.com/gnarroway/hato[hato] (jdk11+) - An HTTP client for Clojure, wrapping JDK 11's HttpClient 52 | * https://github.com/babashka/babashka.curl[babashka.curl] (jdk8+) - A tiny curl wrapper via idiomatic Clojure, inspired by clj-http, Ring and friends (now mostly replaced by babashka/http-client) 53 | 54 | == Installation 55 | 56 | Clojure cli users, add the following under `:deps` in your `deps.edn` file. + 57 | Babashka users, add the following under `:deps` in your `bb.edn` file: 58 | [source,clojure,subs="attributes+"] 59 | ---- 60 | org.clj-commons/clj-http-lite {:mvn/version "{lib-version}"} 61 | ---- 62 | 63 | Lein users, add the following into the `:dependencies` vector in your `project.clj` file: 64 | 65 | [source,clojure,subs="attributes+"] 66 | ---- 67 | [org.clj-commons/clj-http-lite "{lib-version}"] 68 | ---- 69 | 70 | == Usage 71 | 72 | === General 73 | HTTP client functionality is provided by the `clj-http.lite.client` namespace: 74 | 75 | [source,clojure] 76 | ---- 77 | (require '[clj-http.lite.client :as client]) 78 | ---- 79 | 80 | The client supports simple `get`, `head`, `put`, `post`, and `delete` requests. 81 | They all return Ring-style response maps: 82 | 83 | [source,clojure] 84 | ---- 85 | (client/get "https://google.com") 86 | => {:status 200 87 | :headers {"date" "Wed, 17 Aug 2022 21:37:58 GMT" 88 | "cache-control" "private, max-age=0" 89 | "content-type" "text/html; charset=ISO-8859-1" 90 | ...} 91 | :body "..."} 92 | ---- 93 | 94 | TIP: We encourage you to try out these examples in your REPL, `httpbin.org` is a free HTTP test playground and used in many of our examples. 95 | 96 | [source,clojure] 97 | ---- 98 | (client/get "https://httpbin.org/user-agent") 99 | 100 | ;; Tell the server you'd like a json response 101 | (client/get "https://httpbin.org/user-agent" {:accept :json}) 102 | 103 | ;; Or maybe you'd like html back 104 | (client/get "https://httpbin.org/html" {:accept "text/html"}) 105 | 106 | ;; Various options 107 | (client/post "https://httpbin.org/anything" 108 | {:basic-auth ["joe" "cool"] 109 | :body "{\"json\": \"input\"}" 110 | :headers {"X-Api-Version" "2"} 111 | :content-type :json 112 | :socket-timeout 1000 113 | :conn-timeout 1000 114 | :accept :json}) 115 | 116 | ;; Need to contact a server with an untrusted SSL cert? 117 | (client/get "https://expired.badssl.com" {:insecure? true}) 118 | 119 | ;; By default we automatically follow 30* redirects... 120 | (client/get "https://httpbin.org/redirect-to?url=https%3A%2F%2Fclojure.org") 121 | 122 | ;; ... but you don't have to 123 | (client/get "https://httpbin.org/redirect-to?url=https%3A%2F%2Fclojure.org" 124 | {:follow-redirects false}) 125 | 126 | ;; Send form params as a urlencoded body 127 | (client/post "https://httpbin.org/post" {:form-params {:foo "bar"}}) 128 | 129 | ;; Basic authentication 130 | (client/get "https://joe:cool@httpbin.org/basic-auth/joe/cool") 131 | (client/get "https://httpbin.org/basic-auth/joe/cool" {:basic-auth ["joe" "cool"]}) 132 | (client/get "https://httpbin.org/basic-auth/joe/cool" {:basic-auth "joe:cool"}) 133 | 134 | ;; Query parameters can be specified as a map 135 | (client/get "https://httpbin.org/get" {:query-params {"q" "foo, bar"}}) 136 | ---- 137 | 138 | The client transparently accepts and decompresses the `gzip` and `deflate` content encodings. 139 | 140 | [source,clojure] 141 | ---- 142 | (client/get "https://httpbin.org/gzip") 143 | 144 | (client/get "https://httpbin.org/deflate") 145 | ---- 146 | 147 | === Nested params 148 | 149 | Nested parameter `{:a {:b 1}}` in `:form-params` or `:query-params` is automatically flattened to `a[b]=1`. 150 | 151 | [source,clojure] 152 | ---- 153 | (-> (client/get "https://httpbin.org/get" 154 | {:query-params {:one {:two 2 :three 3}}}) 155 | :body 156 | println) 157 | { 158 | "args": { 159 | "one[three]": "3", 160 | "one[two]": "2" 161 | }, 162 | ... 163 | } 164 | 165 | (-> (client/post "https://httpbin.org/post" 166 | {:form-params {:one {:two 2 167 | :three {:four {:five 5}}} 168 | :six 6}}) 169 | :body 170 | println) 171 | { 172 | ... 173 | "form": { 174 | "one[three][four][five]": "5", 175 | "one[two]": "2", 176 | "six": "6" 177 | }, 178 | ... 179 | } 180 | ---- 181 | 182 | === Request body coercion 183 | 184 | [source,clojure] 185 | ---- 186 | ;; body as byte-array 187 | (client/post "https://httbin.org/post" {:body (.getBytes "testing123")}) 188 | 189 | ;; body from a string 190 | (client/post "https://httpbin.org/post" {:body "testing456"}) 191 | 192 | ;; string :body-encoding is optional and defaults to "UTF-8" 193 | (client/post "https://httpbin.org/post" 194 | {:body "mystring" :body-encoding "UTF-8"}) 195 | 196 | ;; body from a file 197 | (require '[clojure.java.io :as io]) 198 | (spit "clj-http-lite-test.txt" "from a file") 199 | (client/post "https://httpbin.org/post" 200 | {:body (io/file "clj-http-lite-test.txt") 201 | :body-encoding "UTF-8"}) 202 | 203 | ;; from a stream 204 | (with-open [is (io/input-stream "clj-http-lite-test.txt")] 205 | (client/post "https://httpbin.org/post" 206 | {:body (io/input-stream "clj-http-lite-test.txt")}) ) 207 | ---- 208 | 209 | === Output body coercion 210 | 211 | [source,clojure] 212 | ---- 213 | ;; The default response body is a string body 214 | (client/get "https://clojure.org") 215 | 216 | ;; Coerce to a byte-array 217 | (client/get "http://clojure.org" {:as :byte-array}) 218 | 219 | ;; Coerce to a string with using a specific charset, default is UTF-8 220 | (client/get "http://clojure.org" {:as "US-ASCII"}) 221 | 222 | ;; Try to automatically coerce the body based on the content-type 223 | ;; response header charset 224 | (client/get "https://google.com" {:as :auto}) 225 | 226 | ;; Return the body as a stream 227 | ;; Note that the connection to the server will NOT be closed until the 228 | ;; stream has been read 229 | (let [res (client/get "https://clojure.org" {:as :stream})] 230 | (with-open [body-stream (:body res)] 231 | (slurp body-stream))) 232 | ---- 233 | 234 | A more general `request` function is also available, which is useful as a primitive for building higher-level interfaces: 235 | 236 | [source,clojure] 237 | ---- 238 | (defn api-action [method path & [opts]] 239 | (client/request 240 | (merge {:method method :url (str "https://some.api/" path)} opts))) 241 | ---- 242 | 243 | === Exceptions 244 | 245 | When a server returns an exceptional HTTP status code, by default, clj-http-lite throws an `ex-info` exception. 246 | The response is included as `ex-data`. 247 | 248 | [source,clojure] 249 | ---- 250 | (client/get "https://httpbin.org/404") 251 | ;; => ExceptionInfo clj-http: status 404 clojure.core/ex-info (core.clj:4617) 252 | 253 | (-> *e ex-data :status) 254 | ;; => 404 255 | 256 | (-> *e ex-data keys) 257 | ;; => (:headers :status :body) 258 | ---- 259 | 260 | You can suppress HTTP status exceptions and handle them yourself via the `:throw-exceptions` option: 261 | 262 | [source,clojure] 263 | ---- 264 | (client/get "https://httpbin.org/404" {:throw-exceptions false}) 265 | ---- 266 | 267 | You can choose to ignore an unknown host via `:ingore-unknown-host?` option. 268 | When enabled, requests return `nil` if the host is not found. 269 | 270 | [source,clojure] 271 | ---- 272 | (client/get "http://aoeuntahuf89o.com" {:ignore-unknown-host? true}) 273 | ;; => nil 274 | ---- 275 | 276 | === Proxies 277 | 278 | A proxy can be specified by setting the Java properties: `.proxyHost` and `.proxyPort` where `` is the client scheme used (normally `http' or `https'). 279 | 280 | == Mocking clj-http-lite responses 281 | 282 | Mocking responses from the clj-http-lite client in tests is easily accomplished with e.g. `with-redefs`: 283 | 284 | [source,clojure] 285 | ---- 286 | (defn my-http-function [] 287 | (let [response (client/get "https://example.org")] 288 | (when (= 200 (:status response)) 289 | (:body response)))) 290 | 291 | (deftest my-http-function-test 292 | (with-redefs [client/get (fn [_] {:status 200 :headers {"content-type" "text/plain"} :body "OK"})] 293 | (is (= (my-http-function) "OK")))) 294 | ---- 295 | 296 | More advanced mocking may be performed by matching attributes in the `request`, like the `mock-response` function below. 297 | 298 | [source,clojure] 299 | ---- 300 | (ns http-test 301 | (:require [clojure.data.json :as json] 302 | [clojure.test :refer [deftest is testing]] 303 | [clj-http.lite.client :as client])) 304 | 305 | (defn send-report [data] 306 | (:body (client/post "https://example.com/reports" {:body data}))) 307 | 308 | (defn get-users [] 309 | (json/read-str (:body (client/get "https://example.com/users")))) 310 | 311 | (defn get-admin [] 312 | (let [response (client/get "https://example.com/admin")] 313 | (if (= 200 (:status response)) 314 | (:body response) 315 | "403 Forbidden"))) 316 | 317 | (defn mock-response [{:keys [url method body] :as request}] 318 | (condp = [url method] 319 | ["https://example.com/reports" :post] 320 | {:status 201 :headers {"content-type" "text/plain"} :body (str "created: " body)} 321 | 322 | ["https://example.com/users" :get] 323 | {:status 200 :headers {"content-type" "application/json"} :body (json/write-str ["joe" "jane" "bob"])} 324 | 325 | ["https://example.com/admin" :get] 326 | {:status 403 :headers {"content-type" "text/plain"} :body "forbidden"} 327 | 328 | (throw (ex-info "unexpected request" request)))) 329 | 330 | (deftest send-report-test 331 | (with-redefs [client/request mock-response] 332 | (testing "sending report" 333 | (is (= (send-report {:balance 100}) "created: {:balance 100}"))) 334 | (testing "list users" 335 | (is (= (get-users) ["joe" "jane" "bob"]))) 336 | (testing "access admin page" 337 | (is (= (get-admin) "403 Forbidden"))))) 338 | ---- 339 | 340 | == GraalVM Native Image Tips 341 | 342 | You’ll need to enable url protocols when building your native image. 343 | 344 | See https://www.graalvm.org/22.2/reference-manual/native-image/dynamic-features/URLProtocols/[GraalVM docs]. 345 | 346 | == Design 347 | 348 | The design of `clj-http` (and therefore `clj-http-lite`) is inspired by the https://github.com/ring-clojure/ring[Ring] protocol for Clojure HTTP server applications. 349 | 350 | The client in `clj-http.lite.core` makes HTTP requests according to a given Ring request map and returns Ring response maps corresponding to the resulting HTTP response. 351 | The function `clj-http.lite.client/request` uses Ring-style middleware to layer functionality over the core HTTP request/response implementation. 352 | Methods like `clj-http.lite.client/get` are sugar over this `clj-http.lite.client/request` function. 353 | -------------------------------------------------------------------------------- /doc/02-developer-guide.adoc: -------------------------------------------------------------------------------- 1 | = Developer Guide 2 | 3 | == Contributing 4 | 5 | We very much appreciate contributions from the community. 6 | 7 | === Issue First Please 8 | 9 | If you have an idea or a fix, please do raise a GitHub issue before investing in any coding effort. That way we can discuss first. 10 | Writing code is the easy part, maintaining it forever is the hard part. 11 | 12 | That said, if you notice a simple typo, a PR without an issue is fine. 13 | 14 | === Submitting a Pull Request 15 | 16 | Please never force push on your PR, as this makes reviewing incremental changes impossible for us. 17 | When we merge your PR, we'll usually squash it, so that will clean up any rambling work in progress. 18 | 19 | == Environmental Overview 20 | 21 | === Developer Prerequisites 22 | 23 | The current version of Babashka. 24 | 25 | * Our scripts use Babashka to launch Clojure, so you don't absolutely need the Clojure cli's `clojure` command. 26 | * JDK, see <<01-user-guide.adoc#supported-envs,supported environments>> 27 | 28 | === Babashka Compatibility 29 | 30 | Clj-http-lite is babashka compatible. 31 | 32 | Babashka supports everything that clj-http-lite needs, but when making changes, be aware that your code must also work under Babashka. 33 | 34 | If your change requires something Babashka does not currently support, we can bring it up with the babashka team, things like adding a class are usually approved. 35 | 36 | == Docs 37 | 38 | All documentation is written in AsciiDoc. 39 | @lread likes to follow https://asciidoctor.org/docs/asciidoc-recommended-practices/#one-sentence-per-line[AsciiDoc best practice of one sentence per line] but won't be entirely pedantic about that. 40 | 41 | We host our docs on cljdoc. 42 | 43 | == Babashka Tasks 44 | 45 | We use Babashka tasks, to see all available tasks run: 46 | 47 | [source,shell] 48 | ---- 49 | bb tasks 50 | ---- 51 | 52 | === Clojure JVM Tests 53 | 54 | Optionally: 55 | 56 | [source,shell] 57 | ---- 58 | $ bb clean 59 | $ bb deps 60 | ---- 61 | 62 | Run all Clojure tests against minimum supported version of Clojure (1.8): 63 | 64 | [source,shell] 65 | ---- 66 | $ bb test:jvm 67 | ---- 68 | 69 | Run tests against a specific Clojure version, for example 1.11 70 | 71 | [source,shell] 72 | ---- 73 | $ bb test:jvm --clj-version 1.11 74 | ---- 75 | 76 | You can also include cognitect test runner options: 77 | 78 | [source,shell] 79 | ---- 80 | $ bb test:jvm --clj-version 1.9 --namespace-regex '*.sanity.*' 81 | ---- 82 | 83 | === Babashka Tests[bb-tests] 84 | 85 | To run the entire test suite under Babashka: 86 | 87 | [source,shell] 88 | ---- 89 | $ bb test:bb 90 | ---- 91 | 92 | You can also include cognitect test runner options: 93 | 94 | [source,shell] 95 | ---- 96 | $ bb test:bb --var clj-http.lite.integration-test/roundtrip 97 | ---- 98 | 99 | === Linting 100 | 101 | Our CI workflow lints sources with clj-kondo, and you can too! 102 | 103 | [source,shell] 104 | ---- 105 | $ bb lint 106 | ---- 107 | -------------------------------------------------------------------------------- /doc/03-maintainer-guide.adoc: -------------------------------------------------------------------------------- 1 | = Maintainer Guide 2 | :toc: levels 4 3 | 4 | == Audience 5 | You are a maintainer of this project. 6 | 7 | == Publishing a New Release 8 | Is invoked from the command line via: 9 | 10 | [source,shell] 11 | ---- 12 | bb publish 13 | ---- 14 | 15 | It validates: 16 | 17 | * local git 18 | ** you are on master branch 19 | ** do not have any uncommitted code 20 | ** do not have any unpushed commits 21 | * changelog 22 | ** Has an "Unreleased" section with content 23 | 24 | Then locally: 25 | 26 | . bumps the version `` (our scheme is `major.minor.`) 27 | ** Our version is stored in `deps.edn` under `:aliases` `:neil` `:project` `:version` 28 | . applies version to: 29 | .. `doc/01-user-guide.adoc` 30 | .. `CHANGELOG.adoc` 31 | . git commits: `deps.edn` `doc/01-user-guide.adoc` `CHANGELOG.adoc` 32 | . git tags with release tag `v` 33 | . pushes commit 34 | . pushes tag 35 | 36 | Then up on CI, the CI publish workflow is only triggered when it sees a release tag: 37 | 38 | . CI tests workflow is invoked 39 | . a release jar is published to clojars 40 | . a GitHub release is created 41 | . cljdoc is informed of the new release 42 | 43 | TIP: you can run just the publish validations alone via `bb pubcheck` 44 | 45 | == Relevant Sources 46 | 47 | Scripts: 48 | 49 | . `bb.edn` - tasks entry point 50 | . `script/publish.clj` - client side work 51 | . `script/ci_publish.clj` - ci side work 52 | 53 | CI - We use GitHub Actions for this project 54 | 55 | . `.github/workflows/tests.yml` 56 | . `.github/workflows/publish.yml` 57 | 58 | == CI Config 59 | 60 | Clojars secrets are protected under the `publish` environment which is only referenced by `publish.yml`. 61 | 62 | == Expected Oddities 63 | 64 | When publishing, you will see both the `tests` workflow triggered and the `publish` workflow triggered (which also invokes the `tests` workflow). 65 | 66 | This extra running of the `tests` workflow is GitHub Actions responding to changes committed as part of the publishing work. 67 | A bit annoying, but harmless. 68 | -------------------------------------------------------------------------------- /doc/cljdoc.edn: -------------------------------------------------------------------------------- 1 | {:cljdoc.doc/tree 2 | [["Readme" {:file "README.adoc"}] 3 | ["Changelog" {:file "CHANGELOG.adoc"}] 4 | ["User Guide" {:file "doc/01-user-guide.adoc"}] 5 | ["Developer Guide" {:file "doc/02-developer-guide.adoc"}] 6 | ["Maintainer Guide" {:file "doc/03-maintainer-guide.adoc"}]]} 7 | -------------------------------------------------------------------------------- /pom.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4.0.0 4 | clj-commons/clj-http-lite 5 | A lite version of clj-http that uses the jre's HttpURLConnection 6 | https://github.com/clj-commons/clj-http-lite 7 | 8 | 9 | MIT 10 | http://www.opensource.org/licenses/mit-license.php 11 | 12 | 13 | 14 | https://github.com/clj-commons/clj-http-lite 15 | scm:git:git://github.com/clj-commons/clj-http-lite.git 16 | scm:git:ssh://git@github.com/clj-commons/clj-http-lite.git 17 | 18 | 19 | UTF-8 20 | 21 | 22 | 23 | clojars 24 | https://repo.clojars.org/ 25 | 26 | 27 | 28 | 29 | clojars 30 | Clojars repository 31 | https://clojars.org/repo 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /script/ci_publish.clj: -------------------------------------------------------------------------------- 1 | (ns ci-publish 2 | "Publish work we invoke from GitHub Actions. 3 | Separated out here: 4 | - to make it clear what is happening on ci 5 | - rate of change here should be less/different than in publish namespace" 6 | (:require [babashka.tasks :as t] 7 | [lread.status-line :as status] 8 | [build-shared])) 9 | 10 | (def changelog-url "https://github.com/clj-commons/clj-http-lite/blob/master/CHANGELOG.adoc") 11 | 12 | (defn- assert-on-ci [] 13 | (when (not (System/getenv "CI")) 14 | (status/die 1 "to be run from continuous integration server only"))) 15 | 16 | (defn- ci-tag [] 17 | (when (= "tag" (System/getenv "GITHUB_REF_TYPE")) 18 | (System/getenv "GITHUB_REF_NAME"))) 19 | 20 | (defn- analyze-ci-tag [] 21 | (let [tag (ci-tag)] 22 | (if (not tag) 23 | (status/die 1 "CI tag not found") 24 | (let [version-from-tag (build-shared/tag->version tag) 25 | lib-version (build-shared/lib-version)] 26 | (cond 27 | (not version-from-tag) 28 | (status/die 1 "Not recognized as version tag: %s" tag) 29 | 30 | (not= version-from-tag lib-version) 31 | (status/die 1 "Lib version %s does not match version from tag %s" 32 | lib-version version-from-tag) 33 | :else 34 | {:tag tag 35 | :version lib-version}))))) 36 | 37 | ;; 38 | ;; Task entry points 39 | ;; 40 | 41 | (defn clojars-deploy [] 42 | (assert-on-ci) 43 | (analyze-ci-tag) ;; fail on unexpected version tag 44 | (t/clojure "-T:build deploy")) 45 | 46 | (defn github-create-release [] 47 | (assert-on-ci) 48 | (let [{:keys [tag]} (analyze-ci-tag)] 49 | (t/shell "gh release create" 50 | tag 51 | "--title" tag 52 | "--notes" (format "[Changelog](%s#%s)" changelog-url tag)))) 53 | 54 | (defn cljdoc-request-build [] 55 | (assert-on-ci) 56 | (let [{:keys [version]} (analyze-ci-tag) 57 | lib (build-shared/lib-artifact-name)] 58 | (status/line :head "Informing cljdoc of %s version %s" lib version) 59 | (assert-on-ci) 60 | (let [exit-code (-> (t/shell {:continue true} 61 | "curl" "-X" "POST" 62 | "-d" (str "project=" lib) 63 | "-d" (str "version=" version) 64 | "https://cljdoc.org/api/request-build2") 65 | :exit)] 66 | (when (not (zero? exit-code)) 67 | (status/line :warn (str "Informing cljdoc did not seem to work, exited with " exit-code)))))) 68 | -------------------------------------------------------------------------------- /script/download_deps.clj: -------------------------------------------------------------------------------- 1 | (ns download-deps 2 | (:require [babashka.tasks :as t] 3 | [clojure.edn :as edn] 4 | [lread.status-line :as status])) 5 | 6 | ;; clojure has a -P command, but to bring down all deps we need to specify all aliases 7 | ;; bb deps will be brought down just from running bb (which assumedly is how this code is run) 8 | 9 | (defn -main [& _args] 10 | (let [aliases (->> "deps.edn" 11 | slurp 12 | edn/read-string 13 | :aliases 14 | keys)] 15 | ;; one at a time because aliases with :replace-deps will... well... you know. 16 | (status/line :detail "Bring down default deps") 17 | (t/clojure "-P") 18 | (doseq [a aliases] 19 | (status/line :detail "Bring down deps for alias: %s" a) 20 | (t/clojure "-P" (str "-M" a))))) 21 | 22 | (when (= *file* (System/getProperty "babashka.file")) 23 | (apply -main *command-line-args*)) 24 | -------------------------------------------------------------------------------- /script/lint.clj: -------------------------------------------------------------------------------- 1 | (ns lint 2 | (:require [babashka.classpath :as bbcp] 3 | [babashka.cli :as cli] 4 | [babashka.fs :as fs] 5 | [babashka.tasks :as t] 6 | [clojure.string :as string] 7 | [lread.status-line :as status])) 8 | 9 | (def clj-kondo-cache ".clj-kondo/.cache") 10 | 11 | (defn- cache-exists? [] 12 | (fs/exists? clj-kondo-cache)) 13 | 14 | (defn- delete-cache [] 15 | (when (cache-exists?) 16 | (fs/delete-tree clj-kondo-cache))) 17 | 18 | (defn- build-cache [] 19 | (when (cache-exists?) 20 | (delete-cache)) 21 | (let [clj-cp (-> (t/clojure {:out :string} 22 | "-Spath -M:test") 23 | with-out-str 24 | string/trim) 25 | bb-cp (bbcp/get-classpath)] 26 | (status/line :detail "- copying lib configs and creating cache") 27 | (t/clojure "-M:clj-kondo --skip-lint --copy-configs --dependencies --lint" clj-cp bb-cp))) 28 | 29 | (defn- check-cache [{:keys [rebuild]}] 30 | (status/line :head "clj-kondo: cache check") 31 | (if-let [rebuild-reason (cond 32 | rebuild 33 | "Rebuild requested" 34 | 35 | (not (cache-exists?)) 36 | "Cache not found" 37 | 38 | :else 39 | (let [updated-dep-files (fs/modified-since clj-kondo-cache ["deps.edn" "bb.edn"])] 40 | (when (seq updated-dep-files) 41 | (format "Found deps files newer than lint cache: %s" (mapv str updated-dep-files)))))] 42 | (do (status/line :detail rebuild-reason) 43 | (build-cache)) 44 | (status/line :detail "Using existing cache"))) 45 | 46 | (defn- lint [opts] 47 | (check-cache opts) 48 | (status/line :head "clj-kondo: linting") 49 | (let [{:keys [exit]} 50 | (t/clojure {:continue true} 51 | "-M:clj-kondo --parallel --lint src test build script deps.edn bb.edn")] 52 | (cond 53 | (= 2 exit) (status/die exit "clj-kondo found one or more lint errors") 54 | (= 3 exit) (status/die exit "clj-kondo found one or more lint warnings") 55 | (> exit 0) (status/die exit "clj-kondo returned unexpected exit code")))) 56 | 57 | (defn -main [& args] 58 | (when-let [opts (cli/parse-opts args)] 59 | (lint opts))) 60 | 61 | (when (= *file* (System/getProperty "babashka.file")) 62 | (apply -main *command-line-args*)) 63 | -------------------------------------------------------------------------------- /script/publish.clj: -------------------------------------------------------------------------------- 1 | (ns publish 2 | "Publish work that happens locally on a maintainer's work" 3 | (:require [babashka.tasks :as t] 4 | [build-shared] 5 | [clojure.string :as string] 6 | [lread.status-line :as status] 7 | [version-clj.core :as v])) 8 | 9 | ;; Note to lurkers: doc updates are geared to AsciiDoc files. 10 | 11 | (def github-coords "clj-commons/clj-http-lite") 12 | (def changelog-fname "CHANGELOG.adoc") 13 | (def user-guide-fname "doc/01-user-guide.adoc") 14 | ;; this project started with "Release-" but we prefer "v" as a version tag prefix 15 | (def legacy-version-tag-prefix "Release-") 16 | 17 | (defn- raw-tags[] 18 | (->> (t/shell {:out :string} 19 | "git ls-remote --tags --refs") 20 | :out 21 | string/split-lines)) 22 | 23 | (defn- parse-raw-tag [raw-tag-line] 24 | (let [pattern (re-pattern (str "refs/tags/((?:" 25 | legacy-version-tag-prefix "|" 26 | build-shared/version-tag-prefix ")(\\d+\\..*))"))] 27 | (some->> (re-find pattern raw-tag-line) 28 | rest 29 | (zipmap [:tag :version])))) 30 | 31 | (defn- most-recent-tag [parsed-tags] 32 | (->> parsed-tags 33 | (sort-by :version v/version-compare) 34 | reverse 35 | first 36 | :tag)) 37 | 38 | (defn last-release-tag [] 39 | (->> (raw-tags) 40 | (keep parse-raw-tag) 41 | (most-recent-tag))) 42 | 43 | (defn- master-branch? [] 44 | (let [current-branch (->> (t/shell {:out :string} "git rev-parse --abbrev-ref HEAD") 45 | :out 46 | string/trim)] 47 | (= "master" current-branch))) 48 | 49 | (defn- uncommitted-code? [] 50 | (-> (t/shell {:out :string} 51 | "git status --porcelain") 52 | :out 53 | string/trim 54 | seq)) 55 | 56 | (defn- local-branch? [] 57 | (let [{:keys [exit]} (t/shell {:continue true :out :string :err :out} 58 | "git rev-parse --symbolic-full-name @{u}")] 59 | (not (zero? exit)))) 60 | 61 | (defn- unpushed-commits? [] 62 | (let [{:keys [exit :out]} (t/shell {:continue true :out :string} 63 | "git cherry -v")] 64 | (and (zero? exit) (-> out string/trim seq)))) 65 | 66 | (defn- analyze-changelog 67 | "Certainly not fool proof, but should help for common mistakes" 68 | [] 69 | (let [content (slurp changelog-fname) 70 | valid-attrs ["[minor breaking]" "[breaking]"] 71 | [_ attr content :as match] (re-find #"(?ims)^== Unreleased ?(.*?)$(.*?)(== v\d|\z)" content)] 72 | (if (not match) 73 | [{:error :section-missing}] 74 | (cond-> [] 75 | (and attr 76 | (not (string/blank? attr)) 77 | (not (contains? (set valid-attrs) attr))) 78 | (conj {:error :suffix-invalid :valid-attrs valid-attrs :found attr}) 79 | 80 | ;; without any words of a reasonable min length, we consider section blank 81 | (not (re-find #"(?m)[\p{L}]{3,}" content)) 82 | (conj {:error :content-missing}))))) 83 | 84 | (defn- release-checks [] 85 | (let [changelog-findings (reduce (fn [acc n] (assoc acc (:error n) n)) 86 | {} 87 | (analyze-changelog))] 88 | [{:check "on master branch" 89 | :result (if (master-branch?) :pass :fail)} 90 | {:check "no uncommitted code" 91 | :result (if (uncommitted-code?) :fail :pass)} 92 | {:check "no unpushed commits" 93 | :result (if (or (local-branch?) (unpushed-commits?)) :fail :pass)} 94 | {:check "changelog has unreleased section" 95 | :result (if (:section-missing changelog-findings) :fail :pass)} 96 | {:check "changelog unreleased section attributes valid" 97 | :result (cond 98 | (:section-missing changelog-findings) :skip 99 | (:suffix-invalid changelog-findings) :fail 100 | :else :pass) 101 | :msg (when-let [{:keys [valid-attrs found]} (:suffix-invalid changelog-findings)] 102 | (format "expected attributes to absent or one of %s, but found: %s" (string/join ", " valid-attrs) found))} 103 | {:check "changelog unreleased section has content" 104 | :result (cond 105 | (:section-missing changelog-findings) :skip 106 | (:content-missing changelog-findings) :fail 107 | :else :pass)}])) 108 | 109 | (defn- bump-version! 110 | "bump version stored in deps.edn" 111 | [] 112 | (t/shell "bb neil version patch --no-tag")) 113 | 114 | (defn- update-file! [fname desc match replacement] 115 | (let [old-content (slurp fname) 116 | new-content (string/replace-first old-content match replacement)] 117 | (if (= old-content new-content) 118 | (status/die 1 "Expected to %s in %s" desc fname) 119 | (spit fname new-content)))) 120 | 121 | (defn- update-user-guide! [version] 122 | (status/line :detail "Applying version %s to user guide" version) 123 | (update-file! user-guide-fname 124 | "update :lib-version: adoc attribute" 125 | #"(?m)^(:lib-version: )(.*)$" 126 | (str "$1" version))) 127 | 128 | (defn- yyyy-mm-dd-now-utc [] 129 | (-> (java.time.Instant/now) str (subs 0 10))) 130 | 131 | (defn- update-changelog! [version release-tag last-release-tag] 132 | (status/line :detail "Applying version %s to changelog" version) 133 | (update-file! changelog-fname 134 | "update unreleased header" 135 | #"(?ims)^== Unreleased(.*?)($.*?)(== v\d|\z)" 136 | (str 137 | ;; add Unreleased section for next released 138 | "== Unreleased\n\n" 139 | ;; replace "Unreleased" with actual version 140 | "== v" version 141 | ;; followed by any attributes 142 | "$1" 143 | ;; followed by datestamp (local time is fine) 144 | " - " (yyyy-mm-dd-now-utc) 145 | ;; followed by an AsciiDoc anchor for easy referencing 146 | " [[v" version "]]" 147 | ;; followed by section content 148 | "$2" 149 | ;; followed by link to commit log 150 | (when last-release-tag 151 | (str 152 | "https://github.com/" github-coords "/compare/" 153 | last-release-tag 154 | "\\\\..." ;; single backslash is escape for AsciiDoc 155 | release-tag 156 | "[commit log]\n\n")) 157 | ;; followed by next section indicator 158 | "$3"))) 159 | 160 | (defn- commit-changes! [version] 161 | (t/shell "git add deps.edn" changelog-fname user-guide-fname) 162 | (t/shell "git commit -m" (str "publish: apply version " version))) 163 | 164 | (defn- tag! [tag version] 165 | (t/shell "git tag" tag "-m" (str "For release: " version))) 166 | 167 | (defn- push! [] 168 | (t/shell "git push")) 169 | 170 | (defn- push-tag! [tag] 171 | (t/shell "git push origin" tag)) 172 | 173 | ;; task entry points 174 | 175 | (defn pubcheck [] 176 | (status/line :head "Performing publish checks") 177 | (let [check-results (release-checks) 178 | passed? (every? #(= :pass (:result %)) check-results)] 179 | (doseq [{:keys [check result msg]} check-results] 180 | (status/line :detail "%s %s" 181 | (case result 182 | :pass "✓" 183 | :fail "x" 184 | :skip "~") 185 | check) 186 | (when msg 187 | (status/line :detail " > %s" msg))) 188 | (when (not passed?) 189 | (status/die 1 "Release checks failed")))) 190 | 191 | (defn -main [& _args] 192 | (pubcheck) 193 | (status/line :head "Calculating versions") 194 | (bump-version!) 195 | (let [last-release-tag (last-release-tag) 196 | version (build-shared/lib-version) 197 | release-tag (build-shared/version->tag version)] 198 | (status/line :detail "Release version: %s" version) 199 | (status/line :detail "Release tag: %s" release-tag) 200 | (status/line :detail "Last release tag: %s" last-release-tag) 201 | (status/line :head "Updating docs") 202 | (update-user-guide! version) 203 | (update-changelog! version release-tag last-release-tag) 204 | (status/line :head "Committing changes") 205 | (commit-changes! version) 206 | (status/line :head "Tagging & pushing") 207 | (tag! release-tag version) 208 | (push!) 209 | (push-tag! release-tag) 210 | (status/line :detail "\nLocal work done.") 211 | (status/line :head "Remote work") 212 | (status/line :detail "The remainging work will be triggered by the release tag on CI:") 213 | (status/line :detail "- Publish a release jar to clojars") 214 | (status/line :detail "- Create a GitHub release") 215 | (status/line :detail "- Inform cljdoc of release"))) 216 | 217 | ;; default action when executing file directly 218 | (when (= *file* (System/getProperty "babashka.file")) 219 | (apply -main *command-line-args*)) 220 | -------------------------------------------------------------------------------- /script/test_jvm.clj: -------------------------------------------------------------------------------- 1 | (ns test-jvm 2 | (:require [babashka.cli :as cli] 3 | [babashka.tasks :as t] 4 | [lread.status-line :as status])) 5 | 6 | (defn -main [& args] 7 | (let [valid-clojure-versions ["1.8" "1.9" "1.10" "1.11" "1.12"] 8 | spec {:clj-version 9 | {:ref "" 10 | :desc "The Clojure version to test against." 11 | :coerce :string 12 | :default-desc "1.8" 13 | ;; don't specify :default, we want to know if the user passed this option in 14 | :validate 15 | {:pred (set valid-clojure-versions) 16 | :ex-msg (fn [_m] 17 | (str "--clj-version must be one of: " valid-clojure-versions))}}} 18 | opts (cli/parse-opts args {:spec spec}) 19 | clj-version (:clj-version opts) 20 | runner-args (if-not clj-version 21 | args 22 | (loop [args args 23 | out-args []] 24 | (if-let [a (first args)] 25 | (if (re-matches #"(--|:)clj-version" a) 26 | (recur (drop 2 args) out-args) 27 | (recur (rest args) (conj out-args a))) 28 | out-args))) 29 | clj-version (or clj-version "1.8")] 30 | 31 | (if (:help opts) 32 | (do 33 | (status/line :head "bb task option help") 34 | (println (cli/format-opts {:spec spec})) 35 | (status/line :head "test-runner option help") 36 | (t/clojure "-M:test --test-help")) 37 | (do 38 | (println "Testing against Clojure" clj-version) 39 | (apply t/clojure (format "-M:%s:test" clj-version) runner-args))))) 40 | 41 | (when (= *file* (System/getProperty "babashka.file")) 42 | (apply -main *command-line-args*)) 43 | -------------------------------------------------------------------------------- /src/clj_http/lite/client.clj: -------------------------------------------------------------------------------- 1 | (ns clj-http.lite.client 2 | "Batteries-included HTTP client. 3 | 4 | Among the many functions here you'll likely be most interested in 5 | [[get]] [[head]] [[put]] [[post]] [[delete]] or the slightly lower level [[request]]." 6 | (:require [clj-http.lite.core :as core] 7 | [clj-http.lite.links :refer [wrap-links]] 8 | [clj-http.lite.util :as util] 9 | [clojure.java.io :as io] 10 | [clojure.string :as str] 11 | [clojure.walk :as walk]) 12 | (:import (java.net UnknownHostException) 13 | (java.nio.charset Charset)) 14 | (:refer-clojure :exclude (get update))) 15 | 16 | (set! *warn-on-reflection* true) 17 | 18 | (defn update [m k f & args] 19 | (assoc m k (apply f (m k) args))) 20 | 21 | (defn when-pos [v] 22 | (when (and v (pos? v)) v)) 23 | 24 | (defn parse-url [url] 25 | (let [url-parsed (io/as-url url)] 26 | {:scheme (keyword (.getProtocol url-parsed)) 27 | :server-name (.getHost url-parsed) 28 | :server-port (when-pos (.getPort url-parsed)) 29 | :uri (.getPath url-parsed) 30 | :user-info (.getUserInfo url-parsed) 31 | :query-string (.getQuery url-parsed)})) 32 | 33 | (def unexceptional-status? 34 | #{200 201 202 203 204 205 206 207 300 301 302 303 307}) 35 | 36 | (defn wrap-exceptions [client] 37 | (fn [req] 38 | (let [{:keys [status] :as resp} (client req)] 39 | (if (or (not (clojure.core/get req :throw-exceptions true)) 40 | (unexceptional-status? status)) 41 | resp 42 | (throw (ex-info (str "clj-http: status " (:status resp)) resp)))))) 43 | 44 | (declare wrap-redirects) 45 | 46 | (defn follow-redirect [client req resp] 47 | (let [url (get-in resp [:headers "location"])] 48 | ((wrap-redirects client) (assoc req :url url)))) 49 | 50 | (defn wrap-redirects [client] 51 | (fn [{:keys [request-method follow-redirects] :as req}] 52 | (let [{:keys [status] :as resp} (client req)] 53 | (cond 54 | (= false follow-redirects) 55 | resp 56 | (and (#{301 302 307} status) (#{:get :head} request-method)) 57 | (follow-redirect client req resp) 58 | (and (= 303 status) (= :head request-method)) 59 | (follow-redirect client (assoc req :request-method :get) resp) 60 | :else 61 | resp)))) 62 | 63 | (defn wrap-decompression [client] 64 | (fn [req] 65 | (if (get-in req [:headers "Accept-Encoding"]) 66 | (client req) 67 | (let [req-c (update req :headers assoc "Accept-Encoding" "gzip, deflate") 68 | resp-c (client req-c)] 69 | (case (or (get-in resp-c [:headers "Content-Encoding"]) 70 | (get-in resp-c [:headers "content-encoding"])) 71 | "gzip" (update resp-c :body util/gunzip) 72 | "deflate" (update resp-c :body util/inflate) 73 | resp-c))))) 74 | 75 | (defn wrap-output-coercion [client] 76 | (fn [{:keys [as] :as req}] 77 | (let [{:keys [body] :as resp} (client req)] 78 | (if body 79 | (cond 80 | (keyword? as) 81 | (condp = as 82 | ;; Don't do anything for streams 83 | :stream resp 84 | ;; Don't do anything when it's a byte-array 85 | :byte-array resp 86 | ;; Automatically determine response type 87 | :auto 88 | (assoc resp 89 | :body 90 | (let [typestring (get-in resp [:headers "content-type"])] 91 | (cond 92 | (.startsWith (str typestring) "text/") 93 | (if-let [charset (second (re-find #"charset=(.*)" 94 | (str typestring)))] 95 | (String. #^"[B" body ^String charset) 96 | (String. #^"[B" body "UTF-8")) 97 | 98 | :else 99 | (String. #^"[B" body "UTF-8")))) 100 | ;; No :as matches found 101 | (assoc resp :body (String. #^"[B" body "UTF-8"))) 102 | ;; Try the charset given if a string is specified 103 | (string? as) 104 | (assoc resp :body (String. #^"[B" body ^String as)) 105 | ;; Return a regular UTF-8 string body 106 | :else 107 | (assoc resp :body (String. #^"[B" body "UTF-8"))) 108 | resp)))) 109 | 110 | (defn wrap-input-coercion [client] 111 | (fn [{:keys [body body-encoding _length] :as req}] 112 | (if body 113 | (cond 114 | (string? body) 115 | (let [encoding-name (or body-encoding "UTF-8") 116 | charset (Charset/forName encoding-name)] 117 | (client (-> req (assoc :body (.getBytes ^String body charset) 118 | :character-encoding encoding-name)))) 119 | :else 120 | (client req)) 121 | (client req)))) 122 | 123 | (defn content-type-value [type] 124 | (if (keyword? type) 125 | (str "application/" (name type)) 126 | type)) 127 | 128 | (defn wrap-content-type [client] 129 | (fn [{:keys [content-type] :as req}] 130 | (if content-type 131 | (client (-> req (assoc :content-type 132 | (content-type-value content-type)))) 133 | (client req)))) 134 | 135 | (defn wrap-accept [client] 136 | (fn [{:keys [accept] :as req}] 137 | (if accept 138 | (client (-> req (dissoc :accept) 139 | (assoc-in [:headers "Accept"] 140 | (content-type-value accept)))) 141 | (client req)))) 142 | 143 | (defn accept-encoding-value [accept-encoding] 144 | (str/join ", " (map name accept-encoding))) 145 | 146 | (defn wrap-accept-encoding [client] 147 | (fn [{:keys [accept-encoding] :as req}] 148 | (if accept-encoding 149 | (client (-> req (dissoc :accept-encoding) 150 | (assoc-in [:headers "Accept-Encoding"] 151 | (accept-encoding-value accept-encoding)))) 152 | (client req)))) 153 | 154 | (defn generate-query-string [params] 155 | (str/join "&" 156 | (mapcat (fn [[k v]] 157 | (if (sequential? v) 158 | (map #(str (util/url-encode (name %1)) 159 | "=" 160 | (util/url-encode (str %2))) 161 | (repeat k) v) 162 | [(str (util/url-encode (name k)) 163 | "=" 164 | (util/url-encode (str v)))])) 165 | params))) 166 | 167 | (defn wrap-query-params [client] 168 | (fn [{:keys [query-params] :as req}] 169 | (if query-params 170 | (client (-> req (dissoc :query-params) 171 | (assoc :query-string 172 | (generate-query-string query-params)))) 173 | (client req)))) 174 | 175 | (defn basic-auth-value [basic-auth] 176 | (let [basic-auth (if (string? basic-auth) 177 | basic-auth 178 | (str (first basic-auth) ":" (second basic-auth)))] 179 | (str "Basic " (util/base64-encode (util/utf8-bytes basic-auth))))) 180 | 181 | (defn wrap-basic-auth [client] 182 | (fn [req] 183 | (if-let [basic-auth (:basic-auth req)] 184 | (client (-> req (dissoc :basic-auth) 185 | (assoc-in [:headers "Authorization"] 186 | (basic-auth-value basic-auth)))) 187 | (client req)))) 188 | 189 | (defn parse-user-info [user-info] 190 | (when user-info 191 | (str/split user-info #":"))) 192 | 193 | (defn wrap-user-info [client] 194 | (fn [req] 195 | (if-let [[user password] (parse-user-info (:user-info req))] 196 | (client (assoc req :basic-auth [user password])) 197 | (client req)))) 198 | 199 | (defn wrap-method [client] 200 | (fn [req] 201 | (if-let [m (:method req)] 202 | (client (-> req (dissoc :method) 203 | (assoc :request-method m))) 204 | (client req)))) 205 | 206 | (defn wrap-form-params [client] 207 | (fn [{:keys [form-params request-method] :as req}] 208 | (if (and form-params (= :post request-method)) 209 | (client (-> req 210 | (dissoc :form-params) 211 | (assoc :content-type (content-type-value 212 | :x-www-form-urlencoded) 213 | :body (generate-query-string form-params)))) 214 | (client req)))) 215 | 216 | (defn- nest-params 217 | [req param-key] 218 | (if-let [params (req param-key)] 219 | (let [nested (walk/prewalk 220 | #(if (and (vector? %) (map? (second %))) 221 | (let [[fk m] %] 222 | (reduce 223 | (fn [m [sk v]] 224 | (assoc m (str (name fk) 225 | \[ (name sk) \]) v)) 226 | {} 227 | m)) 228 | %) 229 | params)] 230 | (assoc req param-key nested)) 231 | req)) 232 | 233 | (defn wrap-nested-params [client] 234 | (fn [req] 235 | (client (-> req (nest-params :form-params) (nest-params :query-params))))) 236 | 237 | (defn wrap-url [client] 238 | (fn [req] 239 | (if-let [url (:url req)] 240 | (client (-> req (dissoc :url) (merge (parse-url url)))) 241 | (client req)))) 242 | 243 | (defn wrap-unknown-host [client] 244 | (fn [{:keys [ignore-unknown-host?] :as req}] 245 | (try 246 | (client req) 247 | (catch UnknownHostException e 248 | (if ignore-unknown-host? 249 | nil 250 | (throw e)))))) 251 | 252 | (defn wrap-oauth [client] 253 | (fn [{:keys [oauth-token] :as req}] 254 | (if oauth-token 255 | (client (-> req (dissoc :oauth-token) 256 | (assoc-in [:headers "Authorization"] 257 | (str "Bearer " oauth-token)))) 258 | (client req)))) 259 | 260 | (defn wrap-request 261 | "Returns a batteries-included HTTP request function." 262 | [request] 263 | ;; note to the uninitiated: wrapper behaviour is applied to requests in order listed here but 264 | ;; from last to first 265 | (-> request 266 | wrap-query-params 267 | wrap-basic-auth 268 | wrap-oauth 269 | wrap-user-info 270 | wrap-url 271 | wrap-redirects 272 | wrap-decompression 273 | wrap-input-coercion 274 | wrap-output-coercion 275 | wrap-exceptions 276 | wrap-accept 277 | wrap-accept-encoding 278 | wrap-content-type 279 | wrap-form-params 280 | wrap-nested-params 281 | wrap-method 282 | wrap-links 283 | wrap-unknown-host)) 284 | 285 | (def ^{:arglists '([req])} 286 | request 287 | "Returns response map for executed HTTP `req` map. 288 | 289 | Notice that some `req` key entries will be overwritten by automatic conversion to other key entries: 290 | 291 | Request method 292 | * `:method` - ex. `:get`,`:head`,`:post`,`:put`,`:delete`, converts to `:request-method` with same value 293 | 294 | Request URL 295 | * `:url` - ex. `\"https://joe:blow@example.com:443/some/path?q=clojure\"`, converts to: 296 | * `:scheme` - protocol `:https` 297 | * `:server-name` - host `\"example.com\"` 298 | * `:server-port` - `443` (if not specified, will be inferred from `:scheme`) 299 | * `:uri` - path `\"/some/path\"` 300 | * `:user-info` - `\"joe:blow\"`, converts to: 301 | * `:basic-auth` - which automatically converts to appropriate `:headers` 302 | * `:query-string` - `\"q=clojure\"` 303 | * `:query-params` - ex. `{\"q\" \"clojure\"}` or `{:q \"clojure\"}` converts to `:query-string` (see above) 304 | 305 | Request body & headers 306 | * `:body` - can be a string, byte array, File or input stream 307 | * `:body-encoding` - charset ex. `\"UTF-16\"`, defaults to `\"UTF-8\"`, iff `:body` is string converts to: 308 | * `:body` encoded in charset 309 | * `:character-encoding` set to charset which converts to appropriate `:headers` iff `:content-type` also set 310 | * `:content-type` - media type of request body, converts to appropriate `:headers` entry, specify: 311 | * keyword as shorthand, ex. `:json` for `\"application/json\"` 312 | * string for verboten, ex. `\"text/html\"` 313 | * `:form-params` - ex. `{\"q\" \"clojure\"}` or `{:q \"clojure\"}`, iff `:method` is `:post`: converts to: 314 | * urlencoded `:body` 315 | * appropriate `:headers` entry 316 | * `:oauth-token` - bearer authorization token, ex. `\"my70k3nh3r3\"`, converts to appropriate `:headers` entry 317 | * `:basic-auth` - basic authentication, converts to appropriate `:headers` entry, (see also `:url` and `:user-info`), specify: 318 | * vector `[\"uname\" \"pass\"]` becomes `\"uname:pass\"` 319 | * use string for verboten 320 | * `:accept-encoding` - vector of accepted response encodings, ex. `[:gzip :deflate :identity]`, converts to appropriate `:headers` entry 321 | * `:accept` - accept response of media type, converts to appropriate `:headers` entry, specify 322 | * keyword as shorthand, ex. `:json` for `\"application/json\"` 323 | * string for verboten, ex. `\"text/html\"` 324 | * `:headers` - explicitly set request headers, ex. `{\"Cache-Control\" \"no-cache\"}` 325 | 326 | Request behaviour 327 | * `:as` - specifies how response body should be coerced: 328 | * `:stream` 329 | * `:byte-array` 330 | * `:auto` - to string decoded with `charset` in response `:headers` `content-type` `charset` else UTF-8 331 | * `\"charset\"` - to string decoded with `charset` ex. `\"utf-16\"` 332 | * else - to string decoded with UTF-8 333 | * `:follow-redirects` - specify `false` to not follow response redirects 334 | * `:throw-exceptions` - specify `false` to not throw on https status error codes 335 | * `:ignore-unknown-host?` - specify `true` to not throw on unknown host 336 | * `:insecure?` - allow connection with an invalid SSL certificate 337 | * `:conn-timeout` - number of milliseconds to wait to establish a connection 338 | * `:socket-timeout` - number of milliseconds to wait for data to be available to read 339 | * `:save-request?` - specify `true` to include ultimate converted `:request` used in response map 340 | * `:chunk-size` - in bytes, enables streaming of HTTP request body with chunk-size bytes, 341 | see [JDK docs](https://docs.oracle.com/javase/8/docs/api/java/net/HttpURLConnection.html#setChunkedStreamingMode-int-) 342 | for details 343 | 344 | Response map keys: 345 | * `:status` - http status code, see `:throw-exceptions` above 346 | * `:headers` - response headers 347 | * `:body` - response body, gzip and deflate responses are accepted and decompressed. See `:as` above. 348 | * `:request` - see `:save-request?` above 349 | 350 | See [README](/README.md#usage) for example usages." 351 | (wrap-request #'core/request)) 352 | 353 | (defn get 354 | "Executes HTTP GET request for `url` and, optionally, more `req` attributes. 355 | See [[request]]." 356 | [url & [req]] 357 | (request (merge req {:method :get :url url}))) 358 | 359 | (defn head 360 | "Executes HTTP HEAD request for `url` and, optionally, more `req` attributes. 361 | See [[request]]." 362 | [url & [req]] 363 | (request (merge req {:method :head :url url}))) 364 | 365 | (defn post 366 | "Executes HTTP POST request for `url` and, optionally, more `req` attributes. 367 | See [[request]]." 368 | [url & [req]] 369 | (request (merge req {:method :post :url url}))) 370 | 371 | (defn put 372 | "Executes HTTP PUT request for `url` and, optionally, more `req` attributes. 373 | See [[request]]." 374 | [url & [req]] 375 | (request (merge req {:method :put :url url}))) 376 | 377 | (defn delete 378 | "Executes HTTP DELETE request for `url` and, optionally, more `req` attributes. 379 | See [[request]]." 380 | [url & [req]] 381 | (request (merge req {:method :delete :url url}))) 382 | 383 | (defmacro with-connection-pool 384 | "This macro is a no-op, but left in to support backward-compatibility 385 | with clj-http." 386 | [_opts & body] 387 | `(do 388 | ~@body)) 389 | -------------------------------------------------------------------------------- /src/clj_http/lite/core.clj: -------------------------------------------------------------------------------- 1 | (ns clj-http.lite.core 2 | "Core HTTP request/response implementation." 3 | (:require [clojure.java.io :as io]) 4 | (:import (java.io ByteArrayOutputStream InputStream) 5 | (java.net HttpURLConnection URL) 6 | (javax.net.ssl HostnameVerifier HttpsURLConnection SSLContext SSLSession TrustManager X509TrustManager))) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | (defn parse-headers 11 | "Returns a map of names to values for URLConnection `conn`. 12 | 13 | If a header name appears more than once (like `set-cookie`) then the value 14 | will be a vector containing the values in the order they appeared 15 | in the headers." 16 | [conn] 17 | (loop [i 1 headers {}] 18 | (let [k (.getHeaderFieldKey ^HttpURLConnection conn i) 19 | v (.getHeaderField ^HttpURLConnection conn i)] 20 | (if k 21 | (recur (inc i) (update-in headers [k] conj v)) 22 | (zipmap (for [k (keys headers)] 23 | (.toLowerCase ^String k)) 24 | (for [v (vals headers)] 25 | (if (= 1 (count v)) 26 | (first v) 27 | (vec v)))))))) 28 | 29 | (defn- coerce-body-entity 30 | "Return body response from HttpURLConnection `conn` coerced to either a byte-array, 31 | or a stream." 32 | [{:keys [as]} conn] 33 | (let [ins (try 34 | (.getInputStream ^HttpURLConnection conn) 35 | (catch Exception _e 36 | (.getErrorStream ^HttpURLConnection conn)))] 37 | (if (or (= :stream as) (nil? ins)) 38 | ins 39 | (with-open [ins ^InputStream ins 40 | baos (ByteArrayOutputStream.)] 41 | (io/copy ins baos) 42 | (.flush baos) 43 | (.toByteArray baos))))) 44 | 45 | (def ^:private trust-all-hostname-verifier 46 | (delay 47 | (proxy [HostnameVerifier] [] 48 | (verify [^String hostname ^SSLSession session] true)))) 49 | 50 | (def ^:private trust-all-ssl-socket-factory 51 | (delay 52 | (.getSocketFactory 53 | (doto (SSLContext/getInstance "SSL") 54 | (.init nil (into-array TrustManager [(reify X509TrustManager 55 | (getAcceptedIssuers [_this] nil) 56 | (checkClientTrusted [_this _certs _authType]) 57 | (checkServerTrusted [_this _certs _authType]))]) 58 | (new java.security.SecureRandom)))))) 59 | 60 | (defn- trust-all-ssl! 61 | [conn] 62 | (when (instance? HttpsURLConnection conn) 63 | (let [^HttpsURLConnection ssl-conn conn] 64 | (.setHostnameVerifier ssl-conn @trust-all-hostname-verifier) 65 | (.setSSLSocketFactory ssl-conn @trust-all-ssl-socket-factory)))) 66 | 67 | (defn request 68 | "Executes the HTTP request corresponding to the given Ring `req` map and 69 | returns the Ring response map corresponding to the resulting HTTP response." 70 | [{:keys [request-method scheme server-name server-port uri query-string 71 | headers content-type character-encoding body socket-timeout 72 | conn-timeout insecure? save-request? follow-redirects 73 | chunk-size] :as req}] 74 | (let [http-url (str (name scheme) "://" server-name 75 | (when server-port (str ":" server-port)) 76 | uri 77 | (when query-string (str "?" query-string))) 78 | ^HttpURLConnection conn (.openConnection (URL. http-url))] 79 | (when insecure? 80 | (trust-all-ssl! conn)) 81 | (when (and content-type character-encoding) 82 | (.setRequestProperty conn "Content-Type" (str content-type 83 | "; charset=" 84 | character-encoding))) 85 | (when (and content-type (not character-encoding)) 86 | (.setRequestProperty conn "Content-Type" content-type)) 87 | (doseq [[h v] headers] 88 | (.setRequestProperty conn h v)) 89 | (when (false? follow-redirects) 90 | (.setInstanceFollowRedirects conn false)) 91 | (.setRequestMethod conn (.toUpperCase (name request-method))) 92 | (when body 93 | (.setDoOutput conn true)) 94 | (when socket-timeout 95 | (.setReadTimeout conn socket-timeout)) 96 | (when conn-timeout 97 | (.setConnectTimeout conn conn-timeout)) 98 | (when chunk-size 99 | (.setChunkedStreamingMode conn chunk-size)) 100 | (.connect conn) 101 | (when body 102 | (with-open [out (.getOutputStream conn)] 103 | (io/copy body out))) 104 | (merge {:headers (parse-headers conn) 105 | :status (.getResponseCode conn) 106 | :body (when-not (= request-method :head) 107 | (coerce-body-entity req conn))} 108 | (when save-request? 109 | {:request (assoc (dissoc req :save-request?) 110 | :http-url http-url)})))) 111 | -------------------------------------------------------------------------------- /src/clj_http/lite/links.clj: -------------------------------------------------------------------------------- 1 | (ns clj-http.lite.links 2 | "Namespace dealing with HTTP link headers 3 | 4 | Imported from https://github.com/dakrone/clj-http/blob/217393258e7863514debece4eb7b23a7a3fa8bd9/src/clj_http/links.clj") 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | (def ^:private quoted-string 9 | #"\"((?:[^\"]|\\\")*)\"") 10 | 11 | (def ^:private token 12 | #"([^,\";]*)") 13 | 14 | (def ^:private link-param 15 | (re-pattern (str "(\\w+)=(?:" quoted-string "|" token ")"))) 16 | 17 | (def ^:private uri-reference 18 | #"<([^>]*)>") 19 | 20 | (def ^:private link-value 21 | (re-pattern (str uri-reference "((?:\\s*;\\s*" link-param ")*)"))) 22 | 23 | (def ^:private link-header 24 | (re-pattern (str "(?:\\s*(" link-value ")\\s*,?\\s*)"))) 25 | 26 | (defn read-link-params [params] 27 | (into {} 28 | (for [[_ name quot tok] (re-seq link-param params)] 29 | [(keyword name) (or quot tok)]))) 30 | 31 | (defn read-link-value [value] 32 | (let [[_ uri params] (re-matches link-value value) 33 | param-map (read-link-params params)] 34 | [(keyword (:rel param-map)) 35 | (-> param-map 36 | (assoc :href uri) 37 | (dissoc :rel))])) 38 | 39 | (defn read-link-headers [header] 40 | (->> (re-seq link-header header) 41 | (map second) 42 | (map read-link-value) 43 | (into {}))) 44 | 45 | (defn- links-response 46 | [response] 47 | (if-let [link-headers (get-in response [:headers "link"])] 48 | (let [link-headers (if (coll? link-headers) 49 | link-headers 50 | [link-headers])] 51 | (assoc response 52 | :links 53 | (into {} (map read-link-headers link-headers)))) 54 | response)) 55 | 56 | (defn wrap-links 57 | "Returns request wrapper fn for `client` that adds 58 | a `:links` key to the response map that contains parsed link headers. 59 | 60 | The links are returned as a map, with the 'rel' value being the key. The 61 | URI is placed under the 'href' key, to mimic the HTML link element. 62 | 63 | e.g. Link: ; rel=next; title=\"Page 2\" 64 | => {:links {:next {:href \"http://example.com/page2.html\" 65 | :title \"Page 2\"}}}" 66 | [client] 67 | (fn 68 | ([request] 69 | (links-response (client request))) 70 | ([request respond raise] 71 | (client request #(respond (links-response %)) raise)))) 72 | -------------------------------------------------------------------------------- /src/clj_http/lite/util.clj: -------------------------------------------------------------------------------- 1 | (ns clj-http.lite.util 2 | "Helper functions for the HTTP client." 3 | (:require [clojure.java.io :as io]) 4 | (:import (java.io ByteArrayInputStream ByteArrayOutputStream InputStream) 5 | (java.net URLEncoder URLDecoder) 6 | (java.util Base64) 7 | (java.util.zip InflaterInputStream DeflaterInputStream 8 | GZIPInputStream GZIPOutputStream))) 9 | 10 | (set! *warn-on-reflection* true) 11 | 12 | (defn utf8-bytes 13 | "Returns the UTF-8 bytes for string `s`." 14 | [#^String s] 15 | (.getBytes s "UTF-8")) 16 | 17 | (defn utf8-string 18 | "Returns the string for UTF-8 decoding of bytes `b`." 19 | [#^"[B" b] 20 | (String. b "UTF-8")) 21 | 22 | (defn url-decode 23 | "Returns the form-url-decoded version of `encoded` string, using either a 24 | specified `encoding` or UTF-8 by default." 25 | [^String encoded & [encoding]] 26 | (let [^String encoding (or encoding "UTF-8")] 27 | (URLDecoder/decode encoded encoding))) 28 | 29 | (defn url-encode 30 | "Returns an UTF-8 URL encoded version of `unencoded` string." 31 | [^String unencoded] 32 | (URLEncoder/encode unencoded "UTF-8")) 33 | 34 | (defn base64-encode 35 | "Encode an array of `unencoded` bytes into a base64 encoded string." 36 | [unencoded] 37 | (.encodeToString (Base64/getEncoder) unencoded)) 38 | 39 | (defn to-byte-array 40 | "Returns a byte array for InputStream `is`." 41 | [is] 42 | (let [chunk-size 8192 43 | baos (ByteArrayOutputStream.) 44 | buffer (byte-array chunk-size)] 45 | (loop [len (.read ^InputStream is buffer 0 chunk-size)] 46 | (when (not= -1 len) 47 | (.write baos buffer 0 len) 48 | (recur (.read ^InputStream is buffer 0 chunk-size)))) 49 | (.toByteArray baos))) 50 | 51 | (defn gunzip 52 | "Returns a gunzip'd version of byte array `b`." 53 | [b] 54 | (when b 55 | (if (instance? InputStream b) 56 | (GZIPInputStream. b) 57 | (to-byte-array (GZIPInputStream. (ByteArrayInputStream. b)))))) 58 | 59 | (defn gzip 60 | "Returns a gzip'd version byte array `b`." 61 | [b] 62 | (when b 63 | (let [baos (ByteArrayOutputStream.) 64 | gos (GZIPOutputStream. baos)] 65 | (io/copy (ByteArrayInputStream. b) gos) 66 | (.close gos) 67 | (.toByteArray baos)))) 68 | 69 | (defn inflate 70 | "Returns a zlib inflate'd version byte array `b`." 71 | [b] 72 | (when b 73 | (to-byte-array (InflaterInputStream. (ByteArrayInputStream. b))))) 74 | 75 | (defn deflate 76 | "Returns a deflate'd version byte array `b`." 77 | [b] 78 | (when b 79 | (to-byte-array (DeflaterInputStream. (ByteArrayInputStream. b))))) 80 | -------------------------------------------------------------------------------- /test-resources/keystore: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clj-commons/clj-http-lite/27c82755af18dad5bb5636b36e91c65963546113/test-resources/keystore -------------------------------------------------------------------------------- /test-resources/logback.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | %d{ISO8601,Europe/London} [%thread] %-5level %logger{36} - %msg%n 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | -------------------------------------------------------------------------------- /test/clj_http/lite/client_sanity_test.clj: -------------------------------------------------------------------------------- 1 | (ns clj-http.lite.client-sanity-test 2 | "A small subset of tests suitable for sanity testing. 3 | Used by babashka libs tests." 4 | (:require [clj-http.lite.client :as client] 5 | [clojure.test :as t :refer [deftest is]])) 6 | 7 | (deftest client-test 8 | (is (= 200 (:status (client/get "https://www.clojure.org" {:throw-exceptions false})))) 9 | 10 | (is (= 200 (:status (client/get "https://postman-echo.com/get?foo1=bar1&foo2=bar2" {:throw-exceptions false})))) 11 | 12 | (is (= 200 (:status (client/post "https://postman-echo.com/post" {:throw-exceptions false})))) 13 | 14 | (is (= 200 (:status (client/post "https://postman-echo.com/post" 15 | {:body "{\"a\": 1}" 16 | :headers {"X-Hasura-Role" "admin"} 17 | :content-type :json 18 | :accept :json 19 | :throw-exceptions false})))) 20 | 21 | (is (= 200 (:status (client/put "https://postman-echo.com/put" 22 | {:body "{\"a\": 1}" 23 | :headers {"X-Hasura-Role" "admin"} 24 | :content-type :json 25 | :accept :json 26 | :throw-exceptions false}))))) 27 | 28 | (deftest exception-test 29 | (try (client/get "https://site.com/broken") 30 | (is false "should not reach here") 31 | (catch Exception e 32 | (is (:headers (ex-data e)))))) 33 | 34 | (deftest insecure-test 35 | (is (thrown? Exception 36 | (client/get "https://expired.badssl.com"))) 37 | (is (= 200 (:status (client/get "https://expired.badssl.com" {:insecure? true})))) 38 | (is (thrown? Exception 39 | (client/get "https://expired.badssl.com")))) 40 | -------------------------------------------------------------------------------- /test/clj_http/lite/client_test.clj: -------------------------------------------------------------------------------- 1 | (ns clj-http.lite.client-test 2 | (:require [clj-http.lite.client :as client] 3 | [clj-http.lite.util :as util] 4 | [clj-http.lite.test-util.test-report] 5 | [clojure.test :refer [deftest is testing]]) 6 | (:import (java.net UnknownHostException))) 7 | 8 | (defn is-passed [middleware req] 9 | (let [client (middleware identity)] 10 | (is (= req (client req))))) 11 | 12 | (defn is-applied [middleware req-in req-out] 13 | (let [client (middleware identity)] 14 | (is (= req-out (client req-in))))) 15 | 16 | (deftest redirect-on-get 17 | (let [client (fn [req] 18 | (if (= "foo.com" (:server-name req)) 19 | {:status 302 20 | :headers {"location" "http://bar.com/bat"}} 21 | {:status 200 22 | :req req})) 23 | r-client (-> client client/wrap-url client/wrap-redirects) 24 | resp (r-client {:server-name "foo.com" :request-method :get})] 25 | (is (= 200 (:status resp))) 26 | (is (= :get (:request-method (:req resp)))) 27 | (is (= :http (:scheme (:req resp)))) 28 | 29 | (is (= "/bat" (:uri (:req resp)))))) 30 | 31 | (deftest redirect-to-get-on-head 32 | (let [client (fn [req] 33 | (if (= "foo.com" (:server-name req)) 34 | {:status 303 35 | :headers {"location" "http://bar.com/bat"}} 36 | {:status 200 37 | :req req})) 38 | r-client (-> client client/wrap-url client/wrap-redirects) 39 | resp (r-client {:server-name "foo.com" :request-method :head})] 40 | (is (= 200 (:status resp))) 41 | (is (= :get (:request-method (:req resp)))) 42 | (is (= :http (:scheme (:req resp)))) 43 | (is (= "/bat" (:uri (:req resp)))))) 44 | 45 | (deftest pass-on-non-redirect 46 | (let [client (fn [req] {:status 200 :body (:body req)}) 47 | r-client (client/wrap-redirects client) 48 | resp (r-client {:body "ok"})] 49 | (is (= 200 (:status resp))) 50 | (is (= "ok" (:body resp))))) 51 | 52 | (deftest pass-on-follow-redirects-false 53 | (let [client (fn [req] {:status 302 :body (:body req)}) 54 | r-client (client/wrap-redirects client) 55 | resp (r-client {:body "ok" :follow-redirects false})] 56 | (is (= 302 (:status resp))) 57 | (is (= "ok" (:body resp))))) 58 | 59 | (deftest throw-on-exceptional 60 | (let [client (fn [_req] {:status 500}) 61 | e-client (client/wrap-exceptions client)] 62 | (is (thrown-with-msg? Exception #"500" 63 | (e-client {}))))) 64 | 65 | (deftest pass-on-non-exceptional 66 | (let [client (fn [_req] {:status 200}) 67 | e-client (client/wrap-exceptions client) 68 | resp (e-client {})] 69 | (is (= 200 (:status resp))))) 70 | 71 | (deftest pass-on-exceptional-when-surpressed 72 | (let [client (fn [_req] {:status 500}) 73 | e-client (client/wrap-exceptions client) 74 | resp (e-client {:throw-exceptions false})] 75 | (is (= 500 (:status resp))))) 76 | 77 | (deftest apply-on-compressed 78 | (let [client (fn [req] 79 | (is (= "gzip, deflate" 80 | (get-in req [:headers "Accept-Encoding"]))) 81 | {:body (util/gzip (util/utf8-bytes "foofoofooƒ⊙⊙")) 82 | :headers {"Content-Encoding" "gzip"}}) 83 | c-client (client/wrap-decompression client) 84 | resp (c-client {})] 85 | (is (= "foofoofooƒ⊙⊙" (util/utf8-string (:body resp)))))) 86 | 87 | (deftest apply-on-deflated 88 | (let [client (fn [req] 89 | (is (= "gzip, deflate" 90 | (get-in req [:headers "Accept-Encoding"]))) 91 | {:body (util/deflate (util/utf8-bytes "barbarbar⒝⒜⒭")) 92 | :headers {"Content-Encoding" "deflate"}}) 93 | c-client (client/wrap-decompression client) 94 | resp (c-client {})] 95 | (is (= "barbarbar⒝⒜⒭" (util/utf8-string (:body resp)))))) 96 | 97 | (deftest pass-on-non-compressed 98 | (let [c-client (client/wrap-decompression (fn [_req] {:body "foo"})) 99 | resp (c-client {:uri "/foo"})] 100 | (is (= "foo" (:body resp))))) 101 | 102 | (deftest apply-on-accept 103 | (is-applied client/wrap-accept 104 | {:accept :json} 105 | {:headers {"Accept" "application/json"}})) 106 | 107 | (deftest pass-on-no-accept 108 | (is-passed client/wrap-accept 109 | {:uri "/foo"})) 110 | 111 | (deftest apply-on-oauth 112 | (is-applied client/wrap-oauth 113 | {:oauth-token "sample-token"} 114 | {:headers {"Authorization" "Bearer sample-token"}})) 115 | 116 | (deftest pass-on-no-oauth 117 | (is-passed client/wrap-oauth 118 | {:uri "/foo"})) 119 | 120 | (deftest apply-on-accept-encoding 121 | (is-applied client/wrap-accept-encoding 122 | {:accept-encoding [:identity :gzip]} 123 | {:headers {"Accept-Encoding" "identity, gzip"}})) 124 | 125 | (deftest pass-on-no-accept-encoding 126 | (is-passed client/wrap-accept-encoding 127 | {:uri "/foo"})) 128 | 129 | (deftest apply-on-utf8-output-coercion 130 | (let [client (fn [_req] {:body (util/utf8-bytes "fooⓕⓞⓞ")}) 131 | o-client (client/wrap-output-coercion client) 132 | resp (o-client {:uri "/foo"})] 133 | (is (= "fooⓕⓞⓞ" (:body resp))))) 134 | 135 | (deftest apply-on-other-output-coercion 136 | (let [client (fn [_req] {:body (.getBytes "sõme ßÒññÝ chÀråcters" "ISO-8859-1") 137 | :headers {"content-type" "text/foo;charset=ISO-8859-1"}}) 138 | o-client (client/wrap-output-coercion client) 139 | resp (o-client {:uri "/foo" :as :auto})] 140 | (is (= "sõme ßÒññÝ chÀråcters" (:body resp))))) 141 | 142 | (deftest pass-on-no-output-coercion 143 | (let [client (fn [_req] {:body nil}) 144 | o-client (client/wrap-output-coercion client) 145 | resp (o-client {:uri "/foo"})] 146 | (is (nil? (:body resp)))) 147 | (let [client (fn [_req] {:body :thebytes}) 148 | o-client (client/wrap-output-coercion client) 149 | resp (o-client {:uri "/foo" :as :byte-array})] 150 | (is (= :thebytes (:body resp))))) 151 | 152 | (deftest apply-on-input-coercion 153 | (let [i-client (client/wrap-input-coercion identity)] 154 | (doseq [[in-body encoding expected-encoding] [["μτƒ8 нαs мαηλ ςнαяαςτεяs ൠ" nil "UTF-8"] 155 | ["μτƒ8 нαs мαηλ ςнαяαςτεяs ൠ" "UTF-8" "UTF-8"] 156 | ["plain text" "ASCII" "ASCII"] 157 | ["sõme ßÒññÝ chÀråcters" "iso-8859-1" "iso-8859-1"]]] 158 | (let [resp (i-client {:body in-body :body-encoding encoding}) 159 | decoded-body (slurp (:body resp) :encoding expected-encoding)] 160 | (is (= expected-encoding (:character-encoding resp)) "character encoding") 161 | (is (= in-body decoded-body) "body"))))) 162 | 163 | (deftest pass-on-no-input-coercion 164 | (is-passed client/wrap-input-coercion 165 | {:body nil})) 166 | 167 | (deftest apply-on-content-type 168 | (is-applied client/wrap-content-type 169 | {:content-type :json} 170 | {:content-type "application/json"})) 171 | 172 | (deftest pass-on-no-content-type 173 | (is-passed client/wrap-content-type 174 | {:uri "/foo"})) 175 | 176 | (deftest apply-on-query-params 177 | (is-applied client/wrap-query-params 178 | {:query-params {"foo" "bar" "dir" "<<"}} 179 | {:query-string "foo=bar&dir=%3C%3C"})) 180 | 181 | (deftest pass-on-no-query-params 182 | (is-passed client/wrap-query-params 183 | {:uri "/foo"})) 184 | 185 | (deftest apply-on-basic-auth 186 | (is-applied client/wrap-basic-auth 187 | {:basic-auth ["Aladdin" "open sesame"]} 188 | {:headers {"Authorization" 189 | "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ=="}})) 190 | 191 | (deftest pass-on-no-basic-auth 192 | (is-passed client/wrap-basic-auth 193 | {:uri "/foo"})) 194 | 195 | (deftest apply-on-method 196 | (let [m-client (client/wrap-method identity) 197 | echo (m-client {:key :val :method :post})] 198 | (is (= :val (:key echo))) 199 | (is (= :post (:request-method echo))) 200 | (is (not (:method echo))))) 201 | 202 | (deftest pass-on-no-method 203 | (let [m-client (client/wrap-method identity) 204 | echo (m-client {:key :val})] 205 | (is (= :val (:key echo))) 206 | (is (not (:request-method echo))))) 207 | 208 | (deftest apply-on-url 209 | (let [u-client (client/wrap-url identity) 210 | resp (u-client {:url "http://google.com:8080/foo?bar=bat"})] 211 | (is (= :http (:scheme resp))) 212 | (is (= "google.com" (:server-name resp))) 213 | (is (= 8080 (:server-port resp))) 214 | (is (= "/foo" (:uri resp))) 215 | (is (= "bar=bat" (:query-string resp))))) 216 | 217 | (deftest pass-on-no-url 218 | (let [u-client (client/wrap-url identity) 219 | resp (u-client {:uri "/foo"})] 220 | (is (= "/foo" (:uri resp))))) 221 | 222 | (deftest provide-default-port 223 | (is (= nil (-> "http://example.com/" client/parse-url :server-port))) 224 | (is (= 8080 (-> "http://example.com:8080/" client/parse-url :server-port))) 225 | (is (= nil (-> "https://example.com/" client/parse-url :server-port))) 226 | (is (= 8443 (-> "https://example.com:8443/" client/parse-url :server-port)))) 227 | 228 | (deftest apply-on-form-params 229 | (testing "With form params" 230 | (let [param-client (client/wrap-form-params identity) 231 | resp (param-client {:request-method :post 232 | :form-params {:param1 "value1" 233 | :param2 "value2"}})] 234 | (is (or (= "param1=value1¶m2=value2" (:body resp)) 235 | (= "param2=value2¶m1=value1" (:body resp)))) 236 | (is (= "application/x-www-form-urlencoded" (:content-type resp))) 237 | (is (not (contains? resp :form-params))))) 238 | (testing "Ensure it does not affect GET requests" 239 | (let [param-client (client/wrap-form-params identity) 240 | resp (param-client {:request-method :get 241 | :body "untouched" 242 | :form-params {:param1 "value1" 243 | :param2 "value2"}})] 244 | (is (= "untouched" (:body resp))) 245 | (is (not (contains? resp :content-type))))) 246 | 247 | (testing "with no form params" 248 | (let [param-client (client/wrap-form-params identity) 249 | resp (param-client {:body "untouched"})] 250 | (is (= "untouched" (:body resp))) 251 | (is (not (contains? resp :content-type)))))) 252 | 253 | (deftest apply-on-nest-params 254 | (let [param-client (client/wrap-nested-params identity) 255 | params {:a 256 | {:b 257 | {:c 5} 258 | :e 259 | {:f 6}} 260 | :g 7} 261 | resp (param-client {:form-params params :query-params params})] 262 | (is (= {"a[b][c]" 5 "a[e][f]" 6 :g 7} (:form-params resp) (:query-params resp))))) 263 | 264 | (deftest pass-on-no-nest-params 265 | (let [m-client (client/wrap-nested-params identity) 266 | in {:key :val} 267 | out (m-client in)] 268 | (is (= out in)))) 269 | 270 | (deftest t-ignore-unknown-host 271 | (is (thrown? UnknownHostException (client/get "http://aorecuf892983a.com"))) 272 | (is (nil? (client/get "http://aorecuf892983a.com" 273 | {:ignore-unknown-host? true})))) 274 | -------------------------------------------------------------------------------- /test/clj_http/lite/integration_test.clj: -------------------------------------------------------------------------------- 1 | (ns clj-http.lite.integration-test 2 | (:require [clj-http.lite.client :as client] 3 | [clj-http.lite.core :as core] 4 | [clj-http.lite.util :as util] 5 | [clj-http.lite.test-util.server-process :as server-process] 6 | [clj-http.lite.test-util.test-report] 7 | [clojure.test :refer [deftest is use-fixtures]])) 8 | 9 | (def ^:dynamic *server* nil) 10 | 11 | (defn with-server [t] 12 | (let [s (server-process/launch)] 13 | (try 14 | (binding [*server* s] 15 | (t)) 16 | (finally 17 | (server-process/kill s))))) 18 | 19 | (use-fixtures :once with-server) 20 | 21 | (defn base-req [] 22 | {:scheme :http 23 | :server-name "localhost" 24 | :server-port (:http-port *server*)}) 25 | 26 | (defn request [req] 27 | (core/request (merge (base-req) req))) 28 | 29 | (defn slurp-body [req] 30 | (slurp (:body req))) 31 | 32 | ;; 33 | ;; Lower level internal unwrapped core requests 34 | ;; 35 | (deftest makes-get-request 36 | (let [resp (request {:request-method :get :uri "/get"})] 37 | (is (= 200 (:status resp))) 38 | (is (= "get" (slurp-body resp))))) 39 | 40 | (deftest makes-head-request 41 | (let [resp (request {:request-method :head :uri "/head"})] 42 | (is (= 200 (:status resp))) 43 | (is (nil? (:body resp))))) 44 | 45 | (deftest sets-content-type-with-charset 46 | (let [resp (request {:request-method :get :uri "/content-type" 47 | :content-type "text/plain" :character-encoding "UTF-8"})] 48 | (is (= "text/plain; charset=UTF-8" (slurp-body resp))))) 49 | 50 | (deftest sets-content-type-without-charset 51 | (let [resp (request {:request-method :get :uri "/content-type" 52 | :content-type "text/plain"})] 53 | (is (= "text/plain" (slurp-body resp))))) 54 | 55 | (deftest sets-arbitrary-headers 56 | (let [resp (request {:request-method :get :uri "/header" 57 | :headers {"X-My-Header" "header-val"}})] 58 | (is (= "header-val" (slurp-body resp))))) 59 | 60 | (deftest sends-and-returns-byte-array-body 61 | (let [resp (request {:request-method :post :uri "/post" 62 | :body (util/utf8-bytes "contents")})] 63 | (is (= 200 (:status resp))) 64 | (is (= "contents" (slurp-body resp))))) 65 | 66 | (deftest returns-arbitrary-headers 67 | (let [resp (request {:request-method :get :uri "/get"})] 68 | (is (string? (get-in resp [:headers "date"]))))) 69 | 70 | (deftest returns-status-on-exceptional-responses 71 | (let [resp (request {:request-method :get :uri "/error"})] 72 | (is (= 500 (:status resp))))) 73 | 74 | (deftest returns-status-on-redirect 75 | (let [resp (request {:request-method :get :uri "/redirect" :follow-redirects false})] 76 | (is (= 302 (:status resp))))) 77 | 78 | (deftest auto-follows-on-redirect 79 | (let [resp (request {:request-method :get :uri "/redirect"})] 80 | (is (= 200 (:status resp))) 81 | (is (= "get" (slurp-body resp))))) 82 | 83 | (deftest sets-conn-timeout 84 | ;; indirect way of testing if a connection timeout will fail by passing in an 85 | ;; invalid argument 86 | (try 87 | (request {:request-method :get :uri "/timeout" :conn-timeout -1}) 88 | (throw (Exception. "Shouldn't get here.")) 89 | (catch Exception e 90 | (is (= IllegalArgumentException (class e)))))) 91 | 92 | (deftest sets-socket-timeout 93 | (try 94 | (request {:request-method :get :uri "/timeout" :socket-timeout 1}) 95 | (is false "expected a throw") 96 | (catch Exception e 97 | (is (or (= java.net.SocketTimeoutException (class e)) 98 | (= java.net.SocketTimeoutException (class (.getCause e)))))))) 99 | 100 | (deftest delete-with-body 101 | (let [resp (request {:request-method :delete :uri "/delete-with-body" 102 | :body (.getBytes "foo bar")})] 103 | (is (= 200 (:status resp))) 104 | (is (= "delete-with-body" (slurp-body resp))))) 105 | 106 | (deftest self-signed-ssl-get 107 | (let [client-opts {:request-method :get 108 | :uri "/get" 109 | :scheme :https 110 | :server-name "localhost" 111 | :server-port (:https-port *server*)}] 112 | (is (thrown? javax.net.ssl.SSLException 113 | (request client-opts))) 114 | (let [resp (request (assoc client-opts :insecure? true))] 115 | (is (= 200 (:status resp))) 116 | (is (= "get" (slurp-body resp)))) 117 | (is (thrown? javax.net.ssl.SSLException 118 | (request client-opts))))) 119 | 120 | (deftest t-save-request-obj 121 | (let [resp (request {:request-method :post :uri "/post" 122 | :body (.getBytes "foo bar" "UTF-8") 123 | :save-request? true})] 124 | (is (= 200 (:status resp))) 125 | (is (= {:scheme :http 126 | :http-url (str "http://localhost:" (:http-port *server*) "/post") 127 | :request-method :post 128 | :uri "/post" 129 | :server-name "localhost" 130 | :server-port (:http-port *server*)} 131 | (-> resp 132 | :request 133 | (dissoc :body)))))) 134 | 135 | (deftest t-streaming-response 136 | (let [stream (:body (request {:request-method :get :uri "/get" :as :stream})) 137 | body (slurp stream)] 138 | (is (= "get" body)))) 139 | 140 | ;; 141 | ;; API level client wrapped requests 142 | ;; 143 | (deftest roundtrip 144 | ;; roundtrip with scheme as a keyword 145 | (let [resp (client/request (merge (base-req) {:uri "/get" :method :get}))] 146 | (is (= 200 (:status resp))) 147 | (is (= "get" (:body resp)))) 148 | ;; roundtrip with scheme as a string 149 | (let [resp (client/request (merge (base-req) {:uri "/get" 150 | :method :get 151 | :scheme "http"}))] 152 | (is (= 200 (:status resp))) 153 | (is (= "get" (:body resp))))) 154 | 155 | (deftest basic-auth-no-creds 156 | (let [resp (client/request (merge (base-req) {:method :get 157 | :uri "/basic-auth" 158 | :throw-exceptions false}))] 159 | (is (= 401 (:status resp))) 160 | (is (= "denied" (:body resp))))) 161 | 162 | (deftest basic-auth-bad-creds 163 | (let [resp (client/request (merge (base-req) {:method :get 164 | :uri "/basic-auth" 165 | :throw-exceptions false 166 | :basic-auth "username:nope"}))] 167 | (is (= 401 (:status resp))) 168 | (is (= "denied" (:body resp))))) 169 | 170 | (deftest basic-auth-creds-as-basic-auth 171 | (let [resp (client/request (merge (base-req) {:method :get 172 | :uri "/basic-auth" 173 | :basic-auth "username:password"}))] 174 | (is (= 200 (:status resp))) 175 | (is (= "welcome" (:body resp))))) 176 | 177 | (deftest basic-auth-creds-as-user-info 178 | (let [resp (client/request (merge (base-req) {:method :get 179 | :uri "/basic-auth" 180 | :user-info "username:password"}))] 181 | (is (= 200 (:status resp))) 182 | (is (= "welcome" (:body resp))))) 183 | 184 | (deftest basic-auth-creds-from-url 185 | (let [resp (client/request {:method :get 186 | :url (format "http://username:password@localhost:%d/basic-auth" 187 | (:http-port *server*))})] 188 | (is (= 200 (:status resp))) 189 | (is (= "welcome" (:body resp))))) 190 | -------------------------------------------------------------------------------- /test/clj_http/lite/links_test.clj: -------------------------------------------------------------------------------- 1 | (ns clj-http.lite.links-test 2 | "Imported from https://github.com/dakrone/clj-http/blob/217393258e7863514debece4eb7b23a7a3fa8bd9/test/clj_http/test/links_test.clj" 3 | (:require [clj-http.lite.links :refer [wrap-links]] 4 | [clj-http.lite.test-util.test-report] 5 | [clojure.test :refer [deftest is testing]])) 6 | 7 | (defn- link-handler [link-header] 8 | (wrap-links (constantly {:headers {"link" link-header}}))) 9 | 10 | (deftest test-wrap-links 11 | (testing "absolute link" 12 | (let [handler (link-handler "; rel=next")] 13 | (is (= (:links (handler {})) 14 | {:next {:href "http://example.com/page2.html"}})))) 15 | (testing "relative link" 16 | (let [handler (link-handler ";rel=next")] 17 | (is (= (:links (handler {})) 18 | {:next {:href "/page2.html"}})))) 19 | (testing "extra params" 20 | (let [handler (link-handler "; rel=next; title=\"Page 2\"")] 21 | (is (= (:links (handler {})) 22 | {:next {:href "/page2.html", :title "Page 2"}})))) 23 | (testing "multiple headers" 24 | (let [handler (link-handler ";rel=prev, ;rel=next,;rel=home")] 25 | (is (= (:links (handler {})) 26 | {:prev {:href "/p1"} 27 | :next {:href "/p3"} 28 | :home {:href "/"}})))) 29 | (testing "no :links key if no link headers" 30 | (let [handler (wrap-links (constantly {:headers {}})) 31 | response (handler {})] 32 | (is (not (contains? response :links)))))) 33 | 34 | (deftest t-multiple-link-headers 35 | (let [handler (link-handler ["; rel=shorturl" 36 | "; rel=icon"]) 37 | resp (handler {})] 38 | (is (= (:links resp) 39 | {:shorturl {:href "http://example.com/Zl_A"} 40 | :icon {:href "http://example.com/foo.png"}})))) 41 | -------------------------------------------------------------------------------- /test/clj_http/lite/test_util/http_server.clj: -------------------------------------------------------------------------------- 1 | (ns clj-http.lite.test-util.http-server 2 | (:require [babashka.fs :as fs] 3 | [clj-http.lite.util :as util] 4 | [clj-http.lite.test-util.server-state :refer [server-state-file]] 5 | [clojure.string :as str] 6 | [ring.adapter.jetty :as ring]) 7 | (:import (org.eclipse.jetty.server Server ServerConnector) 8 | (java.util Base64))) 9 | 10 | (set! *warn-on-reflection* true) 11 | 12 | (defn b64-decode [^String s] 13 | (when s 14 | (-> (Base64/getDecoder) 15 | (.decode s) 16 | util/utf8-string))) 17 | 18 | (defn handler [req] 19 | (condp = [(:request-method req) (:uri req)] 20 | [:get "/get"] 21 | {:status 200 :body "get"} 22 | [:head "/head"] 23 | {:status 200} 24 | [:get "/content-type"] 25 | {:status 200 :body (:content-type req)} 26 | [:get "/header"] 27 | {:status 200 :body (get-in req [:headers "x-my-header"])} 28 | [:post "/post"] 29 | {:status 200 :body (slurp (:body req))} 30 | [:get "/redirect"] {:status 302 :headers {"Location" "/get"}} 31 | [:get "/error"] 32 | {:status 500 :body "o noes"} 33 | [:get "/timeout"] 34 | (do 35 | (Thread/sleep 100) 36 | {:status 200 :body "timeout"}) 37 | [:delete "/delete-with-body"] 38 | {:status 200 :body "delete-with-body"} 39 | ;; minimal to support testing 40 | [:get "/basic-auth"] 41 | (let [cred (some->> (get (:headers req) "authorization") 42 | (re-find #"^Basic (.*)$") 43 | last 44 | b64-decode) 45 | [user pass] (and cred (str/split cred #":"))] 46 | (if (and (= "username" user) (= "password" pass)) 47 | {:status 200 :body "welcome"} 48 | {:status 401 :body "denied"})) 49 | [:get "/stop"] 50 | (do 51 | (future (Thread/sleep 1000) 52 | (println "http-server exiting") 53 | (System/exit 0)) 54 | {:status 200 :body "bye"}))) 55 | 56 | (defn- port-for-protocol [^Server s p] 57 | (some (fn [^ServerConnector c] 58 | (when (str/starts-with? (str/lower-case (.getDefaultProtocol c)) p) 59 | (.getLocalPort c))) 60 | (.getConnectors s))) 61 | 62 | (defn run 63 | "ex. clojure -X:http-server" 64 | [_opts] 65 | (let [^Server s (ring/run-jetty handler {:port 0 ;; Use a free port 66 | :join? false 67 | :ssl-port 0 ;; Use a free port 68 | :ssl? true 69 | :keystore "test-resources/keystore" 70 | :key-password "keykey"})] 71 | (println "server started") 72 | (fs/create-dirs "target") 73 | (let [ports {:http-port (port-for-protocol s "http/") 74 | :https-port (port-for-protocol s "ssl")} 75 | ;; write to temp then move to avoid chance of watcher reading partially written file 76 | tmp-file (fs/create-temp-file {:path "target" 77 | :prefix "http-server" 78 | :suffix ".edn"})] 79 | (spit (fs/file tmp-file) ports) 80 | (fs/move tmp-file server-state-file {:atomic-move true 81 | :replace-existing true})))) 82 | -------------------------------------------------------------------------------- /test/clj_http/lite/test_util/server_process.clj: -------------------------------------------------------------------------------- 1 | (ns clj-http.lite.test-util.server-process 2 | (:require [clj-http.lite.test-util.server-state :refer [server-state-file]] 3 | [clojure.edn :as edn]) 4 | (:import (java.net URL HttpURLConnection) 5 | (java.lang ProcessBuilder$Redirect) 6 | (java.time Duration))) 7 | 8 | (defn- url-reachable? [s] 9 | (try 10 | (let [^HttpURLConnection c (.openConnection (URL. s))] 11 | (.setRequestMethod c "GET") 12 | (= 200 (.getResponseCode c))) 13 | (catch Throwable _e))) 14 | 15 | (defn kill [{:keys [^Process process http-port]}] 16 | (when (and process (.isAlive process)) 17 | (println "Stopping http-server") 18 | (try 19 | (let [^HttpURLConnection c (.openConnection (URL. (format "http://localhost:%d/stop" http-port)))] 20 | (.setRequestMethod c "GET") 21 | (.getResponseCode c)) 22 | (catch Throwable e 23 | (println "warn: stop command failed\n" (.printStackTrace e)))) 24 | (.waitFor process))) 25 | 26 | (defn duration [start-ms end-ms] 27 | (-> (Duration/ofMillis (- end-ms start-ms)) 28 | str 29 | (subs 2))) 30 | 31 | (defn launch [] 32 | (when (.exists server-state-file) 33 | (.delete server-state-file)) 34 | (let [max-wait-msecs 120000 ;; Windows GitHub Actions CI can be painfully slow 35 | status-every-ms 1000 36 | start-time-ms (System/currentTimeMillis) 37 | time-limit-ms (+ start-time-ms max-wait-msecs) 38 | ;; use bb's clojure launcher for an easy time on Windows 39 | p (-> (ProcessBuilder. ["bb" "clojure" "-X:http-server"]) 40 | (.redirectOutput ProcessBuilder$Redirect/INHERIT) 41 | (.redirectError ProcessBuilder$Redirect/INHERIT) 42 | (.start))] 43 | (-> (Runtime/getRuntime) 44 | (.addShutdownHook (Thread. (fn [] (when (.isAlive p) 45 | (println "killing http-server forcibly") 46 | (.destroyForcibly p) 47 | (.waitFor p)))))) 48 | (print "Starting http-server") 49 | (flush) 50 | (loop [next-status (System/currentTimeMillis) 51 | server-state nil] 52 | (cond 53 | (not (.isAlive p)) 54 | (throw (ex-info "Http-server process died unexpectedly" {})) 55 | (> (System/currentTimeMillis) time-limit-ms) 56 | (do (when server-state 57 | (kill server-state)) 58 | (throw (ex-info (format "Timed out after waiting %s for test http-server to start" 59 | (duration start-time-ms (System/currentTimeMillis))) {}))) 60 | (and server-state (url-reachable? (format "http://localhost:%d/get" 61 | (:http-port server-state)))) 62 | (do (println "waited" (duration start-time-ms (System/currentTimeMillis))) 63 | server-state) 64 | (and (not server-state) (.exists server-state-file)) 65 | (recur next-status 66 | (-> server-state-file slurp edn/read-string (assoc :process p))) 67 | :else 68 | (let [next-status (if (> (System/currentTimeMillis) next-status) 69 | (do (print ".") 70 | (flush) 71 | (+ (System/currentTimeMillis) status-every-ms)) 72 | next-status)] 73 | (Thread/sleep 50) 74 | (recur next-status server-state)))))) 75 | -------------------------------------------------------------------------------- /test/clj_http/lite/test_util/server_state.clj: -------------------------------------------------------------------------------- 1 | (ns clj-http.lite.test-util.server-state 2 | (:require [clojure.java.io :as io])) 3 | 4 | (def server-state-file (io/file "target/http-server.edn")) 5 | -------------------------------------------------------------------------------- /test/clj_http/lite/test_util/test_report.clj: -------------------------------------------------------------------------------- 1 | (ns clj-http.lite.test-util.test-report 2 | (:require [clojure.test])) 3 | 4 | (def platform 5 | (if (System/getProperty "babashka.version") 6 | "bb" 7 | (str "jvm-clj " (clojure-version)))) 8 | 9 | (defmethod clojure.test/report :begin-test-var [m] 10 | (let [test-name (-> m :var meta :name)] 11 | (println (format "=== %s [%s]" test-name platform)))) 12 | --------------------------------------------------------------------------------