diff --git a/src/flanders/json_schema.cljc b/src/flanders/json_schema.cljc index 39046d0f..bfdf8591 100644 --- a/src/flanders/json_schema.cljc +++ b/src/flanders/json_schema.cljc @@ -1,5 +1,6 @@ (ns flanders.json-schema (:require [clojure.string :as str] + [clojure.set :as set] [flanders.core :as f])) (defn- -normalize @@ -62,35 +63,42 @@ [v opts] (cond ;; TODO "default", "example", "description", "title" - (map? v) (let [{:strs [$defs $dynamicAnchor $dynamicRef $id $vocabulary $schema]} (normalize-map v) + (map? v) (let [{:strs [$ref $defs $dynamicAnchor $dynamicRef $id $vocabulary $schema]} (normalize-map v) ;; TODO _ (when $schema (assert (= "http://json-schema.org/draft-07/schema#" $schema) (pr-str $schema))) _ (assert (nil? $dynamicAnchor)) ;; TODO _ (assert (nil? $dynamicRef)) ;; TODO - $defs (some-> $defs normalize-map) - opts (-> opts - (update ::base-id (fn [parent-id] - ;; TODO subschemas start new id https://json-schema.org/draft/2020-12/json-schema-core#section-8.2.1 - (when (and parent-id $id) - (throw (ex-info "$id only supported at top-level" {}))) - (or $id parent-id - ;; TODO Establishing a Base URI https://www.rfc-editor.org/rfc/rfc3986.html#section-5.1 - (throw (ex-info "Must supply $id" {}))))) - (as-> opts - (update opts ::defs - (fn [defs] - (let []) - ) - (fnil into {}) - (map (fn [[k v]] - (let [{::keys [base-id path]} opts - k (-normalize k)] - [(-normalize k) - (->flanders v (conj-path opts "$defs" k))]))) - $defs)))] + opts (as-> opts opts + (update ::base-id (fn [parent-id] + ;; TODO subschemas start new id https://json-schema.org/draft/2020-12/json-schema-core#section-8.2.1 + (when (and parent-id $id) + (throw (ex-info "$id only supported at top-level" {}))) + (or $id parent-id + ;; TODO Establishing a Base URI https://www.rfc-editor.org/rfc/rfc3986.html#section-5.1 + (throw (ex-info "Must supply $id" {}))))) + (cond-> opts + (seq $defs) + (update opts ::defs + (fn [defs] + (let [defs (or defs {}) + $defs (normalize-map $defs)] + (when-some [clashes (seq (set/intersection (-> defs keys set) + (-> $defs keys set)))] + (throw (ex-info "Clashing $def's" {:clashes clashes}))) + (into defs + (map (fn [[k v]] + (let [opts (conj-path opts "$defs" k) + this-id (absolute-id opts)] + [this-id + (->flanders v (update opts ::seen (fnil conj #{}) this-id))]))) + $defs))) + $defs)))] (or ;; https://datatracker.ietf.org/doc/html/draft-pbryan-zyp-json-ref-03#section-3 - (when (get v "$ref") - (->JSONSchemaRef v opts)) + (when-some [this-id (some-> $ref (resolve-id opts))] + (when (contains? (::seen opts) this-id) + (throw (ex-info "Recursive schemas not allowed" {:id this-id}))) + (or (get-in opts [::defs this-id]) + (throw (ex-info "Could not resolve id" {:absolute-id this-id :relative-id $ref})))) (when-some [disjuncts (get v "anyOf")] (f/either :choices (into [] (map-indexed #(->flanders %2 (conj-path opts "anyOf" %1))) disjuncts))) (when-some [conjuncts (get v "allOf")]