Add self-service parent-based group verification

This will allow a user to self-verify a group that is a subgroup of an
already verified group.

Author: tobias

src/clojars/routes/verify.clj

@@ -7,6 +7,22 @@
    [ring.util.response :refer [redirect]]
    [compojure.core :as compojure :refer [GET POST]]))
 
+(defn verify-via-parent
+  [db username params]
+  (let [request (merge {:username username}
+                       (select-keys params [:group]))]
+    (log/with-context (assoc request :tag :verify-group-via-parent-group)
+      (let [result (verification/verify-group-by-parent-group db request)]
+        (if-some [error (:error result)]
+          (log/info {:status :failed
+                     :error  error})
+          (do
+            (log/info {:status :succeeded})
+            (log/audit db {:tag     :group-verified-via-parent-group
+                           :message (format "group '%s' verified" (:group request))})))
+        (-> (redirect "/verify/group")
+            (assoc :flash (merge request result)))))))
+
 (defn verify-via-TXT
   [db username params]
   (let [request (merge {:username username}
@@ -18,13 +34,16 @@
                      :error  error})
           (do
             (log/info {:status :succeeded})
-            (log/audit db {:tag     :group-verified
+            (log/audit db {:tag     :group-verified-via-TXT
                            :message (format "group '%s' verified" (:group request))})))
         (-> (redirect "/verify/group")
             (assoc :flash (merge request result)))))))
 
 (defn routes [db]
   (compojure/routes
+      (POST "/verify/group/parent" {:keys [params]}
+         (auth/with-account
+           #(verify-via-parent db % params)))
    (POST "/verify/group/txt" {:keys [params]}
          (auth/with-account
            #(verify-via-TXT db % params)))

src/clojars/web/group_verification.clj

@@ -6,10 +6,13 @@
    [hiccup.form :refer [label submit-button text-field]]))
 
 (defn- flash-details
-  [{:keys [domain group txt-records]}]
+  [{:keys [domain group parent-group txt-records]}]
   [:div#details
    [:p "Group: " group]
-   [:p "Domain: " domain]
+   (when domain
+     [:p "Domain: " domain])
+   (when parent-group
+     [:p "Parent group: " parent-group])
    (when txt-records
      (list
       [:p "TXT records:"
@@ -53,6 +56,29 @@
                "an issue")
       " if you run in to any problems verifying your group name."])))
 
+(def ^:private parent-help
+  (list
+   [:p "A subgroup is based on a (potential) subdomain of another group. To
+  verify it, the parent group has to be verified."]
+   [:p "This will create the group if it doesn't already exist, and can also
+     be used to verify an existing group."]
+   [:p "For example, if you are trying to verify the subgroup "
+    [:code "com.example.ham"]
+    ", and you have already verified "
+    [:code "com.example"]
+    ", then you can use this verification option."]
+   [:p "If you haven't verified the parent group and don't need to, you can
+   verify the group using the TXT record method above, but note that the TXT
+   record will need to be on the corresponding subdomain."]
+   [:p "See "
+    (link-to "https://github.com/clojars/clojars-web/wiki/Verified-Group-Names"
+             "the wiki")
+    " for more details on verified group names."]
+   [:p "Please "
+    (link-to "https://github.com/clojars/administration/issues/new/choose"
+             "an issue")
+    " if you run in to any problems verifying your group name."]))
+
 (defn index
   [account flash-data]
   (html-doc
@@ -61,7 +87,7 @@
    [:div.col-xs-6
     [:h1 "Group Verification"]
     (format-flash flash-data)
-    [:div
+    [:div.via-txt
      [:h2 "Verification by TXT Record"]
      [:details.help
       [:summary "Help"]
@@ -75,4 +101,15 @@
               (text-field {:required    true
                            :placeholder "example.com"}
                           :domain)
+              (submit-button "Verify Group"))]
+    [:div.via-parent
+     [:h2 "Verification by Parent Group"]
+     [:details.help
+      [:summary "Help"]
+      parent-help]
+     (form-to [:post "/verify/group/parent"]
+              (label :group "Group name")
+              (text-field {:required    true
+                           :placeholder "com.example.ham"}
+                          :group)
               (submit-button "Verify Group"))]]))

test/clojars/integration/group_verification_test.clj

@@ -17,9 +17,10 @@
         (register-as "dantheman" "test@example.org" "password")
         (follow-redirect)
         (visit "/verify/group")
-        (fill-in "Group name" "com.example")
-        (fill-in "Domain with TXT record" "example.com")
-        (press "Verify Group")
+        (within [:div.via-txt]
+                (fill-in "Group name" "com.example")
+                (fill-in "Domain with TXT record" "example.com")
+                (press "Verify Group"))
         (follow-redirect)
         (within [:div.info]
                 (has (some-text? "The group 'com.example' has been verified"))))))
@@ -30,9 +31,43 @@
         (register-as "dantheman" "test@example.org" "password")
         (follow-redirect)
         (visit "/verify/group")
-        (fill-in "Group name" "com.example")
-        (fill-in "Domain with TXT record" "example.org")
-        (press "Verify Group")
+        (within [:div.via-txt]
+                (fill-in "Group name" "com.example")
+                (fill-in "Domain with TXT record" "example.org")
+                (press "Verify Group"))
         (follow-redirect)
         (within [:div.error]
                 (has (some-text? "Group and domain do not correspond with each other"))))))
+
+(deftest user-can-verify-sub-group
+  (help/with-TXT ["clojars dantheman"]
+    (-> (session (help/app))
+        (register-as "dantheman" "test@example.org" "password")
+        (follow-redirect)
+        (visit "/verify/group")
+        (within [:div.via-txt]
+         (fill-in "Group name" "com.example")
+         (fill-in "Domain with TXT record" "example.com")
+         (press "Verify Group"))
+        (follow-redirect)
+        (within [:div.info]
+                (has (some-text? "The group 'com.example' has been verified")))
+
+        (within [:div.via-parent]
+                (fill-in "Group name" "com.example.ham")
+                (press "Verify Group"))
+        (follow-redirect)
+        (within [:div.info]
+                (has (some-text? "The group 'com.example.ham' has been verified"))))))
+
+(deftest user-cannot-verify-subgroup-with-non-verified-parent
+  (-> (session (help/app))
+      (register-as "dantheman" "test@example.org" "password")
+      (follow-redirect)
+      (visit "/verify/group")
+      (within [:div.via-parent]
+              (fill-in "Group name" "com.example")
+              (press "Verify Group"))
+      (follow-redirect)
+      (within [:div.error]
+              (has (some-text? "The group is not a subgroup of a verified group")))))