From c5e0fe804500d00743376bc4d914d80a91013b87 Mon Sep 17 00:00:00 2001 From: Keith Philpott Date: Tue, 11 Feb 2020 15:19:06 -0800 Subject: [PATCH] moved notice --- .circleci/config.yml | 44 -- .gitignore | 5 - LICENSE | 277 ----------- README.md | 3 + project.clj | 19 - src/validaze/core.clj | 904 ----------------------------------- src/validaze/refinements.clj | 8 - test/validaze/core_test.clj | 100 ---- 8 files changed, 3 insertions(+), 1357 deletions(-) delete mode 100644 .circleci/config.yml delete mode 100644 .gitignore delete mode 100644 LICENSE create mode 100644 README.md delete mode 100644 project.clj delete mode 100644 src/validaze/core.clj delete mode 100644 src/validaze/refinements.clj delete mode 100644 test/validaze/core_test.clj diff --git a/.circleci/config.yml b/.circleci/config.yml deleted file mode 100644 index 6272d6a..0000000 --- a/.circleci/config.yml +++ /dev/null @@ -1,44 +0,0 @@ -# Clojure CircleCI 2.0 configuration file -# -# Check https://circleci.com/docs/2.0/language-clojure/ for more details -# -version: 2 -jobs: - build: - docker: - # specify the version you desire here - - image: circleci/clojure:lein-2.8.1 - - # Specify service dependencies here if necessary - # CircleCI maintains a library of pre-built images - # documented at https://circleci.com/docs/2.0/circleci-images/ - # - image: circleci/postgres:9.4 - - working_directory: ~/repo - - environment: - LEIN_ROOT: "true" - # Customize the JVM maximum heap limit - JVM_OPTS: -Xmx3200m - - steps: - - checkout - - # Download and cache dependencies - - restore_cache: - keys: - - v1-dependencies-{{ checksum "project.clj" }} - # fallback to using the latest cache if no exact match is found - - v1-dependencies- - - - run: lein deps - - - save_cache: - paths: - - ~/.m2 - key: v1-dependencies-{{ checksum "project.clj" }} - - # run tests! - - run: - command: lein eftest - no_output_timeout: "45m" diff --git a/.gitignore b/.gitignore deleted file mode 100644 index 4a55a03..0000000 --- a/.gitignore +++ /dev/null @@ -1,5 +0,0 @@ -.DS_Store -.nrepl-port -pom.xml -pom.xml.asc -target/ diff --git a/LICENSE b/LICENSE deleted file mode 100644 index d3087e4..0000000 --- a/LICENSE +++ /dev/null @@ -1,277 +0,0 @@ -Eclipse Public License - v 2.0 - - THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE - PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION - OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. - -1. DEFINITIONS - -"Contribution" means: - - a) in the case of the initial Contributor, the initial content - Distributed under this Agreement, and - - b) in the case of each subsequent Contributor: - i) changes to the Program, and - ii) additions to the Program; - where such changes and/or additions to the Program originate from - and are Distributed by that particular Contributor. A Contribution - "originates" from a Contributor if it was added to the Program by - such Contributor itself or anyone acting on such Contributor's behalf. - Contributions do not include changes or additions to the Program that - are not Modified Works. - -"Contributor" means any person or entity that Distributes the Program. - -"Licensed Patents" mean patent claims licensable by a Contributor which -are necessarily infringed by the use or sale of its Contribution alone -or when combined with the Program. - -"Program" means the Contributions Distributed in accordance with this -Agreement. - -"Recipient" means anyone who receives the Program under this Agreement -or any Secondary License (as applicable), including Contributors. - -"Derivative Works" shall mean any work, whether in Source Code or other -form, that is based on (or derived from) the Program and for which the -editorial revisions, annotations, elaborations, or other modifications -represent, as a whole, an original work of authorship. - -"Modified Works" shall mean any work in Source Code or other form that -results from an addition to, deletion from, or modification of the -contents of the Program, including, for purposes of clarity any new file -in Source Code form that contains any contents of the Program. Modified -Works shall not include works that contain only declarations, -interfaces, types, classes, structures, or files of the Program solely -in each case in order to link to, bind by name, or subclass the Program -or Modified Works thereof. - -"Distribute" means the acts of a) distributing or b) making available -in any manner that enables the transfer of a copy. - -"Source Code" means the form of a Program preferred for making -modifications, including but not limited to software source code, -documentation source, and configuration files. - -"Secondary License" means either the GNU General Public License, -Version 2.0, or any later versions of that license, including any -exceptions or additional permissions as identified by the initial -Contributor. - -2. GRANT OF RIGHTS - - a) Subject to the terms of this Agreement, each Contributor hereby - grants Recipient a non-exclusive, worldwide, royalty-free copyright - license to reproduce, prepare Derivative Works of, publicly display, - publicly perform, Distribute and sublicense the Contribution of such - Contributor, if any, and such Derivative Works. - - b) Subject to the terms of this Agreement, each Contributor hereby - grants Recipient a non-exclusive, worldwide, royalty-free patent - license under Licensed Patents to make, use, sell, offer to sell, - import and otherwise transfer the Contribution of such Contributor, - if any, in Source Code or other form. This patent license shall - apply to the combination of the Contribution and the Program if, at - the time the Contribution is added by the Contributor, such addition - of the Contribution causes such combination to be covered by the - Licensed Patents. The patent license shall not apply to any other - combinations which include the Contribution. No hardware per se is - licensed hereunder. - - c) Recipient understands that although each Contributor grants the - licenses to its Contributions set forth herein, no assurances are - provided by any Contributor that the Program does not infringe the - patent or other intellectual property rights of any other entity. - Each Contributor disclaims any liability to Recipient for claims - brought by any other entity based on infringement of intellectual - property rights or otherwise. As a condition to exercising the - rights and licenses granted hereunder, each Recipient hereby - assumes sole responsibility to secure any other intellectual - property rights needed, if any. For example, if a third party - patent license is required to allow Recipient to Distribute the - Program, it is Recipient's responsibility to acquire that license - before distributing the Program. - - d) Each Contributor represents that to its knowledge it has - sufficient copyright rights in its Contribution, if any, to grant - the copyright license set forth in this Agreement. - - e) Notwithstanding the terms of any Secondary License, no - Contributor makes additional grants to any Recipient (other than - those set forth in this Agreement) as a result of such Recipient's - receipt of the Program under the terms of a Secondary License - (if permitted under the terms of Section 3). - -3. REQUIREMENTS - -3.1 If a Contributor Distributes the Program in any form, then: - - a) the Program must also be made available as Source Code, in - accordance with section 3.2, and the Contributor must accompany - the Program with a statement that the Source Code for the Program - is available under this Agreement, and informs Recipients how to - obtain it in a reasonable manner on or through a medium customarily - used for software exchange; and - - b) the Contributor may Distribute the Program under a license - different than this Agreement, provided that such license: - i) effectively disclaims on behalf of all other Contributors all - warranties and conditions, express and implied, including - warranties or conditions of title and non-infringement, and - implied warranties or conditions of merchantability and fitness - for a particular purpose; - - ii) effectively excludes on behalf of all other Contributors all - liability for damages, including direct, indirect, special, - incidental and consequential damages, such as lost profits; - - iii) does not attempt to limit or alter the recipients' rights - in the Source Code under section 3.2; and - - iv) requires any subsequent distribution of the Program by any - party to be under a license that satisfies the requirements - of this section 3. - -3.2 When the Program is Distributed as Source Code: - - a) it must be made available under this Agreement, or if the - Program (i) is combined with other material in a separate file or - files made available under a Secondary License, and (ii) the initial - Contributor attached to the Source Code the notice described in - Exhibit A of this Agreement, then the Program may be made available - under the terms of such Secondary Licenses, and - - b) a copy of this Agreement must be included with each copy of - the Program. - -3.3 Contributors may not remove or alter any copyright, patent, -trademark, attribution notices, disclaimers of warranty, or limitations -of liability ("notices") contained within the Program from any copy of -the Program which they Distribute, provided that Contributors may add -their own appropriate notices. - -4. COMMERCIAL DISTRIBUTION - -Commercial distributors of software may accept certain responsibilities -with respect to end users, business partners and the like. While this -license is intended to facilitate the commercial use of the Program, -the Contributor who includes the Program in a commercial product -offering should do so in a manner which does not create potential -liability for other Contributors. Therefore, if a Contributor includes -the Program in a commercial product offering, such Contributor -("Commercial Contributor") hereby agrees to defend and indemnify every -other Contributor ("Indemnified Contributor") against any losses, -damages and costs (collectively "Losses") arising from claims, lawsuits -and other legal actions brought by a third party against the Indemnified -Contributor to the extent caused by the acts or omissions of such -Commercial Contributor in connection with its distribution of the Program -in a commercial product offering. The obligations in this section do not -apply to any claims or Losses relating to any actual or alleged -intellectual property infringement. In order to qualify, an Indemnified -Contributor must: a) promptly notify the Commercial Contributor in -writing of such claim, and b) allow the Commercial Contributor to control, -and cooperate with the Commercial Contributor in, the defense and any -related settlement negotiations. The Indemnified Contributor may -participate in any such claim at its own expense. - -For example, a Contributor might include the Program in a commercial -product offering, Product X. That Contributor is then a Commercial -Contributor. If that Commercial Contributor then makes performance -claims, or offers warranties related to Product X, those performance -claims and warranties are such Commercial Contributor's responsibility -alone. Under this section, the Commercial Contributor would have to -defend claims against the other Contributors related to those performance -claims and warranties, and if a court requires any other Contributor to -pay any damages as a result, the Commercial Contributor must pay -those damages. - -5. NO WARRANTY - -EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT -PERMITTED BY APPLICABLE LAW, THE PROGRAM IS PROVIDED ON AN "AS IS" -BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR -IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF -TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR -PURPOSE. Each Recipient is solely responsible for determining the -appropriateness of using and distributing the Program and assumes all -risks associated with its exercise of rights under this Agreement, -including but not limited to the risks and costs of program errors, -compliance with applicable laws, damage to or loss of data, programs -or equipment, and unavailability or interruption of operations. - -6. DISCLAIMER OF LIABILITY - -EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT -PERMITTED BY APPLICABLE LAW, NEITHER RECIPIENT NOR ANY CONTRIBUTORS -SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, -EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST -PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE -EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGES. - -7. GENERAL - -If any provision of this Agreement is invalid or unenforceable under -applicable law, it shall not affect the validity or enforceability of -the remainder of the terms of this Agreement, and without further -action by the parties hereto, such provision shall be reformed to the -minimum extent necessary to make such provision valid and enforceable. - -If Recipient institutes patent litigation against any entity -(including a cross-claim or counterclaim in a lawsuit) alleging that the -Program itself (excluding combinations of the Program with other software -or hardware) infringes such Recipient's patent(s), then such Recipient's -rights granted under Section 2(b) shall terminate as of the date such -litigation is filed. - -All Recipient's rights under this Agreement shall terminate if it -fails to comply with any of the material terms or conditions of this -Agreement and does not cure such failure in a reasonable period of -time after becoming aware of such noncompliance. If all Recipient's -rights under this Agreement terminate, Recipient agrees to cease use -and distribution of the Program as soon as reasonably practicable. -However, Recipient's obligations under this Agreement and any licenses -granted by Recipient relating to the Program shall continue and survive. - -Everyone is permitted to copy and distribute copies of this Agreement, -but in order to avoid inconsistency the Agreement is copyrighted and -may only be modified in the following manner. The Agreement Steward -reserves the right to publish new versions (including revisions) of -this Agreement from time to time. No one other than the Agreement -Steward has the right to modify this Agreement. The Eclipse Foundation -is the initial Agreement Steward. The Eclipse Foundation may assign the -responsibility to serve as the Agreement Steward to a suitable separate -entity. Each new version of the Agreement will be given a distinguishing -version number. The Program (including Contributions) may always be -Distributed subject to the version of the Agreement under which it was -received. In addition, after a new version of the Agreement is published, -Contributor may elect to Distribute the Program (including its -Contributions) under the new version. - -Except as expressly stated in Sections 2(a) and 2(b) above, Recipient -receives no rights or licenses to the intellectual property of any -Contributor under this Agreement, whether expressly, by implication, -estoppel or otherwise. All rights in the Program not expressly granted -under this Agreement are reserved. Nothing in this Agreement is intended -to be enforceable by any entity that is not a Contributor or Recipient. -No third-party beneficiary rights are created under this Agreement. - -Exhibit A - Form of Secondary Licenses Notice - -"This Source Code may also be made available under the following -Secondary Licenses when the conditions for such availability set forth -in the Eclipse Public License, v. 2.0 are satisfied: {name license(s), -version(s), and exceptions or additional permissions here}." - - Simply including a copy of this Agreement, including this Exhibit A - is not sufficient to license the Source Code under Secondary Licenses. - - If it is not possible or desirable to put the notice in a particular - file, then You may include the notice in a location (such as a LICENSE - file in a relevant directory) where a recipient would be likely to - look for such a notice. - - You may add additional accurate notices of copyright ownership. diff --git a/README.md b/README.md new file mode 100644 index 0000000..b069bf6 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# MOVED + +To monolith. This repository will no longer receive updates. diff --git a/project.clj b/project.clj deleted file mode 100644 index 5c29b49..0000000 --- a/project.clj +++ /dev/null @@ -1,19 +0,0 @@ -(defproject yummly/validaze "1.4.1" - :description - "Hiccup-inspired DSL implementation of refinement types for validating JSON data." - :license {:name "Eclipse Public License" - :url "http://www.eclipse.org/legal/epl-v10.html"} - :dependencies [[org.clojure/clojure "1.9.0"] - [com.gfredericks/test.chuck "0.2.8"] - [clj-time "0.14.2"] - [com.rpl/specter "1.0.4"] - [org.clojure/data.codec "0.1.0"] - [org.clojure/core.match "0.3.0-alpha5"] - [mvxcvi/arrangement "1.1.1"] - ;; require 0.10.0 to fix a bug around monkey patching with clojure.test - [org.clojure/test.check "0.10.0-alpha2"]] - :exact-lein-version "2.8.1" - :main ^:skip-aot validaze.core - :target-path "target/%s" - :eftest {:test-warn-time 5000} - :profiles {:dev {:plugins [[lein-eftest "0.4.1"]]}}) diff --git a/src/validaze/core.clj b/src/validaze/core.clj deleted file mode 100644 index 94c4b90..0000000 --- a/src/validaze/core.clj +++ /dev/null @@ -1,904 +0,0 @@ -(ns validaze.core - (:require - [clojure.spec.alpha :as s] - [clojure.spec.test.alpha :as stest] - [clojure.test.check.generators :as gen] - [clojure.test.check.properties :as prop] - [clojure.test.check :as tc] - [com.rpl.specter :as specter] - [com.gfredericks.test.chuck.generators :as gen'] - [clojure.core.match :refer [match]] - [arrangement.core :as order] - [validaze.refinements :as refinements])) - -(s/def ::nonempty-string - (s/and string? seq)) - -(def ^:private base-refinements - {:string string? - :object map? - :number number? - :integer integer? - :boolean boolean?}) - -(def ^:dynamic primitive-type-to-gen nil) -(s/def ::nonnilable-json-primitive - (s/with-gen - (s/or :b boolean? :n number? :s string?) - #(let [selected (select-keys base-refinements [:boolean :number :string])] - ((merge {nil (gen/one-of (map (fn [p] (s/gen p)) (vals selected)))} - (specter/transform [specter/MAP-VALS] s/gen selected)) - primitive-type-to-gen)))) - -(def value-level-value-spec (s/or :primitive ::json-primitive :seq sequential? :map map?)) -(s/def ::value-level-value - (s/with-gen - value-level-value-spec - #(if (not (nil? primitive-type-to-gen)) - (s/gen ::nonnilable-json-primitive) - (s/gen value-level-value-spec)))) - -(s/def ::json-primitive - (s/nilable ::nonnilable-json-primitive)) - -(s/def ::json-map - (s/with-gen - (let [checker (fn inner [primitives? v] - (cond - (map? v) (and (every? string? (keys v)) (every? (partial inner true) (vals v))) - (coll? v) (every? (partial inner true) v) - primitives? (s/valid? ::json-primitive v) - :else false))] - (partial checker false)) - #(gen/recursive-gen (fn [inner] (gen/map gen/string inner)) - (s/gen ::json-primitive)))) - -(defn- printable-fn [f to-string] - (reify clojure.lang.IFn - (toString [this] (to-string)) - (invoke [this a] (f a)) - (applyTo [this a] (apply f a)))) - -(defn- printable-const-fn [constant] - (printable-fn - (fn [_] constant) - #(format "(fn [_] %s)" (if (string? constant) (format "\"%s\"" constant) constant)))) - -(def validation-fn-gen - #(gen/frequency [[8 (gen/return (with-meta (printable-const-fn true) {:validates? true}))] - [1 (gen/return (with-meta (printable-const-fn false) {:validates? false}))]])) - -(s/def ::value-level-validation-fn - (s/with-gen - (s/fspec :args (s/cat :v ::value-level-value) - :ret boolean?) - validation-fn-gen)) - -(s/def ::validation-fn - (s/with-gen - (s/or :func (s/fspec :args (s/cat :x ::json-map) - :ret boolean?) - :set set? - :spec s/spec?) - validation-fn-gen)) - -(def message-fn-gen - #(gen/let [msg gen/string] (with-meta (printable-const-fn msg) {:msg msg}))) - -(s/def ::primitive-message-fn - (s/with-gen - (s/fspec :args (s/cat :x ::json-primitive) :ret string?) - message-fn-gen)) - -(s/def ::message-fn - (s/with-gen - (s/fspec :args (s/cat :x ::json-primitive) - :ret string?) - message-fn-gen)) - -(s/def ::validation-result - (s/nilable string?)) - -(s/fdef validate-to-msg - :args (s/cat :validation-fn ::value-level-validation-fn :message-fn ::primitive-message-fn - :value ::json-primitive) - :ret ::validation-result) -(defn- validate-to-msg [validation-fn message-fn value] - (if-not (s/valid? validation-fn value) - (message-fn value))) - -(defn validator-generator [v-fn-gen m-fn-gen] - #(gen/let [v-fn (s/gen v-fn-gen) - validates? (gen/return (:validates? (meta v-fn))) - msg-fn (s/gen m-fn-gen)] - (printable-fn - (partial validate-to-msg v-fn msg-fn) - (fn [] (if validates? "(fn [_] nil)" (str msg-fn)))))) - -(s/def ::validator - (s/with-gen - (s/fspec :args (s/cat :v ::json-map) - :ret ::validation-result) - (validator-generator ::validation-fn ::message-fn))) - -(s/def ::primitive-validator - (s/with-gen - (s/fspec :args (s/cat :v ::json-primitive) - :ret ::validation-result) - (validator-generator ::value-level-validation-fn ::primitive-message-fn))) - -(defn- into-recursively-sorted-map [m] - (specter/transform - [(specter/recursive-path - [] p (specter/cond-path - map? (specter/continue-then-stay specter/MAP-VALS p) - coll? (specter/continue-then-stay specter/ALL p)))] - #(cond - (map? %1) (into (sorted-map-by order/rank) %1) - (coll? %1) %1) m)) - -(def ^:private vowels #{\a \e \i \o \u}) -(def ^:private normalized-base-refinements - (let [article #(if (vowels (first %1)) "an" "a")] - (specter/transform - [specter/ALL] - (fn [[k v]] - (let [typ (name k)] - [k [nil [v (fn [_] (format "must be %s %s" (article typ) typ))]]])) - base-refinements))) - -(defn- seq->gen - "Takes a sequence of generators and produces a generator of sequences." - [seq] - (apply gen/tuple seq)) - -(defn- map-seq->gen - "Takes a sequence of values and a function to apply over them - and produces a generator of the sequence of mapped values." - [f val-seq] - (seq->gen (map f val-seq))) - -(s/def ::refinement-tup - (s/tuple (s/nilable keyword?) (s/tuple ::value-level-validation-fn ::primitive-message-fn))) - -(s/def ::refinements - (s/with-gen - (s/map-of keyword? ::refinement-tup) - #(gen/let [kwds (gen/fmap (fn [c] (if (even? (count c)) (vec (butlast c)) c)) - (gen/vector-distinct gen/keyword {:min-elements 5 :max-elements 25})) - cyclic-kwds (gen/return (cycle kwds)) - pairs (gen/return (distinct (take (count kwds) (partition 2 cyclic-kwds)))) - broken-cycle (gen/return (specter/transform [specter/LAST] (fn [p] [(first p) nil]) pairs)) - refinements - (map-seq->gen - (fn [[kwd prev]] - (gen/let [prev-k (gen/frequency [[4 (gen/return prev)] [1 (gen/return nil)]]) - validation-fn (s/gen ::value-level-validation-fn) - validates? (gen/return (:validates? (meta validation-fn))) - message-fn (s/gen ::primitive-message-fn) - msg (gen/return (:msg (meta message-fn)))] - [kwd [prev-k (with-meta [validation-fn message-fn] {:validates? validates? :msg msg})]])) - broken-cycle)] - (into {} refinements)))) - -(s/def ::user-defined-refinements - (s/map-of keyword? (s/or :set set? :refinement-tup ::refinement-tup))) - -(s/def ::refinements-with-string - (s/with-gen - ::refinements - #(gen/fmap (partial merge (select-keys normalized-base-refinements [:string])) (s/gen ::refinements)))) - -(s/def ::refinements-with-string-and-object - (s/with-gen - ::refinements - #(gen/fmap (partial merge (select-keys normalized-base-refinements [:object])) (s/gen ::refinements-with-string)))) - -(defn- gen-derived-from-refinements [f] - (gen/bind - (s/gen ::refinements-with-string) - (fn [refinements] (gen/let [kwd (gen/elements (keys refinements))] (f refinements kwd))))) - -(s/def ::refinements-refinement-kwd-tup - (s/with-gen - (s/tuple ::refinements-with-string keyword?) - #(gen-derived-from-refinements vector))) - -(s/fdef -refinement-kwd->validator - :args (s/cat :tup ::refinements-refinement-kwd-tup) - :fn #(let [[refinements kwd] (-> %1 :args :tup) - funcs (reverse - (loop [[prev tup] (refinements kwd) - funcs []] - (if (nil? prev) - (conj funcs tup) - (recur (refinements prev) (conj funcs tup))))) - failing-msg (if-let [f (some (fn [t] (if (-> t meta :validates? not) (second t))) funcs)] (f nil)) - returned-msg ((:ret %1) nil)] - (= returned-msg failing-msg)) - :ret ::primitive-validator) -(defn- -refinement-kwd->validator [[refinements refinement-kwd]] ; tuple allows both inputs to be generated simult. - (let [_ (if-not (contains? refinements refinement-kwd) - (throw (IllegalStateException. (format "Unknown refinement: %s" refinement-kwd)))) - [prev [validator-fn msg-fn]] (refinement-kwd refinements) - validate-this #(validate-to-msg validator-fn msg-fn %1)] - (cond - (nil? prev) validate-this - :else #(if-let [msg ((-refinement-kwd->validator [refinements prev]) %1)] - msg - (validate-this %1))))) - -(defn- refinement-kwd->validator [refinements refinement-kwd] - (-refinement-kwd->validator [refinements refinement-kwd])) - -(defn- assign-ordering - "Takes a collection and produces a sorted map with the key - for each element being its index starting counting from the number one." - [col] - (into (sorted-map) (map-indexed (comp #(specter/transform [specter/FIRST] inc %) vector) col))) - -(defn- deep-merge - "Recursively merges maps. If keys are not maps, the last value wins." - [& vals] - (if (every? map? vals) - (apply merge-with deep-merge vals) - (last vals))) - -(s/def ::snake-cased-alpha-numeric - (let [regex #"[a-z0-9\_]+"] - (s/with-gen - (s/and string? #(re-matches regex %)) - #(gen'/string-from-regex regex)))) -(s/def ::required? - (s/or :bool boolean? - :when (s/tuple #{:when} - ::snake-cased-alpha-numeric - (s/or :set (s/coll-of ::nonnilable-json-primitive :kind set?) - :exists #{:exists})))) -(s/def ::property-attrs - (s/keys :req-un [::required?])) -(def property-spec - (gen/fmap #(into {} [%]) (gen/tuple (s/gen ::snake-cased-alpha-numeric) (s/gen ::property-attrs)))) - -(defn- valid-includes? [property-set] - (if (contains? property-set :includes) - (s/valid? (s/coll-of keyword? :kind vector?) - (property-set :includes)) - true)) - -(s/def ::property-set - (s/map-of ::snake-cased-alpha-numeric (s/nilable ::property-attrs))) - -(s/def ::event-property-set - #(and (valid-includes? %1) - (s/valid? ::property-set (dissoc %1 :includes)))) - -(defn- one-based-contig-range? [c] - (= c (range 1 (+ 1 (count c))))) - -(s/def ::events-schema - (s/with-gen - (s/and - (s/map-of ::snake-cased-alpha-numeric - (s/map-of integer? ::event-property-set) - :min-count 1) - #(every? one-based-contig-range? - (specter/select [specter/MAP-VALS (specter/view (comp sort keys))] %))) - #(gen/let [min-events (gen/return 2) - max-events (gen/return 5) - max-versions (gen/return 7) - min-props (gen/return 1) - max-props (gen/return 7) - events (gen/vector (s/gen ::snake-cased-alpha-numeric) min-events max-events) - version-counts (gen/vector (gen/choose 1 max-versions) (count events) (count events)) - shared-property-count (gen/frequency [[2 (gen/return (count events))] - [8 (gen/fmap (fn [d] (int (* (count events) d))) - (gen/double* {:min 1.0 :max 2.0}))]]) - shared-properties (gen/vector (s/gen ::snake-cased-alpha-numeric) - shared-property-count shared-property-count) - event-cyc (gen/return (cycle events)) - shared-prop-mappings (gen/return (mapv vector shared-properties event-cyc)) - shared-groups (gen/return (specter/transform [specter/MAP-VALS] (partial map first) - (group-by second shared-prop-mappings))) - zipped (gen/return (map vector events version-counts)) - with-shared-props (gen/return (map (fn [t] (conj t (shared-groups (first t)))) zipped)) - alternates (gen/return (cycle '(:create :delete))) - weave-deletions (gen/return - (fn [altern-prop alternations prop-attrs versions] - (let [zipped (map vector alternations alternates prop-attrs) - mapped (mapv (fn [t] {(t 0) {altern-prop (if (= :create (t 1)) - (t 2))}}) zipped)] - (apply deep-merge (conj mapped versions))))) - with-all-props - (map-seq->gen (fn [t] (gen/fmap (fn [[shared ps [altern-prop alternations prop-attrs]]] - [(t 0) - (weave-deletions - altern-prop - alternations - prop-attrs - (assign-ordering - (conj (rest ps) - (apply merge (conj shared (first ps))))))]) - (gen/tuple - (map-seq->gen (fn [p] - (gen/let [attr (s/gen ::property-attrs)] {p attr})) - (t 2)) - (map-seq->gen (fn [_] - (gen/let [props (gen/choose min-props max-props) - prop-specs - (gen/vector property-spec props props)] - (apply merge prop-specs))) - (range (t 1))) - (gen/let [altern-prop (s/gen ::snake-cased-alpha-numeric) - num-alternations (gen/choose 0 (- (t 1) 1)) - alternations (gen/return - (sort (take num-alternations - (shuffle (range 1 (+ 1 (t 1))))))) - prop-attrs (gen/vector (s/gen ::property-attrs) - num-alternations num-alternations)] - [altern-prop alternations prop-attrs])))) with-shared-props)] - (into (sorted-map) with-all-props)))) - -(defn- materialize-versions [[event versions]] - (into (sorted-map) - {event - (reduce - (fn [acc [version prop-specs]] - (let [this-version (into (sorted-map) (merge (acc (- version 1)) prop-specs)) - deletes (filter #(nil? (second %1)) this-version)] - (doseq [del deletes] - (if (not (contains? (acc (- version 1)) (first del))) - (throw (IllegalStateException. - (format "ERROR: Attempt to delete non-existent property '%s' on event '%s' in version %s" - (first del) event version))))) - (assoc acc version (apply (partial dissoc this-version) (map first deletes))))) - (sorted-map) - versions)})) - -(defn- materialize-event-schema [events-schema] - (apply merge (map materialize-versions events-schema))) - -(defn- all-referenced-properties [events-schema] - (keys (apply merge (mapcat vals (vals events-schema))))) - -(defn- check-property-references [events-schema properties-schema] - (let [referenced (set (all-referenced-properties events-schema)) - defined (set (mapcat keys properties-schema)) - undefined (into (sorted-set) (clojure.set/difference referenced defined)) - unreferenced (into (sorted-set) (clojure.set/difference defined referenced))] - (if (or (not-empty unreferenced) (not-empty undefined)) - (let [undefined-errs (if (not-empty undefined) - (format "ERROR: undefined referenced properties:\n%s" - (with-out-str (clojure.pprint/pprint undefined)))) - unreferenced-errs (if (not-empty unreferenced) - (format "ERROR: unreferenced defined properties:\n%s" - (with-out-str (clojure.pprint/pprint unreferenced)))) - msg (clojure.string/join "\n\n" (filter identity [undefined-errs unreferenced-errs]))] - (throw (IllegalStateException. (str "\n" msg)))) - true))) ; true if validation succeeded - -(s/fdef keys-validator - :args (s/cat :required-keys (s/coll-of string?) - :optional-keys (s/coll-of string?)) - :ret (s/tuple (s/fspec :args (s/cat :v ::json-map) :ret set?) - (s/fspec :args (s/cat :v ::json-map) :ret set?))) -(defn- keys-validator [required-keys optional-keys] - (let [missing #(clojure.set/difference (set required-keys) (set (keys %))) - unexpected #(clojure.set/difference (set (keys %)) (set (concat required-keys optional-keys)))] - (with-meta - [missing unexpected] - {:required required-keys - :optional optional-keys}))) - -(defn- prop-set->keys-validator [field-descs] - (let [{required true optional false} (group-by #(-> % second :required?) field-descs) - [required optional] [(map first required) (map first optional)]] - (keys-validator required optional))) - -(defn- events-schema->keys-validators [events-schema] - (let [materialized (materialize-event-schema events-schema)] - (specter/transform - [specter/MAP-VALS specter/MAP-VALS] - prop-set->keys-validator - materialized))) - -(defn- super-props-schema->keys-validators [super-properties-schema] - (let [append-version (fn [acc [version props]] - (assoc acc version (merge props (get acc (- version 1))))) - reduced (reduce append-version {} super-properties-schema) - denormalized (if (empty? reduced) {0 {}} reduced)] - (specter/transform [specter/MAP-VALS] prop-set->keys-validator denormalized))) - -(defn- reify-keys-validator [refinements - [event-keys-missing event-keys-unexpected] - [super-props-missing super-props-unexpected]] - (let [unexpected (fn [v] (clojure.set/intersection (event-keys-unexpected v) (super-props-unexpected v))) - missing (fn [v] (clojure.set/union (event-keys-missing v) (super-props-missing v))) - validation-fn (fn [v] (and (map? v) (empty? (missing v)) (empty? (unexpected v)))) - msg-fn (fn [v] - (if (not (map? v)) - "internal error" ; can't happen - (-> " " - (clojure.string/join - [(if (not-empty (missing v)) - (format "Missing required keys: %s." (into [] (missing v)))) - (if (not-empty (unexpected v)) - (format "Unexpected keys: %s." (into [] (unexpected v))))]) - (clojure.string/trim))))] - (refinement-kwd->validator (assoc refinements :keys [:object [validation-fn msg-fn]]) :keys))) - -(s/fdef enum-validator - :args (s/cat :refinements ::refinements-with-string :values (s/coll-of string? :min-count 1)) - :fn #(let [val-set (set (-> %1 :args :values)) - ret (:ret %1)] - (-> (prop/for-all [v (s/gen any?)] (boolean (val-set v))) - (partial tc/quick-check 100))) - :ret ::primitive-validator) -(defn- enum-validator [refinements values] - (let [value-set (set values) - validation-fn #(-> %1 value-set boolean) - msg-fn (fn [_] (format "must be one of: %s" value-set))] - (refinement-kwd->validator (assoc refinements :enum [:string [validation-fn msg-fn]]) :enum))) - -(s/fdef -list-validator - :args (s/cat :udr ::refinements :tup ::refinements-refinement-kwd-tup) - :ret ::primitive-validator) -(defn- -list-validator [user-defined-refinements [refinements inner-type]] - (let [validator (refinement-kwd->validator refinements inner-type) - is-user-defined? (contains? user-defined-refinements inner-type) - validation-fn (fn [v] (and (sequential? v) (every? #(nil? (validator %1)) v))) - msg-fn (fn [v] (format "must be a vector of type '%s'%s" - (name inner-type) - (if is-user-defined? - (format " and '%s' %s" (name inner-type) (some identity (map validator v))) - "")))] - (refinement-kwd->validator (assoc refinements - :list [nil [vector? (fn [_] "must be a vector")]] - :elements [:list [validation-fn msg-fn]]) :elements))) - -(defn- list-validator [user-defined-refinements refinements inner-type] - (-list-validator user-defined-refinements [refinements inner-type])) - -(defn- name-type [typ] - (cond - (keyword? typ) (name typ) - (and (vector? typ) (= :list (first typ))) (format "[ %s ]" (name (second typ))) - :else "[internal error]")) - -(declare vectorized-refinement->validator) -(defn- object-validator [user-defined-refinements refinements key-type value-type] - (let [kwd->validator (partial refinement-kwd->validator refinements) - key-validator (kwd->validator key-type) - value-type->validator (cond (keyword? value-type) kwd->validator - (and (vector? value-type) (= :list (first value-type))) - #(apply (partial vectorized-refinement->validator - user-defined-refinements refinements) %1) - :else (throw - (IllegalStateException. (format "Invalid nested type: %s" value-type)))) - value-validator (value-type->validator value-type) - validation-fn (fn [v] (and (every? #(nil? (key-validator %1)) (keys v)) - (every? #(nil? (value-validator %1)) (vals v)))) - msg-fn (fn [_] (format "must be an object from type '%s' to type '%s'" - (name key-type) (name-type value-type)))] - (refinement-kwd->validator (assoc refinements - :specialized-obj [:object [validation-fn msg-fn]]) :specialized-obj))) - -(defn- vectorized-refinement->validator [user-defined-refinements refinements head & rest] - (condp = head - :enum (enum-validator refinements rest) - :object (if (= 2 (count rest)) - (object-validator user-defined-refinements refinements (first rest) (second rest)) - (throw (IllegalStateException. - (format "Object vectorized refinement type expects exactly two arguments. Received: %s" - rest)))) - :list (if (= 1 (count rest)) - (list-validator user-defined-refinements refinements (first rest)) - (throw (IllegalStateException. - (format "List vectorized refinement type expects a single argument. Received: %s" rest)))) - (throw (IllegalStateException. (format "Invalid vectorized refinement type: %s" head))))) - -(s/fdef transform-msg - :args (s/cat :prop ::snake-cased-alpha-numeric - :validator ::primitive-validator - :xfm (s/fspec :args (s/cat :msg string?) - :ret string?)) - :ret ::validator) -(defn- transform-msg [property validator transform-fn] - (fn [e] - (if (contains? e property) - (if-let [msg (validator (get e property))] - (transform-fn msg))))) - -(s/fdef prepend-prop - :args (s/cat :prop ::snake-cased-alpha-numeric - :validator ::primitive-validator) - :ret ::validator) -(defn- prepend-prop [prop validator] - (transform-msg prop validator #(format "'%s' %s" prop %1))) - -(defn- list-refinement-gen [refinements] - (gen/let [inner-refinement (gen/elements (keys refinements))] - [:list inner-refinement])) - -(s/def ::enum-refinement - (s/cat :head (s/with-gen #{:enum} #(gen/return :enum)) - :tail (s/+ string?))) - -(s/def ::list-refinement - (s/cat :head (s/with-gen #{:list} #(gen/return :list)) - :tail keyword?)) - -(s/def ::object-refinement - (s/cat :head (s/with-gen #{:object} #(gen/return :object)) - :from keyword? - :to (s/or :kwd keyword? :lst ::list-refinement))) - -(s/def ::type - (s/or :kwd keyword? - :vectorized (s/alt :enum ::enum-refinement :list ::list-refinement :obj ::object-refinement))) - -(s/def ::refinements-property-refinement-tup - (s/with-gen - (s/and - (s/tuple ::refinements-with-string - (s/tuple ::snake-cased-alpha-numeric ::type)) - #(let [[refinements [_ [refinement-type refinement]]] %1] - (condp = refinement-type - :kwd (contains? refinements refinement) - :vectorized (cond (= :list (first refinement)) - (contains? refinements (:tail (second refinement))) - (= :enum (first refinement)) true)))) - #(gen/let [refinements (gen-derived-from-refinements (comp first vector)) - property (s/gen ::snake-cased-alpha-numeric) - refinement (gen/one-of [(gen/elements (keys refinements)) - (s/gen ::enum-refinement) - (list-refinement-gen refinements)])] - [refinements [property refinement]]))) - -(s/fdef -prop-spec->prop-validator - :args (s/cat :udr ::refinements :tup ::refinements-property-refinement-tup) - :ret (s/tuple ::snake-cased-alpha-numeric ::validator)) -(defn- -prop-spec->prop-validator [user-defined-refinements [refinements [property refinement]]] - [property - (prepend-prop property - (cond - (keyword? refinement) - (refinement-kwd->validator refinements refinement) - (coll? refinement) - (apply (partial vectorized-refinement->validator - user-defined-refinements refinements) refinement)))]) - -(defn- prop-spec->prop-validator [user-defined-refinements refinements [property refinement]] - (-prop-spec->prop-validator user-defined-refinements [refinements [property refinement]])) - -(defn- all-properties [properties-schema] - (apply merge properties-schema)) - -(def ^:private trivial-validator (fn [_] nil)) - -(defn- properties-schemas->validators [user-defined-refinements refinements properties-schema - super-properties-schema-reified] - (let [validator-gen (partial prop-spec->prop-validator user-defined-refinements refinements) - transform-all #(specter/transform [specter/ALL] %1 %2) ; can't use partial because macro - transform-last #(specter/transform [specter/LAST] %1 %2)] - (merge - (transform-all validator-gen (all-properties properties-schema)) - (transform-all - (fn [tup] - (transform-last - (fn [validator] - (fn [o] - (let [[always-required? required-validator] (:required? (second tup))] - (when (or always-required? (not= required-validator trivial-validator) (contains? o (first tup))) - (some force [(delay (required-validator o)) (delay (validator o))]))))) - (validator-gen (transform-last :type tup)))) - super-properties-schema-reified)))) - -(defn- validate-property-values [properties-validators props] - (let [validators (map #(properties-validators (first %1)) props)] - (map #(%1 props) validators))) - -(defn- validate-conditional-requires [events-schema-reified event-type event-version properties] - (let [prop-specs ((events-schema-reified event-type) event-version) - validators (specter/select - [specter/ALL specter/LAST :required? specter/LAST #(not= % trivial-validator)] - prop-specs)] - (map #(%1 properties) validators))) - -(defn- event-key->optional-spec [events-schema-reified event-type event-version key] - (if (< event-version 1) false - (let [event-schema ((events-schema-reified event-type) event-version)] - (if (contains? event-schema key) - (or (-> key event-schema :required? meta :syntax) false) - (recur events-schema-reified event-type (- event-version 1) key))))) - -(defn- event->schema [events-schema-reified super-keys-validators keys-validators - properties-schema super-properties-schema-raw - super-properties-version event-type event-version] - (if-let [super-keys-validator (get super-keys-validators super-properties-version)] - (if-let [event-keys-validators (keys-validators event-type)] - (if-let [event-keys-validator (get event-keys-validators event-version)] - (let [{keys-req :required keys-optional :optional} (meta event-keys-validator) - {sup-keys-req :required sup-keys-optional :optional} (meta super-keys-validator) - keys-spec (fn [keys req?] (apply merge (map #(do {% {:required? req?}}) keys))) - req-keys (keys-spec keys-req true) - opt-spec (partial event-key->optional-spec events-schema-reified event-type event-version) - opt-keys (apply merge (map #(do {%1 {:required? (opt-spec %1)}}) keys-optional)) - event-keys (merge req-keys opt-keys) - super-keys (merge (keys-spec sup-keys-req true) (keys-spec sup-keys-optional false)) - merged-prop-schema (apply merge properties-schema) - referred-key-props (keys event-keys) - event-key-types (apply merge (map #(do {%1 (merged-prop-schema %1)}) referred-key-props)) - merged-super-prop-schema (apply merge (vals super-properties-schema-raw)) - referred-super-props (keys super-keys) - super-key-types (apply merge (map #(do {%1 (merged-super-prop-schema %1)}) referred-super-props)) - types (merge event-key-types super-key-types) - reduced (into {} (for [[k v] types] [k (or (:type v) v)]))] - (into-recursively-sorted-map - {:keys event-keys - :super-keys super-keys - :types reduced})))))) - -(defn- validate-single-extended [refinements keys-validators super-keys-validators - properties-validators events-schema-reified - {:strs [event_type event_version properties super_properties_version] - :or {super_properties_version (apply min (keys super-keys-validators))}}] - (if-let [super-keys-validator (get super-keys-validators super_properties_version)] - (let [event-keys-validators (keys-validators event_type) - event-keys-validator (get event-keys-validators event_version)] - (if (and event-keys-validators event-keys-validator) - (let [keys-validator (reify-keys-validator refinements event-keys-validator super-keys-validator)] - (if-let [msg (keys-validator properties)] - [msg] - (not-empty - (remove nil? (concat (validate-conditional-requires - events-schema-reified event_type event_version properties) - (validate-property-values properties-validators properties)))))) - [(format "There is no version %s for event '%s'" event_version event_type)])) - [(format "There is no super-properties version %s" super_properties_version)])) - -(defn- validate-vector-or-single [vec-or-single validator-fn success-fn] - (let [errors - (if (sequential? vec-or-single) - (into {} (map-indexed #(let [e (validator-fn %2)] (when (not-empty e) [%1 e])) vec-or-single)) - (validator-fn vec-or-single))] - (if (empty? errors) - (success-fn vec-or-single) - (if (sequential? errors) - (into [] errors) - errors)))) - -(defn- validate-extended [refinements keys-validators super-keys-validators - properties-validators events-schema-reified event] - (validate-vector-or-single - event - (partial validate-single-extended refinements keys-validators - super-keys-validators properties-validators events-schema-reified) - (constantly nil))) - -(defn- property->validator [refinements prop refinement-kwd] - (prepend-prop prop (refinement-kwd->validator refinements refinement-kwd))) - -(def ^:private missing-nothing (constantly #{})) -(def ^:private unexpected-everything (comp set keys)) -(defn- base-event-validators [refinements] - [(reify-keys-validator - refinements - (keys-validator ["event_version" "event_type" "properties"] ["super_properties_version"]) - [missing-nothing unexpected-everything]) - (property->validator refinements "super_properties_version" :integer) - (property->validator refinements "event_version" :integer) - (property->validator refinements "event_type" :string) - (property->validator refinements "properties" :object)]) - -(defn- validate-base [base-event-validators event] - (let [validator (fn [event] (filter identity (map #(% event) base-event-validators)))] - (validate-vector-or-single event validator (constantly nil)))) - -(defn- check-super-property-separateness [properties-schema super-properties-schema] - (let [prop-keys (-> properties-schema all-properties keys set) - super-prop-keys (-> super-properties-schema keys set) - intersection (clojure.set/intersection prop-keys super-prop-keys)] - (if (not-empty intersection) - (throw (IllegalStateException. - (format "Super-properties cannot be explicitly referenced. Illegal: %s" - (into [] intersection)))) - true))) - -(defn- check-spec [spec data] - (if-not (s/valid? spec data) - (throw (IllegalStateException. ^String (s/explain-str spec data))) - true)) - -(s/def ::properties-schema - (s/coll-of (s/map-of ::snake-cased-alpha-numeric ::type) :min-count 1)) - -(s/def ::super-property-field - (s/keys :req-un [::type ::required?])) -(s/def ::super-properties-schema - (s/and - (s/map-of integer? (s/map-of ::snake-cased-alpha-numeric ::super-property-field)) - #(one-based-contig-range? (sort (keys %1))))) - -(s/def ::property-lists - (s/map-of keyword? ::property-set)) - -(defn- check-property-list-references [events-schema property-lists] - (let [keys (set (keys property-lists)) - includes - (set (apply concat (remove nil? (specter/select [specter/MAP-VALS specter/MAP-VALS :includes] events-schema)))) - undefined (clojure.set/difference includes keys)] - (if (not-empty undefined) - (throw (IllegalStateException. - (format "Undefined property list references: %s" (into [] undefined)))) - true))) - -(defn- check-super-prop-version-additiveness [super-properties-schema] - (let [keys-sets (specter/transform - [specter/MAP-VALS] - (comp set keys) - super-properties-schema) - verify-version (fn [acc [version props]] - (let [intersection (clojure.set/intersection acc props)] - (if (not-empty intersection) - (throw (IllegalStateException. - (format - "Version %s of super-properties schema duplicates existing properties: %s" - version (into [] intersection)))) - (clojure.set/union acc props))))] - (reduce verify-version #{} (into (sorted-map) keys-sets)) - true)) - -(defn- schemas-valid? [events-schema events-schema-raw properties-schema - super-properties-schema super-properties-schema-raw - property-lists] - (and - (check-property-references events-schema properties-schema) - (check-super-property-separateness properties-schema super-properties-schema) - (check-super-prop-version-additiveness super-properties-schema) - (check-spec ::events-schema events-schema-raw) - (check-property-list-references events-schema-raw property-lists) - (check-spec ::properties-schema properties-schema) - (check-spec ::super-properties-schema super-properties-schema-raw))) - -(defn- reify-required-specs [prop-schema] - (specter/transform - [specter/ALL (specter/collect-one specter/FIRST) specter/LAST :required?] - (fn [prop req-spec] - (match req-spec - [:when other-prop values] - (let [[pred msg] (if (= values :exists) - [#(contains? % other-prop) "exists"] - [#(contains? values (% other-prop)) - (format "is any of: %s" values)])] - (with-meta - [false - (fn [o] - (if (pred o) - (if-not (contains? o prop) - (format "'%s' is required when '%s' %s" - prop other-prop msg))))] - {:syntax [:when other-prop values]})) - :else [req-spec trivial-validator])) - prop-schema)) - -(defn- explode-includes [property-lists m] - (specter/transform [specter/MAP-VALS specter/MAP-VALS (specter/submap [:includes])] - #(apply merge (map property-lists (%1 :includes))) m)) - -(defn- prepare-refinements [user-defined-refinements normalized-base-refinements] - (let [user-defined-refinements (specter/transform - [specter/MAP-VALS set?] - #(do [:string [%1 (fn [_] (str "must be one of: " %1))]]) - user-defined-refinements) - refinements (s/assert ::refinements - (merge user-defined-refinements - refinements/user-defined-refinements - normalized-base-refinements))] - [user-defined-refinements refinements])) - -(s/fdef validator - :args (s/alt - :binary - (s/cat :events-schema ::events-schema - :properties-schema ::properties-schema) - :tertiary - (s/cat :events-schema ::events-schema - :properties-schema ::properties-schema - :super-properties-schema ::super-properties-schema) - :quaternary - (s/cat :events-schema ::events-schema - :properties-schema ::properties-schema - :super-properties-schema ::super-properties-schema - :refinements ::user-defined-refinements) - :pentary - (s/cat :events-schema ::events-schema - :properties-schema ::properties-schema - :super-properties-schema ::super-properties-schema - :property-lists ::property-lists - :refinements ::user-defined-refinements)) - :ret ::validator) -(defn validator - ([events-schema properties-schema] - (validator events-schema properties-schema {})) - ([events-schema properties-schema super-properties-schema] - (validator events-schema properties-schema super-properties-schema {})) - ([events-schema properties-schema super-properties-schema refinements] - (validator events-schema properties-schema super-properties-schema {} refinements)) - ([events-schema properties-schema super-properties-schema property-lists refinements] - (let [property-lists (into-recursively-sorted-map property-lists) - events-schema-raw (into-recursively-sorted-map events-schema) - events-schema-reified (specter/transform - [specter/MAP-VALS specter/MAP-VALS] - reify-required-specs - (explode-includes property-lists events-schema-raw)) - events-schema (specter/transform - [specter/MAP-VALS specter/MAP-VALS specter/MAP-VALS :required?] - first - events-schema-reified) - properties-schema (into-recursively-sorted-map properties-schema) - super-properties-schema-raw (into-recursively-sorted-map super-properties-schema) - super-properties-schema-reified (specter/transform - [specter/MAP-VALS] - reify-required-specs - super-properties-schema-raw) - super-properties-schema (specter/transform - [specter/MAP-VALS specter/MAP-VALS :required?] - first - super-properties-schema-reified) - refinements-raw (into-recursively-sorted-map refinements) - [user-defined-refinements refinements] - (prepare-refinements refinements-raw normalized-base-refinements) - keys-validators (events-schema->keys-validators events-schema) - super-keys-validators (super-props-schema->keys-validators super-properties-schema) - super-properties-schemas-flattened (apply merge (reverse (vals super-properties-schema-reified))) - properties-validators (properties-schemas->validators - user-defined-refinements refinements properties-schema - super-properties-schemas-flattened)] - (if (schemas-valid? events-schema events-schema-raw properties-schema super-properties-schema - super-properties-schema-raw property-lists) - (with-meta - (fn [event-or-events] - (if-let [msg (validate-base (base-event-validators refinements) event-or-events)] - msg - (validate-extended refinements keys-validators super-keys-validators - properties-validators events-schema-reified event-or-events))) - {:events-schema events-schema - :events-schema-reified events-schema-reified - :super-properties-schema super-properties-schema - :super-properties-schema-reified super-properties-schema-reified - :super-properties-schemas-flattened super-properties-schemas-flattened - :user-defined-refinements user-defined-refinements - :refinements refinements - :event->schema (partial event->schema events-schema-reified super-keys-validators keys-validators - properties-schema super-properties-schema-raw)}))))) - -(defn- refinement->base-refinement [refinements refinement] - (loop [cur refinement] - (let [[nxt _] (refinements cur)] - (if (nil? nxt) cur (recur nxt))))) - -(s/fdef refinements->validators - :args (s/cat :refinements - (fn [v] - (every? - identity - (map - (fn [[refinement [kwd refinement-spec :as refinement-tup]]] - (or (set? refinement-spec) - (binding [primitive-type-to-gen - (refinement->base-refinement - (merge v normalized-base-refinements) kwd)] - (s/valid? ::refinement-tup refinement-tup)))) - v)))) - :ret (s/map-of keyword? ::validator)) -(defn refinements->validators [refinements] - (let [[_ refinements] (prepare-refinements refinements normalized-base-refinements)] - (specter/transform - [specter/ALL] - (fn [[kwd _]] - [kwd (-refinement-kwd->validator [refinements kwd])]) - refinements))) - -(stest/instrument `validator) -(stest/instrument `refinements->validators) diff --git a/src/validaze/refinements.clj b/src/validaze/refinements.clj deleted file mode 100644 index 2e02fb5..0000000 --- a/src/validaze/refinements.clj +++ /dev/null @@ -1,8 +0,0 @@ -(ns validaze.refinements - (:require [clj-time.format :refer [parse formatters]])) - -(def user-defined-refinements - {:nonnegative-integer [:integer [nat-int? (fn [_] "must be a nonnegative integer")]] - :positive-integer [:integer [pos-int? (fn [_] "must be a positive integer")]] - :datetime [:string [#(try (parse (formatters :date-time) %1) (catch Exception e nil)) - (fn [_] "must be a datetime")]]}) diff --git a/test/validaze/core_test.clj b/test/validaze/core_test.clj deleted file mode 100644 index 0566ebd..0000000 --- a/test/validaze/core_test.clj +++ /dev/null @@ -1,100 +0,0 @@ -(ns validaze.core-test - (:require [validaze.core :as core] - [clojure.test :refer :all] - [clojure.set :as set] - [clojure.spec.alpha :as s] - [clojure.spec.test.alpha :as stest] - [clojure.test.check.generators :as gen])) - -(defn instrument-all-syms [] - (stest/instrument (stest/instrumentable-syms))) - -(defn spec-check-is-success [check-res] - (stest/summarize-results check-res) - (if (nil? check-res) - (is false "stest/check result was nil. did you pass it any valid symbols?") - (let [check #(let [res %1] - (is (= true (-> res :clojure.spec.test.check/ret :result)) - (format "spec check failure:\r\n%s" (with-out-str (clojure.pprint/pprint res)))))] - (doall (map check check-res))))) - -(defn explain-valid? [spec data] - (is (s/valid? spec data) - (format "`valid?` failure explanation:\r\n%s" (s/explain-str spec data)))) - -(deftest ^:eftest/slow specd-functions-pass-check - (instrument-all-syms) - (let [fns [`core/enum-validator - `core/-list-validator - `core/-refinement-kwd->validator - `core/transform-msg - `core/prepend-prop - `core/-prop-spec->prop-validator - `core/validate-to-msg - `core/keys-validator]] - (spec-check-is-success (stest/check fns)))) - -(deftest generator-spec-congruence - (instrument-all-syms) - ;; These are the specs in our project defined with `with-gen`. - ;; Verifies that generator and spec are congruent with one another. - (doseq [spec '(::core/json-map - ::core/refinements - ::core/refinements-with-string - ::core/refinements-with-string-and-object - ::core/refinements-refinement-kwd-tup - ::core/snake-cased-alpha-numeric - ::core/events-schema - ::core/refinements-property-refinement-tup - ::core/value-level-validation-fn - ::core/primitive-message-fn - ::core/validation-fn - ::core/message-fn - ::core/enum-refinement - ::core/list-refinement - ::core/object-refinement - ::core/primitive-validator - ::core/validator)] - (is (gen/sample (s/gen spec) 1000) - (format "incongruence between spec and its generator: %s" spec)))) - -(deftest super-props-behave-when-unspecified - (let [events-schema {"event1" {1 {"prop1" {:required? true}}}} - props-schema [{"prop1" :string}] - super-props-schema {1 {"super_prop1" {:type :string :required? true}}} - validator-with-super-props (core/validator events-schema props-schema super-props-schema) - validator-without-super-props (core/validator events-schema props-schema) - event {"event_type" "event1" "event_version" 1 "properties" {"prop1" "blah"}}] - (is (= ["Missing required keys: [\"super_prop1\"]."] - (validator-with-super-props event))) - (is (nil? (validator-without-super-props event))))) - -(deftest when-prop-works - (let [exists-schema {"event1" {1 {"prop1" {:required? false} - "prop2" {:required? [:when "prop1" :exists]}}}} - is-one-of-schema (assoc-in exists-schema ["event1" 1 "prop2" :required?] [:when "prop1" #{"foo" "bar"}]) - props-schema [{"prop1" :string "prop2" :string}] - exists-validator (core/validator exists-schema props-schema) - is-one-of-validator (core/validator is-one-of-schema props-schema) - base-event {"event_type" "event1" "event_version" 1}] - ; exists tests - (is (= ["'prop2' is required when 'prop1' exists"] - (exists-validator (merge base-event {"properties" {"prop1" "p1"}})))) - (is (nil? (exists-validator (merge base-event {"properties" {"prop1" "p1" "prop2" "p2"}})))) - (is (nil? (exists-validator (merge base-event {"properties" {}})))) - ; is-one-of tests - (is (= ["'prop2' is required when 'prop1' is any of: #{\"foo\" \"bar\"}"] - (is-one-of-validator (merge base-event {"properties" {"prop1" "foo"}})))) - (is (nil? (is-one-of-validator (merge base-event {"properties" {"prop1" "bar" "prop2" "p2"}})))) - (is (nil? (is-one-of-validator (merge base-event {"properties" {}})))))) - -(deftest errors-returned-as-vector-or-map - (let [events-schema {"event1" {1 {"prop1" {:required? true}}}} - props-schema [{"prop1" :string}] - validator (core/validator events-schema props-schema) - event {"event_type" "event1" "event_version" 1 "properties" {}} - num-events 10 - multi-res (validator (repeat num-events event))] - (is (vector? (validator event))) - (is (map? multi-res)) - (is (= (sort (keys multi-res)) (range num-events)))))