Skip to content

Commit

Permalink
more robust tests for hsts
Browse files Browse the repository at this point in the history
  • Loading branch information
@d-t-w
d-t-w committed Dec 9, 2024
1 parent f0a6db7 commit 91da31d
Showing 1 changed file with 52 additions and 60 deletions.
112 changes: 52 additions & 60 deletions common/test/slipway/https_server_test.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -257,39 +257,24 @@

(deftest strict-transport-security

(testing "hsts not configured"
(testing "no hsts configuration"

(try
(example/start! [:https])

(is (= {:protocol-version {:name "HTTP" :major 1 :minor 1}
:status 200
:reason-phrase "OK"
:orig-content-encoding "gzip"
:headers {"Connection" "close"
"Content-Type" "text/html"
"Vary" "Accept-Encoding, User-Agent"}
:body (html/user-page {})}
(-> (client/do-get "https://localhost:3443/user" {:insecure? true})
(select-keys (conj of-interest :headers)))))
(let [result (-> (client/do-get "https://localhost:3443/user" {:insecure? true})
(select-keys (conj of-interest :headers)))
sts-header (get-in result [:headers "Strict-Transport-Security"])
result (dissoc result :headers)]

(finally (example/stop!))))
(is (= {:protocol-version {:name "HTTP" :major 1 :minor 1}
:status 200
:reason-phrase "OK"
:orig-content-encoding "gzip"
:body (html/user-page {})}
result))

(testing "no hsts configuration"

(try
(example/start! [:https])

(is (= {:protocol-version {:name "HTTP" :major 1 :minor 1}
:status 200
:reason-phrase "OK"
:orig-content-encoding "gzip"
:headers {"Connection" "close"
"Content-Type" "text/html"
"Vary" "Accept-Encoding, User-Agent"}
:body (html/user-page {})}
(-> (client/do-get "https://localhost:3443/user" {:insecure? true})
(select-keys (conj of-interest :headers)))))
(is (= nil sts-header)))

(finally (example/stop!))))

Expand All @@ -298,36 +283,40 @@
(try
(example/start! [:hsts])

(is (= {:protocol-version {:name "HTTP" :major 1 :minor 1}
:status 200
:reason-phrase "OK"
:orig-content-encoding "gzip"
:headers {"Connection" "close"
"Content-Type" "text/html"
"Strict-Transport-Security" "max-age=31536000; includeSubDomains"
"Vary" "Accept-Encoding, User-Agent"}
:body (html/user-page {})}
(-> (client/do-get "https://localhost:3443/user" {:insecure? true})
(select-keys (conj of-interest :headers)))))
(let [result (-> (client/do-get "https://localhost:3443/user" {:insecure? true})
(select-keys (conj of-interest :headers)))
sts-header (get-in result [:headers "Strict-Transport-Security"])
result (dissoc result :headers)]

(is (= {:protocol-version {:name "HTTP" :major 1 :minor 1}
:status 200
:reason-phrase "OK"
:orig-content-encoding "gzip"
:body (html/user-page {})}
result))

(is (= "max-age=31536000; includeSubDomains" sts-header)))

(finally (example/stop!))))

(testing "sts-include without subdomains"
(testing "sts-max-age without subdomains"

(try
(example/start! [:hsts-no-subdomains])

(is (= {:protocol-version {:name "HTTP" :major 1 :minor 1}
:status 200
:reason-phrase "OK"
:orig-content-encoding "gzip"
:headers {"Connection" "close"
"Content-Type" "text/html"
"Strict-Transport-Security" "max-age=31536000"
"Vary" "Accept-Encoding, User-Agent"}
:body (html/user-page {})}
(-> (client/do-get "https://localhost:3443/user" {:insecure? true})
(select-keys (conj of-interest :headers)))))
(let [result (-> (client/do-get "https://localhost:3443/user" {:insecure? true})
(select-keys (conj of-interest :headers)))
sts-header (get-in result [:headers "Strict-Transport-Security"])
result (dissoc result :headers)]

(is (= {:protocol-version {:name "HTTP" :major 1 :minor 1}
:status 200
:reason-phrase "OK"
:orig-content-encoding "gzip"
:body (html/user-page {})}
result))

(is (= "max-age=31536000" sts-header)))

(finally (example/stop!))))

Expand All @@ -336,15 +325,18 @@
(try
(example/start! [:hsts-no-max-age])

(is (= {:protocol-version {:name "HTTP" :major 1 :minor 1}
:status 200
:reason-phrase "OK"
:orig-content-encoding "gzip"
:headers {"Connection" "close"
"Content-Type" "text/html"
"Vary" "Accept-Encoding, User-Agent"}
:body (html/user-page {})}
(-> (client/do-get "https://localhost:3443/user" {:insecure? true})
(select-keys (conj of-interest :headers)))))
(let [result (-> (client/do-get "https://localhost:3443/user" {:insecure? true})
(select-keys (conj of-interest :headers)))
sts-header (get-in result [:headers "Strict-Transport-Security"])
result (dissoc result :headers)]

(is (= {:protocol-version {:name "HTTP" :major 1 :minor 1}
:status 200
:reason-phrase "OK"
:orig-content-encoding "gzip"
:body (html/user-page {})}
result))

(is (= nil sts-header)))

(finally (example/stop!)))))

0 comments on commit 91da31d

Please sign in to comment.