Merge pull request #9 from Aidbox/worm2fed/#7-verify-deps

[#7] Verify dependencies

Makefile

@@ -1,7 +1,7 @@
 build-jar:
 	clj -T:build uberjar
 
-test:
+run-tests:
 	clj -M:test -m kaocha.runner
 
 PATH_TO_JAR := $(project_dir)/$(jar_path)

deps.edn

@@ -8,10 +8,11 @@
  :aliases
  {:dev {:extra-paths ["dev"]}
 
-  :test {:extra-paths ["tests"]
+  :test {:extra-paths ["test"]
          :exec-fn     kaocha.runner/exec-fn
-         :extra-deps  {com.health-samurai/matcho {:mvn/version "0.3.11"}
-                       lambdaisland/kaocha       {:mvn/version "1.91.1392"}}}
+         :extra-deps  {com.health-samurai/matcho  {:mvn/version "0.3.11"}
+                       lambdaisland/kaocha        {:mvn/version "1.91.1392"}
+                       nubank/matcher-combinators {:mvn/version "3.9.1"}}}
 
   :build {:deps       {io.github.clojure/tools.build {:mvn/version "0.10.5"}}
           :ns-default build}}}

dev/user.clj

@@ -1,17 +1,19 @@
 (ns user
   (:require [aidbox-sdk.generator :as gen]
+            [aidbox-sdk.schema.verify :refer [fhir-version-pattern]]
             [clojure.data]
-            [clojure.java.io :as io]))
+            [clojure.java.io :as io]
+            [clojure.string :as str]))
 
 (def source' (io/file "resources/schemas"))
 
-(def target (io/file "/tmp/sdk"))
+(def target (io/file "out/"))
 
 (defn vector-to-map [v]
   (->> (map (fn [item] (hash-map (:url item) item)) v)
        (into {})))
 
-(apply merge [{:a 1 :b 2} {:a 3 :c 4}])
+;; (apply merge [{:a 1 :b 2} {:a 3 :c 4}])
 
 (comment
 
@@ -71,5 +73,4 @@
 
   (gen/build-all! source' target)
 
-  ;;
-  )
+  :rcf)

src/aidbox_sdk/core.clj

@@ -30,6 +30,8 @@
         (println "Error: please provide an output argument"))
 
       :else
-      (generator/build-all!
-       (resource input)
-       (io/as-file output)))))
+      (do
+        (println "Building FHIR SDK...")
+        (generator/build-all!
+         (resource input)
+         (io/as-file output))))))

src/aidbox_sdk/generator.clj

@@ -1,16 +1,15 @@
 (ns aidbox-sdk.generator
   (:refer-clojure :exclude [namespace])
-  (:require
-   [clojure.data.json :as json]
-   [aidbox-sdk.generator.dotnet.templates :as dotnettpl]
-   [aidbox-sdk.generator.helpers :refer [->pascal-case safe-conj
-                                         uppercase-first-letter vector-to-map]]
-   [clojure.java.io :as io]
-   [clojure.set :as set]
-   [clojure.string :as str]
-   [clojure.walk])
-  (:import
-   [java.util.zip ZipEntry ZipOutputStream]))
+  (:require [aidbox-sdk.generator.dotnet.templates :as dotnettpl]
+            [aidbox-sdk.generator.helpers :refer [->pascal-case safe-conj
+                                                  uppercase-first-letter
+                                                  vector-to-map]]
+            [aidbox-sdk.schema :as schema]
+            [clojure.java.io :as io]
+            [clojure.set :as set]
+            [clojure.string :as str]
+            [clojure.walk])
+  (:import [java.util.zip ZipEntry ZipOutputStream]))
 
 ;;
 ;; FHIR
@@ -646,6 +645,7 @@
   (delete-directory! dir)
   (create-directory! dir))
 
+;; FIXME do we need it?
 (defn zip-dir! [path zip-name]
   (with-open [zip (ZipOutputStream. (io/output-stream zip-name))]
     (doseq [f (file-seq (io/file path)) :when (.isFile f)]
@@ -654,6 +654,7 @@
       (.closeEntry zip)))
   (io/file zip-name))
 
+;; FIXME do we need it?
 (defn copy-files! [src-dir target-dir]
   (doseq [file (remove #(.isDirectory %) (file-seq src-dir))]
     (io/copy file (io/file target-dir (.getName file)))))
@@ -691,61 +692,15 @@
               (conj schema {:backbone-elements
                             (flat-backbones (:backbone-elements schema) [])})))))
 
-(defn get-directory-files [path]
-  (->> path
-       file-seq
-       (remove #(.isDirectory %))))
-
-(defn fetch-packages [source-path]
-  (->> source-path
-       (get-directory-files)
-       (remove #(.isDirectory %))
-       (filter #(str/includes? (.getName %) "hl7.fhir"))))
-
-(defn create-gzip-reader [path]
-  (-> path
-      (io/input-stream)
-      (java.util.zip.GZIPInputStream.)
-      (io/reader)))
-
-(defn parse-ndjson-gz [path]
-  (with-open [rdr (create-gzip-reader path)]
-    (->> rdr
-         line-seq
-         (mapv (fn [line]
-                 (json/read-str line :key-fn keyword))))))
-
-(defn merge-duplicates [schemas]
-  (->> schemas
-       (group-by :url)
-       (map (fn [[_url same-url-schemas]]
-              (apply merge same-url-schemas)))))
-
-(defmulti retrieve-schemas class)
-
-(defmethod retrieve-schemas java.io.File
-  [source]
-  (->> (fetch-packages source)
-       (map parse-ndjson-gz)
-       (flatten)
-       (remove #(nil? (:package-meta %)))
-       (map (fn [schema]
-              (assoc schema :package (get-in schema [:package-meta :name]))))
-       (merge-duplicates)))
-
-(defmethod retrieve-schemas java.net.URL
-  [source] (do "something"))
-
 (defn build-all! [input output]
   (let [search-parameters-dir (io/file output "search")
-        all-schemas           (retrieve-schemas input)
+        all-schemas           (schema/retrieve input)
         ;; search-params-schemas (retrieve-search-params source-dir)
         search-params-schemas all-schemas
         constraints           (->> all-schemas
                                    (filter #(and
                                              (constraint? %)
                                              (not (from-extension? %)))))]
-
     (prepare-target-directory! output)
 
     ;; create base namespace (all FHIR datatypes) file

src/aidbox_sdk/schema.clj

@@ -0,0 +1,70 @@
+(ns aidbox-sdk.schema
+  (:require [aidbox-sdk.schema.verify :as verify]
+            [clojure.data.json :as json]
+            [clojure.java.io :as io]
+            [clojure.string :as str]))
+
+(defn get-packages-from-directory
+  "Returns all packages in the given directory, including files in subdirectories.
+   NOTE: right now it'll filter out all files which do not contains hl7.fhir
+   in their name."
+  [path]
+  (let [packages (->> path
+                      file-seq
+                      (remove #(.isDirectory %))
+                      ;; FIXME only gzip, but there is no problem to accept unpacked ndjson
+                      ;; see https://github.com/Aidbox/aidbox-sdk/issues/11
+                      (filter #(str/ends-with? (.getName %) ".gz")))]
+    (println "✅ Found packages:" (count packages))
+    packages))
+
+(defn create-gzip-reader [path]
+  (-> path
+      (io/input-stream)
+      (java.util.zip.GZIPInputStream.)
+      (io/reader)))
+
+;; TODO derive some criteria to determine whether it's a package (is it valid?)
+;; see https://github.com/Aidbox/aidbox-sdk/issues/10
+(defn parse-package [path]
+  (println "Parsing package:" (str path))
+  (with-open [rdr (create-gzip-reader path)]
+    (->> rdr
+         line-seq
+         (mapv (fn [line]
+                 (json/read-str line :key-fn keyword))))))
+
+(defn remove-invalid-schemas [schemas]
+  (remove #(nil? (:package-meta %)) schemas))
+
+(defn merge-duplicates [schemas]
+  (->> schemas
+       (group-by :url)
+       (map (fn [[_url same-url-schemas]]
+              (apply merge same-url-schemas)))))
+
+(defn prepare-schemas [schemas]
+  (map #(->> (get-in % [:package-meta :name])
+             (assoc  %  :package))
+       schemas))
+
+
+(defmulti retrieve class)
+
+;; ! According to an example here:
+;; ! https://clojuredocs.org/clojure.java.io/file
+;; ! it's possible to create a File instance from url, which may lead to bugs
+(defmethod retrieve java.io.File
+  [source]
+  (println "Retrieving packages from: " (str source))
+  (->> (get-packages-from-directory source)
+       (mapv parse-package)
+       (verify/check-compatibility!)
+       (flatten)
+       (remove-invalid-schemas)
+       (prepare-schemas)
+       (merge-duplicates)))
+
+(defmethod retrieve java.net.URL
+  [source]
+  (do "something"))

src/aidbox_sdk/schema/verify.clj

@@ -0,0 +1,144 @@
+(ns aidbox-sdk.schema.verify
+  (:require [clojure.string :as str]))
+
+(def fhir-version-pattern
+  #"^(0|[1-9]\d*)\.(0|[1-9]\d*)(?:\.(0|[1-9]\d*))?(?:-((?:0|[1-9]\d*|\d*[a-zA-Z-][0-9a-zA-Z-]*))?)?$")
+
+(defn versions-match? [v1 v2]
+  (let [->groups (fn [v] (->> v (re-matcher fhir-version-pattern) re-find))
+        ->map    (fn [[_ major minor patch label]]
+                   {:major major, :minor minor, :patch patch, :label label})
+
+        v1-groups (-> v1 ->groups ->map)
+        v2-groups (-> v2 ->groups ->map)]
+
+    (if (and v1-groups v2-groups)
+      (and (= (:major v1-groups) (:major v2-groups))
+           (= (:minor v1-groups) (:minor v2-groups)))
+      false)))
+
+(defn simplify-package-meta [package]
+  (select-keys package [:name :version]))
+
+
+;; FIXME: is it reliable to use first element of the list?
+;; ! seems like it's not for original packages (without Aidbox processing).
+(defn extract-meta-from-package
+  "Extracts meta information from the package."
+  [package]
+  (first package))
+
+(defn find-core-package
+  "Finds core package in the list of packages.
+   Throws an exception if there are more then one core package."
+  [packages]
+  (let [cores (filter #(= "fhir.core" (:type %)) packages)
+        core  (first cores)]
+    (cond
+      (= (count cores) 0)
+      (throw (ex-info "No core package found" {}))
+
+      (> (count cores) 1)
+      (throw (ex-info "Found more then one core package"
+                      {:packages (mapv #(simplify-package-meta %) cores)}))
+
+      :else
+      core)))
+
+(defn find-extra-packages
+  "Finds extra packages in the list of packages.
+   Throws an exception if there are a few packages with same name."
+  [packages]
+  (let [extra      (remove #(= "fhir.core" (:type %)) packages)
+
+        duplicates (reduce (fn [duplicates [k v]]
+                             (if (= (count v) 1)
+                               duplicates
+                               (assoc duplicates k v)))
+                           {} (group-by :name extra))]
+    (cond
+      (> (count duplicates) 0)
+      (throw (ex-info "Found more then one package with same name"
+                      {:packages (keys duplicates)}))
+
+      :else
+      extra))
+
+  (remove #(= "fhir.core" (:type %)) packages))
+
+(defn find-core-package-mismatch
+  "Finds packages which do not support a core package version."
+  [version packages]
+  (->> packages
+       (mapv    (fn [package]
+                  (assoc package :match-with-core?
+                         (if (> (count (:fhirVersions package)) 0)
+                           (->> (:fhirVersions package)
+                                (map #(versions-match? version %))
+                                (some #{true})
+                                (boolean))
+                           true))))
+
+       (filterv #(not (:match-with-core? %)))))
+
+(defn- find-failed-dependencies
+  "Finds failed dependencies for the package looking up in all packages.
+   In case of failure will return a vec of failed dependencies."
+  [packages {:keys [dependencies]}]
+  (reduce (fn [mismatch dependency]
+            (let [dependency
+                  (if (str/starts-with? dependency ":")
+                    (subs dependency 1)
+                    dependency)
+
+                  [dep-name dep-version]
+                  (str/split dependency #"#")
+
+                  found
+                  (->> packages
+                       (filterv #(= (:name %) dep-name))
+                       (mapv #(simplify-package-meta %)))]
+
+              (if (and (= (count found) 1)
+                       (every? #(= (:version %) dep-version) found))
+                mismatch
+                (conj mismatch {:required {:name    dep-name
+                                           :version dep-version}
+                                :found    found}))))
+          [] dependencies))
+
+(defn find-dependencies-mismatch
+  "Finds packages with failed dependencies check."
+  [packages]
+  (reduce (fn [mismatches package]
+            (let [failed-dependencies (find-failed-dependencies packages package)]
+              (if-not (empty? failed-dependencies)
+                (->> failed-dependencies
+                     (assoc package :failed-dependencies)
+                     (conj mismatches))
+                mismatches)))
+          [] packages))
+
+(defn check-compatibility! [packages]
+  (println "Verifying compatibility...")
+  (let [all   (map extract-meta-from-package packages)
+        core  (find-core-package   all)
+        extra (find-extra-packages all)]
+    (println "✅ Core package found:" (simplify-package-meta core))
+
+    (println "Checking core version match...")
+    (let [core-mismatch (find-core-package-mismatch (:version core) extra)]
+      (when-not (empty? core-mismatch)
+        (throw (ex-info "Some packages do not match with core version"
+                        {:version  (:version core)
+                         :packages (mapv :name core-mismatch)}))))
+    (println "✅ Core version match check passed")
+
+    (println "Checking dependencies match...")
+    (let [deps-mismatch (find-dependencies-mismatch all)]
+      (when-not (empty? deps-mismatch)
+        (throw (ex-info "Some packages failed dependencies check"
+                        {:packages (mapv #(select-keys % [:name :failed-dependencies])
+                                         deps-mismatch)}))))
+    (println "✅ Dependencies match check passed"))
+  packages)