receiver, verifier, retriever, storage: URL normalization

utils: add url utilities for accurate comparison

- add url/normalize taht reconstructs URL, strips unnecessary
components, reorders query string and ensures determinism
- add url/url= that uses url/normalize

receiver: normalize URLs before checking and putting in queue

- use url= and normalize from utils.url
- rename verify-request to check-request to avoid confusion with
verifier.clj

verifier: check if source includes target URL more accurately

- implement url/extract with robinst/autolink-java, which extracts a
vector a URLs from string
- check if source includes target by
  1. extracting all links from source body
  2. normalizing all links before comparing with target link (with url=
func)
- refactor verify-headers -> match-content-types, with a higher order
function and clearer description

retriever, storage: use url= instead of = when comparing urls

3 files changed, 68 insertions, 37 deletions

diff --git a/test/weepinbell/receiver_test.clj b/test/weepinbell/receiver_test.clj
index a0524dc..827c078 100644
--- a/test/weepinbell/receiver_test.clj
+++ b/test/weepinbell/receiver_test.clj
@@ -13,7 +13,7 @@
 
 (ns weepinbell.receiver-test
   (:require [clojure.test :refer [deftest testing is]]
-            [clojure.core.async :refer [chan poll! <!!]]
+            [clojure.core.async :refer [chan poll!]]
             [weepinbell.receiver :refer [receive]]))
 
 ;; utilities
@@ -40,6 +40,9 @@
                   ["https://bob.blog/post/123" "ftp://alice.blog/file/x" (wrap-400-msg :invalid-url)]
                   ;; identical URLs 
                   ["https://alice.blog/article/abc" "https://alice.blog/article/abc" (wrap-400-msg :identical)]
+                  ["https://alice.blog/article/abc/" "https://alice.blog/article/abc" (wrap-400-msg :identical)]
+                  ["https://alice.blog/article/abc#anchor" "https://alice.blog/article/abc" (wrap-400-msg :identical)]
+                  ["https://alice.blog/article/abc?a=1&b=2" "https://alice.blog/article/abc?b=2&a=1" (wrap-400-msg :identical)]
                   ;; domain not allowed 
                   ["https://bob.blog/post/123" "https://chris.blog/archive/xxx" (wrap-400-msg :domain-not-allowed)]])
 ;; end define test cases
@@ -98,39 +101,3 @@
          doall)))
 ;; end in-queue test
 
-;; anchor removing test
-(deftest anchor-remove-test
-  (testing "Receiver should remove anchor in URL before pushing it into queue"
-    (let [cases [{:has    ["https://bob.blog/page/1#heading-a"
-                           "https://alice.blog/"]
-                  :expects ["https://bob.blog/page/1"
-                            "https://alice.blog/"]}
-                 {:has    ["https://bob.blog/page/1"
-                           "https://alice.blog/archive/a#heading-1"]
-                  :expects ["https://bob.blog/page/1"
-                            "https://alice.blog/archive/a"]}
-                 {:has    ["https://bob.blog/page/1#heading-a"
-                           "https://alice.blog/archive/a#heading-1"]
-                  :expects ["https://bob.blog/page/1"
-                            "https://alice.blog/archive/a"]}
-                 {:has    ["https://bob.blog/page/1"
-                           "https://alice.blog/archive/a"]
-                  :expects ["https://bob.blog/page/1"
-                            "https://alice.blog/archive/a"]}
-                 {:has    ["https://bob.blog/?page=1&key=value#heading-1"
-                           "https://alice.blog/archive/a"]
-                  :expects ["https://bob.blog/?page=1&key=value"
-                            "https://alice.blog/archive/a"]}]]
-      (->> cases
-           (map (fn [case]
-                  (let [hs (get-in case [:has 0])
-                        ht (get-in case [:has 1])
-                        es (get-in case [:expects 0])
-                        et (get-in case [:expects 1])
-                        wm {:s hs :t ht}
-                        test-queue (chan)]
-                    (receive wm test-queue {:allowed-target-domains ["alice.blog"]})
-                    (let [{:keys [s t]} (<!! test-queue)]
-                      (is (= s es))
-                      (is (= t et))))))
-           doall))))
diff --git a/test/weepinbell/utils_url_test.clj b/test/weepinbell/utils_url_test.clj
new file mode 100644
index 0000000..732ba1c
--- /dev/null
+++ b/test/weepinbell/utils_url_test.clj
@@ -0,0 +1,56 @@
+(ns weepinbell.utils-url-test
+  (:require [weepinbell.utils.url :as url]
+            [clojure.test :refer [deftest testing is]]))
+
+(deftest valid-http-url-test
+  (testing "valid url, return true"
+    (is (url/valid-http-url? "https://example.com/page/abc?param1=a&param2=b#anchor"))
+    (is (url/valid-http-url? "http://www.example.com/")))
+  (testing "url not a string, returns false"
+    (is (not (url/valid-http-url? 1)))
+    (is (not (url/valid-http-url? [])))
+    (is (not (url/valid-http-url? {})))
+    (is (not (url/valid-http-url? '())))
+    (is (not (url/valid-http-url? :not-url)))
+    (is (not (url/valid-http-url? true))))
+  (testing "malformed url, return false"
+    (is (not (url/valid-http-url? "123")))
+    (is (not (url/valid-http-url? "example.com")))
+    (is (not (url/valid-http-url? "http//example.com")))
+    (is (not (url/valid-http-url? "http:example.com"))))
+  (testing "not the right scheme, return false"
+    (is (not (url/valid-http-url? "ftp://example.com"))))
+  (testing "localhost, return false"
+    (is (not (url/valid-http-url? "http://localhost")))))
+
+(deftest getter-tests
+  (testing "getting domain"
+    (is (= "www.example.com" (url/get-domain "https://www.example.com/index.php?page=abc")))
+    (is (= "example.com" (url/get-domain "https://example.com/page/abc#anchor"))))
+  (testing "getting path"
+    (is (= "/index.php" (url/get-path "https://www.example.com/index.php?page=abc")))
+    (is (= "/page/abc" (url/get-path "https://example.com/page/abc#anchor"))))
+  (testing "getting target"
+    (is (= "https://www.example.com" (url/get-target {:webmention {:target "https://www.example.com"}}))))) 
+
+(deftest url-equal-test 
+  (testing "URL equality"
+    (is (url/url= "https://example.com/./abc" "https://example.com/abc"))
+    (is (url/url= "https://example.com/page/../abc" "https://example.com/abc"))
+    (is (url/url= "https://example.com/page/abc" "https://example.com/page/abc/"))
+    (is (url/url= "https://example.com/page#heading-1" "https://example.com/page/"))
+    (is (url/url= "https://example.com/p?b=123&a=321" "https://example.com/p/?a=321&b=123"))
+    (is (url/url= "https://example.com/p?b=123&a=321" "https://example.com/p/?a=321&b=123"))))
+
+(defn- has-same-elements? [& colls]
+  (apply = (map set colls)))
+(deftest url-extract-test 
+  (testing "Extracting URLs from string"
+    (is (has-same-elements? 
+          ["https://test.com" "https://example.com"]
+          (url/extract "two links: https://test.com and https://example.com")))
+    (is (has-same-elements? 
+          ["http://www.example.com/index.php?page=123#anchor"]
+          (url/extract "complicated one (http://www.example.com/index.php?page=123#anchor)")))))
+
+
diff --git a/test/weepinbell/verifier_test.clj b/test/weepinbell/verifier_test.clj
index 5780abd..313a4e9 100644
--- a/test/weepinbell/verifier_test.clj
+++ b/test/weepinbell/verifier_test.clj
@@ -83,6 +83,14 @@
                            "/target" {:status 200}]
       (is (not (test-verify "http://localhost:38888/source"
                             "http://localhost:38888/target")))))
+  (testing "unsupported content type"
+    (with-webmention :new ["/source" {:status 200
+                                      :headers {"Content-Type" "application/json"}
+                                      :body "{\"message\": \"I mentioned alice's other post\n https://alice.blog/article/efg\"}"}
+                           "/target" {:status 200
+                                      :headers {"Content-Type" "text/plain"}}]
+      (is (not (test-verify "http://localhost:38888/source"
+                            "http://localhost:38888/target")))))
   (testing "responses have no status"
     (with-webmention :new ["/source" {:status nil
                                       :headers {"Content-Type" "text/plain"}