diff --git a/src/clj_test_containers/core.clj b/src/clj_test_containers/core.clj index 697599b..45ca9ba 100644 --- a/src/clj_test_containers/core.clj +++ b/src/clj_test_containers/core.clj @@ -1,24 +1,25 @@ (ns clj-test-containers.core (:require - [clj-test-containers.spec.core :as cs] - [clojure.spec.alpha :as s] - [clojure.string]) + [clj-test-containers.spec.core :as cs] + [clojure.spec.alpha :as s] + [clojure.string]) (:import - (java.nio.file - Paths) - (org.testcontainers.containers - BindMode - GenericContainer - Network) - (org.testcontainers.containers.output - ToStringConsumer) - (org.testcontainers.containers.wait.strategy - Wait) - (org.testcontainers.images.builder - ImageFromDockerfile) - (org.testcontainers.utility - MountableFile - ResourceReaper))) + (java.nio.file + Paths) + (org.testcontainers.containers + BindMode + GenericContainer + Network) + (org.testcontainers.containers.output + ToStringConsumer) + (org.testcontainers.containers.wait.strategy + Wait) + (org.testcontainers.images.builder + ImageFromDockerfile) + (org.testcontainers.utility + MountableFile + ResourceReaper) + (java.time Duration))) (defn- resolve-bind-mode (^BindMode [bind-mode] @@ -31,66 +32,72 @@ (ResourceReaper/instance)) (defmulti wait - "Sets a wait strategy to the container. Supports :http, :health and :log as - strategies. + "Sets a wait strategy to the container. Supports :http, :health and :log as + strategies. - ## HTTP Strategy - The :http strategy will only accept the container as initialized if it can be - accessed via HTTP. It accepts a path, a port, a vector of status codes, a - boolean that specifies if TLS is enabled, a read timeout in seconds and a map - with basic credentials, containing username and password. Only the path is - required, all others are optional. + ## HTTP Strategy + The :http strategy will only accept the container as initialized if it can be + accessed via HTTP. It accepts a path, a port, a vector of status codes, a + boolean that specifies if TLS is enabled, a read timeout in seconds and a map + with basic credentials, containing username and password. Only the path is + required, all others are optional. - Example: + Example: - ```clojure - (wait {:wait-strategy :http - :port 80 - :path \"/\" - :status-codes [200 201] - :tls true - :read-timeout 5 - :basic-credentials {:username \"user\" - :password \"password\"}} - container) - ``` + ```clojure + (wait {:wait-strategy :http + :port 80 + :path \"/\" + :status-codes [200 201] + :tls true + :read-timeout 5 + :basic-credentials {:username \"user\" + :password \"password\"}} + container) + ``` - ## Health Strategy - The :health strategy only accepts a true or false value. This enables support - for Docker's healthcheck feature, whereby you can directly leverage the - healthy state of your container as your wait condition. + ## Health Strategy + The :health strategy only accepts a true or false value. This enables support + for Docker's healthcheck feature, whereby you can directly leverage the + healthy state of your container as your wait condition. - Example: + Example: - ```clojure - (wait {:wait-strategy :health :true} container) - ``` + ```clojure + (wait {:wait-strategy :health :true} container) + ``` - ## Log Strategy - The :log strategy accepts a message which simply causes the output of your - container's log to be used in determining if the container is ready or not. - The output is `grepped` against the log message. + ## Log Strategy + The :log strategy accepts a message which simply causes the output of your + container's log to be used in determining if the container is ready or not. + The output is `grepped` against the log message. - Example: + Example: - ```clojure - (wait {:wait-strategy :log - :message \"accept connections\"} container) - ```" - :wait-strategy) + ```clojure + (wait {:wait-strategy :log + :message \"accept connections\"} container) + ```" + :wait-strategy) (defmethod wait :http [{:keys [path port + method status-codes tls read-timeout - basic-credentials] :as options} + basic-credentials + headers + startup-timeout] :as options} ^GenericContainer container] (let [for-http (Wait/forHttp path)] (when port (.forPort for-http port)) + (when method + (.withMethod for-http method)) + (doseq [status-code status-codes] (.forStatusCode for-http status-code)) @@ -98,27 +105,53 @@ (.usingTls for-http)) (when read-timeout - (.withReadTimeout for-http (java.time.Duration/ofSeconds read-timeout))) + (.withReadTimeout for-http (Duration/ofSeconds read-timeout))) (when basic-credentials - (let [{username :username password :password} basic-credentials] + (let [{:keys [username password]} basic-credentials] (.withBasicCredentials for-http username password))) + (when headers + (.withHeaders for-http headers)) + + (when startup-timeout + (.withStartupTimeout for-http (Duration/ofSeconds startup-timeout))) + (.waitingFor container for-http) {:wait-for-http (dissoc options :strategy)})) (defmethod wait :health - [_ ^GenericContainer container] - (.waitingFor container (Wait/forHealthcheck)) + [{:keys [startup-timeout]} ^GenericContainer container] + (let [strategy (Wait/forHealthcheck)] + + (when startup-timeout + (.withStartupTimeout strategy (Duration/ofSeconds startup-timeout))) + + (.waitingFor container strategy)) {:wait-for-healthcheck true}) (defmethod wait :log - [{:keys [message]} ^GenericContainer container] - (let [log-message (str ".*" message ".*\\n")] - (.waitingFor container (Wait/forLogMessage log-message 1)) + [{:keys [message startup-timeout]} ^GenericContainer container] + (let [log-message (str ".*" message ".*\\n") + strategy (Wait/forLogMessage log-message 1)] + + (when startup-timeout + (.withStartupTimeout strategy (Duration/ofSeconds startup-timeout))) + + (.waitingFor container strategy) {:wait-for-log-message log-message})) +(defmethod wait :port + [{:keys [startup-timeout]} ^GenericContainer container] + (let [strategy (Wait/forListeningPort)] + + (when startup-timeout + (.withStartupTimeout strategy (Duration/ofSeconds startup-timeout))) + + (.waitingFor container strategy)) + {:wait-for-port true}) + (defmethod wait :default [_ _] nil) (s/fdef init @@ -149,11 +182,11 @@ (when network-aliases (.setNetworkAliases container network-aliases)) - (merge init-options {:container container + (merge init-options {:container container :exposed-ports (vec (.getExposedPorts container)) - :env-vars (into {} (.getEnvMap container)) - :host (.getHost container) - :network network} (wait wait-for container))) + :env-vars (into {} (.getEnvMap container)) + :host (.getHost container) + :network network} (wait wait-for container))) (s/fdef create :args (s/cat :create-options ::cs/create-options) @@ -181,11 +214,11 @@ [{:keys [^GenericContainer container] :as container-config} {:keys [^String resource-path ^String container-path mode]}] (assoc container-config - :container - (.withClasspathResourceMapping container - resource-path - container-path - (resolve-bind-mode mode)))) + :container + (.withClasspathResourceMapping container + resource-path + container-path + (resolve-bind-mode mode)))) (defn bind-filesystem! "Binds a source from the filesystem to the given container path. Should be @@ -193,11 +226,11 @@ [{:keys [^GenericContainer container] :as container-config} {:keys [^String host-path ^String container-path mode]}] (assoc container-config - :container - (.withFileSystemBind container - host-path - container-path - (resolve-bind-mode mode)))) + :container + (.withFileSystemBind container + host-path + container-path + (resolve-bind-mode mode)))) (defn copy-file-to-container! "If a container is not yet started, adds a mapping from mountable file to @@ -208,16 +241,16 @@ (let [^MountableFile mountable-file (case type :classpath-resource (MountableFile/forClasspathResource path) - :host-path (MountableFile/forHostPath path))] + :host-path (MountableFile/forHostPath path))] (if id (do (.copyFileToContainer container mountable-file container-path) container-config) (assoc container-config - :container - (.withCopyFileToContainer container - mountable-file - container-path))))) + :container + (.withCopyFileToContainer container + mountable-file + container-path))))) (defn execute-command! "Executes a command in the container, and returns the result" @@ -228,28 +261,28 @@ :stderr (.getStderr result)})) (defmulti log - "Sets a log strategy on the container as a means of accessing the container - logs. It currently only supports a :string as the strategy to use. + "Sets a log strategy on the container as a means of accessing the container + logs. It currently only supports a :string as the strategy to use. - ## String Strategy - The :string strategy sets up a function in the returned map, under the - `string-log` key. This function enables the dumping of the logs when passed to - the `dump-logs` function. + ## String Strategy + The :string strategy sets up a function in the returned map, under the + `string-log` key. This function enables the dumping of the logs when passed to + the `dump-logs` function. - Example: + Example: - ```clojure - {:log-strategy :string} - ``` + ```clojure + {:log-strategy :string} + ``` - Then, later in your program, you can access the logs thus: + Then, later in your program, you can access the logs thus: - ```clojure - (def container-config (tc/start! container)) - (tc/dump-logs container-config) - ``` - " - :log-strategy) + ```clojure + (def container-config (tc/start! container)) + (tc/dump-logs container-config) + ``` + " + :log-strategy) (defmethod log :string [_ ^GenericContainer container] @@ -259,9 +292,9 @@ (-> (.toUtf8String to-string-consumer) (clojure.string/replace #"\n+" "\n")))})) -(defmethod log :slf4j [_ _] nil) ;; Not yet implemented +(defmethod log :slf4j [_ _] nil) ;; Not yet implemented -(defmethod log :default [_ _] nil) ;; Not yet implemented +(defmethod log :default [_ _] nil) ;; Not yet implemented (defn dump-logs "Dumps the logs found by invoking the function on the :string-log key" @@ -286,9 +319,9 @@ container-id image-name) (-> container-config - (merge {:id container-id + (merge {:id container-id :mapped-ports mapped-ports - :image-name image-name} logger) + :image-name image-name} logger) (dissoc :log-to)))) (defn stop! @@ -320,9 +353,9 @@ network-name (.getName network)] (.registerNetworkIdForCleanup ^ResourceReaper (reaper-instance) network-name) {:network network - :name network-name - :ipv6 (.getEnableIpv6 network) - :driver (.getDriver network)})))) + :name network-name + :ipv6 (.getEnableIpv6 network) + :driver (.getDriver network)})))) (def ^:deprecated init-network create-network) diff --git a/test/clj_test_containers/core_test.clj b/test/clj_test_containers/core_test.clj index cda1674..238c60f 100644 --- a/test/clj_test_containers/core_test.clj +++ b/test/clj_test_containers/core_test.clj @@ -1,17 +1,17 @@ (ns clj-test-containers.core-test (:require - [clj-test-containers.core :as sut] - [clojure.string :refer [includes?]] - [clojure.test :refer [deftest is testing]]) + [clj-test-containers.core :as sut] + [clojure.string :refer [includes?]] + [clojure.test :refer [deftest is testing]]) (:import - (org.testcontainers.containers - PostgreSQLContainer))) + (org.testcontainers.containers + PostgreSQLContainer))) (deftest create-test (testing "Testing basic testcontainer generic image initialisation" - (let [container (sut/create {:image-name "postgres:12.2" + (let [container (sut/create {:image-name "postgres:12.2" :exposed-ports [5432] - :env-vars {"POSTGRES_PASSWORD" "pw"}}) + :env-vars {"POSTGRES_PASSWORD" "pw"}}) initialized-container (sut/start! container) stopped-container (sut/stop! container)] (is (some? (:id initialized-container))) @@ -22,16 +22,18 @@ (testing "Testing log access to the container" (let [container (sut/init {:container (PostgreSQLContainer. "postgres:12.2") - :log-to {:log-strategy :string}}) + :log-to {:log-strategy :string}}) initialized-container (sut/start! container)] (Thread/sleep 500) (is (includes? (sut/dump-logs initialized-container) "database system is ready to accept connections")))) (testing "Testing basic testcontainer generic image initialisation with wait for log message" - (let [container (sut/create {:image-name "postgres:12.2" + (let [container (sut/create {:image-name "postgres:12.2" :exposed-ports [5432] - :env-vars {"POSTGRES_PASSWORD" "pw"} - :wait-for {:wait-strategy :log :message "accept connections"}}) + :env-vars {"POSTGRES_PASSWORD" "pw"} + :wait-for {:wait-strategy :log + :message "accept connections" + :startup-timeout 10}}) initialized-container (sut/start! container) stopped-container (sut/stop! container)] (is (some? (:id initialized-container))) @@ -41,9 +43,50 @@ (is (nil? (:id stopped-container))) (is (nil? (:mapped-ports stopped-container))))) + (testing "Testing basic testcontainer generic image initialisation with wait for host port" + (let [container (sut/create {:image-name "postgres:12.2" + :exposed-ports [5432] + :env-vars {"POSTGRES_PASSWORD" "pw"} + :wait-for {:wait-strategy :port}}) + initialized-container (sut/start! container) + stopped-container (sut/stop! container)] + (is (some? (:id initialized-container))) + (is (some? (:mapped-ports initialized-container))) + (is (some? (get (:mapped-ports initialized-container) 5432))) + (is (= (:wait-for-port initialized-container) true)) + (is (nil? (:id stopped-container))) + (is (nil? (:mapped-ports stopped-container))))) + + (testing "Testing basic testcontainer generic image initialisation with wait for http" + (let [container (sut/create {:image-name "alpine:3.5" + :network-aliases ["foo"] + :command ["/bin/sh" + "-c" + "while true ; do printf 'HTTP/1.1 200 OK\\n\\nyay' | nc -l -p 8080; done"] + :exposed-ports [8080] + :wait-for {:wait-strategy :http + :path "/" + :port 8080 + :method "GET" + :status-codes [200] + :headers {"Accept" "text/plain"}}}) + initialized-container (sut/start! container) + stopped-container (sut/stop! container)] + (is (some? (:id initialized-container))) + (is (some? (:mapped-ports initialized-container))) + (is (some? (get (:mapped-ports initialized-container) 8080))) + (is (= (:wait-for-http initialized-container) {:headers {"Accept" "text/plain"} + :method "GET" + :path "/" + :port 8080 + :status-codes [200] + :wait-strategy :http})) + (is (nil? (:id stopped-container))) + (is (nil? (:mapped-ports stopped-container))))) + (testing "Testing basic testcontainer image creation from docker file" (let [container (sut/create-from-docker-file {:exposed-ports [80] - :docker-file "test/resources/Dockerfile"}) + :docker-file "test/resources/Dockerfile"}) initialized-container (sut/start! container) stopped-container (sut/stop! container)] (is (some? (:id initialized-container))) @@ -64,9 +107,9 @@ (deftest execute-command-in-container (testing "Executing a command in the running Docker container" - (let [container (sut/create {:image-name "postgres:12.2" + (let [container (sut/create {:image-name "postgres:12.2" :exposed-ports [5432] - :env-vars {"POSTGRES_PASSWORD" "pw"}}) + :env-vars {"POSTGRES_PASSWORD" "pw"}}) initialized-container (sut/start! container) result (sut/execute-command! initialized-container ["whoami"]) _stopped-container (sut/stop! container)] @@ -76,12 +119,12 @@ (deftest init-volume-test (testing "Testing mapping of a classpath resource" - (let [container (-> (sut/create {:image-name "postgres:12.2" + (let [container (-> (sut/create {:image-name "postgres:12.2" :exposed-ports [5432] - :env-vars {"POSTGRES_PASSWORD" "pw"}}) - (sut/map-classpath-resource! {:resource-path "test.sql" + :env-vars {"POSTGRES_PASSWORD" "pw"}}) + (sut/map-classpath-resource! {:resource-path "test.sql" :container-path "/opt/test.sql" - :mode :read-only})) + :mode :read-only})) initialized-container (sut/start! container) file-check (sut/execute-command! initialized-container ["tail" "/opt/test.sql"]) stopped-container (sut/stop! container)] @@ -93,12 +136,12 @@ (is (nil? (:mapped-ports stopped-container))))) (testing "Testing mapping of a filesystem-binding" - (let [container (-> (sut/create {:image-name "postgres:12.2" + (let [container (-> (sut/create {:image-name "postgres:12.2" :exposed-ports [5432] - :env-vars {"POSTGRES_PASSWORD" "pw"}}) - (sut/bind-filesystem! {:host-path "." - :container-path "/opt" - :mode :read-only})) + :env-vars {"POSTGRES_PASSWORD" "pw"}}) + (sut/bind-filesystem! {:host-path "." + :container-path "/opt" + :mode :read-only})) initialized-container (sut/start! container) file-check (sut/execute-command! initialized-container ["tail" "/opt/README.md"]) stopped-container (sut/stop! container)] @@ -110,12 +153,12 @@ (is (nil? (:mapped-ports stopped-container))))) (testing "Copying a file from the host into the container" - (let [container (-> (sut/create {:image-name "postgres:12.2" + (let [container (-> (sut/create {:image-name "postgres:12.2" :exposed-ports [5432] - :env-vars {"POSTGRES_PASSWORD" "pw"}}) - (sut/copy-file-to-container! {:path "test.sql" - :container-path "/opt/test.sql" - :type :host-path})) + :env-vars {"POSTGRES_PASSWORD" "pw"}}) + (sut/copy-file-to-container! {:path "test.sql" + :container-path "/opt/test.sql" + :type :host-path})) initialized-container (sut/start! container) file-check (sut/execute-command! initialized-container ["tail" "/opt/test.sql"]) stopped-container (sut/stop! container)] @@ -128,12 +171,12 @@ (testing "Copying a file from the classpath into the container" - (let [container (-> (sut/create {:image-name "postgres:12.2" + (let [container (-> (sut/create {:image-name "postgres:12.2" :exposed-ports [5432] - :env-vars {"POSTGRES_PASSWORD" "pw"}}) - (sut/copy-file-to-container! {:path "test.sql" - :container-path "/opt/test.sql" - :type :classpath-resource})) + :env-vars {"POSTGRES_PASSWORD" "pw"}}) + (sut/copy-file-to-container! {:path "test.sql" + :container-path "/opt/test.sql" + :type :classpath-resource})) initialized-container (sut/start! container) file-check (sut/execute-command! initialized-container ["tail" "/opt/test.sql"]) stopped-container (sut/stop! container)] @@ -145,14 +188,14 @@ (is (nil? (:mapped-ports stopped-container))))) (testing "Copying a file from the host into a running container" - (let [container (sut/create {:image-name "postgres:12.2" + (let [container (sut/create {:image-name "postgres:12.2" :exposed-ports [5432] - :env-vars {"POSTGRES_PASSWORD" "pw"}}) + :env-vars {"POSTGRES_PASSWORD" "pw"}}) initialized-container (sut/start! container) _ (sut/copy-file-to-container! initialized-container - {:path "test.sql" + {:path "test.sql" :container-path "/opt/test.sql" - :type :host-path}) + :type :host-path}) file-check (sut/execute-command! initialized-container ["tail" "/opt/test.sql"]) stopped-container (sut/stop! container)] @@ -164,14 +207,14 @@ (is (nil? (:mapped-ports stopped-container))))) (testing "Copying a file from the classpath into a running container" - (let [container (sut/create {:image-name "postgres:12.2" + (let [container (sut/create {:image-name "postgres:12.2" :exposed-ports [5432] - :env-vars {"POSTGRES_PASSWORD" "pw"}}) + :env-vars {"POSTGRES_PASSWORD" "pw"}}) initialized-container (sut/start! container) _ (sut/copy-file-to-container! initialized-container - {:path "test.sql" + {:path "test.sql" :container-path "/opt/test.sql" - :type :classpath-resource}) + :type :classpath-resource}) file-check (sut/execute-command! initialized-container ["tail" "/opt/test.sql"]) stopped-container (sut/stop! container)] @@ -185,15 +228,15 @@ (deftest networking-test (testing "Putting two containers into the same network and check their communication" (let [network (sut/create-network) - server-container (sut/create {:image-name "alpine:3.5" - :network network + server-container (sut/create {:image-name "alpine:3.5" + :network network :network-aliases ["foo"] - :command ["/bin/sh" - "-c" - "while true ; do printf 'HTTP/1.1 200 OK\\n\\nyay' | nc -l -p 8080; done"]}) + :command ["/bin/sh" + "-c" + "while true ; do printf 'HTTP/1.1 200 OK\\n\\nyay' | nc -l -p 8080; done"]}) client-container (sut/create {:image-name "alpine:3.5" - :network network - :command ["top"]}) + :network network + :command ["top"]}) started-server (sut/start! server-container) started-client (sut/start! client-container) response (sut/execute-command! started-client ["wget", "-O", "-", "http://foo:8080"])