♻️ Refactor forms

Mainly replace spec with schema with better
and more reusable validations

common/src/app/common/data.cljc

@@ -9,7 +9,7 @@
   data resources."
   (:refer-clojure :exclude [read-string hash-map merge name update-vals
                             parse-double group-by iteration concat mapcat
-                            parse-uuid max min])
+                            parse-uuid max min regexp?])
   #?(:cljs
      (:require-macros [app.common.data]))
 
@@ -641,6 +641,13 @@
 ;; Utilities
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defn regexp?
+  "Return `true` if `x` is a regexp pattern
+  instance."
+  [x]
+  #?(:cljs (cljs.core/regexp? x)
+     :clj (instance? java.util.regex.Pattern x)))
+
 (defn nilf
   "Returns a new function that if you pass nil as any argument will
   return nil"

common/src/app/common/schema.cljc

@@ -44,6 +44,14 @@
   [o]
   (m/schema? o))
 
+(defn properties
+  [s]
+  (m/properties s))
+
+(defn type-properties
+  [s]
+  (m/type-properties s))
+
 (defn lazy-schema?
   [s]
   (satisfies? ILazySchema s))
@@ -144,6 +152,8 @@
    (m/encode s val options transformer)))
 
 (defn decode
+  ([s val]
+   (m/decode s val default-options default-transformer))
   ([s val transformer]
    (m/decode s val default-options transformer))
   ([s val options transformer]
@@ -428,23 +438,33 @@
   [s]
   (if (string? s)
     (re-matches email-re s)
-    s))
+    nil))
+
+(defn email-string?
+  [s]
+  (and (string? s)
+       (re-seq email-re s)))
 
-;; FIXME: add proper email generator
 (define! ::email
-  {:type ::email
-   :pred (fn [s]
-           (and (string? s)
-                (< (count s) 250)
-                (re-seq email-re s)))
+  {:type :string
+   :pred email-string?
+   :property-pred
+   (fn [{:keys [max] :as props}]
+     (if (some? max)
+       (fn [value]
+         (<= (count value) max))
+       (constantly true)))
+
    :type-properties
    {:title "email"
     :description "string with valid email address"
-    :error/message "expected valid email"
-    :gen/gen (-> :string sg/generator)
+    :error/code "errors.invalid-email"
+    :gen/gen (sg/email)
     ::oapi/type "string"
     ::oapi/format "email"
-    ::oapi/decode parse-email}})
+    ::oapi/decode
+    (fn [v]
+      (or (parse-email v) v))}})
 
 (def non-empty-strings-xf
   (comp
@@ -452,6 +472,59 @@
    (remove str/empty?)
    (remove str/blank?)))
 
+;; NOTE: this is general purpose set spec and should be used over the other
+
+(define! ::set
+  {:type :set
+   :compile
+   (fn [{:keys [coerce kind max min] :as props} _ _]
+     (let [xform (if coerce
+                   (comp non-empty-strings-xf (map coerce))
+                   non-empty-strings-xf)
+           pred  (cond
+                   (fn? kind)  kind
+                   (nil? kind) any?
+                   :else       (validator kind))
+
+           pred (cond
+                  (and max min)
+                  (fn [value]
+                    (let [size (count value)]
+                      (and (set? value)
+                           (<= min size max)
+                           (every? pred value))))
+
+                  min
+                  (fn [value]
+                    (let [size (count value)]
+                      (and (set? value)
+                           (<= min size)
+                           (every? pred value))))
+
+                  max
+                  (fn [value]
+                    (let [size (count value)]
+                      (and (set? value)
+                           (<= size max)
+                           (every? pred value))))
+
+                  :else
+                  pred)]
+
+       {:pred pred
+        :type-properties
+        {:title "set"
+         :description "Set of Strings"
+         :error/message "should be a set of strings"
+         :gen/gen (-> kind sg/generator sg/set)
+         ::oapi/type "array"
+         ::oapi/format "set"
+         ::oapi/items {:type "string"}
+         ::oapi/unique-items true
+         ::oapi/decode (fn [v]
+                         (let [v (if (string? v) (str/split v #"[\s,]+") v)]
+                           (into #{} xform v)))}}))})
+
 (define! ::set-of-strings
   {:type ::set-of-strings
    :pred #(and (set? %) (every? string? %))
@@ -634,6 +707,8 @@
 (define! ::fn
   [:schema fn?])
 
+;; FIXME: deprecated, replace with ::text
+
 (define! ::word-string
   {:type ::word-string
    :pred #(and (string? %) (not (str/blank? %)))
@@ -649,16 +724,102 @@
 (define! ::uri
   {:type ::uri
    :pred u/uri?
+   :property-pred
+   (fn [{:keys [min max prefix] :as props}]
+     (if (seq props)
+       (fn [value]
+         (let [value  (str value)
+               size   (count value)]
+
+           (and
+            (cond
+              (and min max)
+              (<= min size max)
+
+              min
+              (<= min size)
+
+              max
+              (<= size max))
+
+            (cond
+              (d/regexp? prefix)
+              (some? (re-seq prefix value))
+
+              :else
+              true))))
+
+       (constantly true)))
+
    :type-properties
    {:title "uri"
     :description "URI formatted string"
-    :error/message "expected URI instance"
+    :error/code "errors.invalid-uri"
     :gen/gen (sg/uri)
     ::oapi/type "string"
     ::oapi/format "uri"
     ::oapi/decode (comp u/uri str/trim)}})
 
-(def! ::plugin-data
+(define! ::text
+  {:type :string
+   :pred #(and (string? %) (not (str/blank? %)))
+   :property-pred
+   (fn [{:keys [min max] :as props}]
+     (if (seq props)
+       (fn [value]
+         (let [size (count value)]
+           (cond
+             (and min max)
+             (<= min size max)
+
+             min
+             (<= min size)
+
+             max
+             (<= size max))))
+       (constantly true)))
+
+   :type-properties
+   {:title "string"
+    :description "not whitespace string"
+    :gen/gen (sg/word-string)
+    :error/code "errors.invalid-text"
+    :error/fn
+    (fn [{:keys [value schema]}]
+      (let [{:keys [max min] :as props} (properties schema)]
+        (cond
+          (and (string? value)
+               (number? max)
+               (> (count value) max))
+          ["errors.field-max-length" max]
+
+          (and (string? value)
+               (number? min)
+               (< (count value) min))
+          ["errors.field-min-length" min]
+
+          (and (string? value)
+               (str/blank? value))
+          "errors.field-not-all-whitespace")))}})
+
+(define! ::password
+  {:type :string
+   :pred
+   (fn [value]
+     (and (string? value)
+          (>= (count value) 8)
+          (not (str/blank? value))))
+   :type-properties
+   {:title "password"
+    :gen/gen (->> (sg/word-string)
+                  (sg/filter #(>= (count %) 8)))
+    :error/code "errors.password-too-short"
+    ::oapi/type "string"
+    ::oapi/format "password"}})
+
+
+;; FIXME: this should not be here
+(define! ::plugin-data
   [:map-of {:gen/max 5} :string :string])
 
 ;; ---- PREDICATES

common/src/app/common/schema/generators.cljc

@@ -77,10 +77,23 @@
 
 (defn word-string
   []
-  (->> (tg/such-that #(re-matches #"\w+" %)
-                     tg/string-alphanumeric
-                     50)
-       (tg/such-that (complement str/blank?))))
+  (as-> tg/string-alphanumeric $$
+    (tg/such-that (fn [v] (re-matches #"\w+" v)) $$ 50)
+    (tg/such-that (fn [v]
+                    (and (not (str/blank? v))
+                         (not (re-matches #"^\d+.*" v))))
+                  $$
+                  50)))
+
+
+(defn email
+  []
+  (->> (word-string)
+       (tg/such-that (fn [v] (>= (count v) 4)))
+       (tg/fmap str/lower)
+       (tg/fmap (fn [v]
+                  (str v "@example.net")))))
+
 
 (defn uri
   []