Merge pull request #13 from Aidbox/loading-schemas-from-aidbox

feat(#3): add schemas downloading from aidbox url

Makefile

@@ -14,6 +14,7 @@ generate_reflect_config:
 COMPILE_OPTS := \
   --no-fallback \
   --features=clj_easy.graal_build_time.InitClojureClasses \
+	--enable-url-protocols=http,https \
   -H:ReflectionConfigurationFiles=$(project_dir)/META/reflect-config.json \
   -H:Name=aidbox-sdk
 compile_native_image: generate_reflect_config

deps.edn

@@ -1,8 +1,8 @@
 {:paths ["src"]
- :deps {org.clojure/data.json                {:mvn/version "2.5.0"}
-
-        com.github.clj-easy/graal-build-time {:mvn/version "1.0.5"}
+ :deps {com.github.clj-easy/graal-build-time {:mvn/version "1.0.5"}
+        org.clj-commons/clj-http-lite        {:mvn/version "1.0.13"}
         org.clojure/clojure                  {:mvn/version "1.11.3"}
+        org.clojure/data.json                {:mvn/version "2.5.0"}
         org.clojure/tools.cli                {:mvn/version "1.1.230"}}
 
  :aliases

dev/user.clj

@@ -61,7 +61,6 @@
   (count (gen/apply-constraints mcodes
                                 bases))
 
-  (vec (gen/retrieve-schemas' source'))
   (contains? (->> (gen/retrieve-schemas' source')
                   (filter gen/base-schema?)
                   (gen/prepared-schemas)
@@ -71,6 +70,6 @@
                   (vector-to-map))
              "http://hl7.org/fhir/StructureDefinition/Observation")
 
-  (gen/build-all! source' target)
+  (gen/build-all! (io/as-url "http://localhost:8765/sdk/fhir-packages")  target)
 
   :rcf)

src/aidbox_sdk/core.clj

@@ -2,24 +2,43 @@
   (:gen-class)
   (:require
    [clojure.java.io :as io]
+   [clojure.tools.cli :as cli]
    [aidbox-sdk.generator :as generator]))
 
 (set! *warn-on-reflection* true)
 
-(defn url
+(defn url?
   "Safe version of as-url function"
   [s]
   (try
-    (io/as-url s)
-    (catch java.net.MalformedURLException _ nil)
-    (catch java.net.URISyntaxException _ nil)))
+    (let [_ (io/as-url s)]
+      true)
+    (catch java.net.MalformedURLException _ false)
+    (catch java.net.URISyntaxException _ false)))
 
 (defn resource [path]
-  (or (url path)
-      (io/as-file path)))
+  (if (url? path)
+    {:type :url :source path}
+    {:type :file :source path}))
+
+(def cli-options
+  [["-a" "--auth BASE64_string" "Base64 of username:password"
+    :validate [(complement nil?) "auth token is required"]]
+   ["-h" "--help"]])
 
 (defn -main [& args]
-  (let [[input output] args]
+  (let [{:keys [options summary]} (cli/parse-opts args cli-options)
+        [input output] args]
+    (when (:help options)
+      (println "Generate Aidbox SDK from FHIR schemas")
+      (println)
+      (println "USAGE")
+      (println "aidbox-sdk <input-source> <output-dir> [options]")
+      (println)
+      (println "OPTIONS")
+      (println summary)
+      (System/exit 0))
+
     (cond
       (nil? input)
       (binding [*out* *err*]
@@ -33,5 +52,8 @@
       (do
         (println "Building FHIR SDK...")
         (generator/build-all!
+         options
          (resource input)
-         (io/as-file output))))))
+         (io/as-file output))
+        (println "Finished succesfully!")
+        (System/exit 0)))))

src/aidbox_sdk/generator.clj

@@ -1,15 +1,16 @@
 (ns aidbox-sdk.generator
   (:refer-clojure :exclude [namespace])
-  (: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]))
+  (: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]))
 
 ;;
 ;; FHIR
@@ -645,20 +646,6 @@
   (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)]
-      (.putNextEntry zip (ZipEntry. (str/replace-first (.getPath f) path "")))
-      (io/copy f zip)
-      (.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)))))
-
 ;;
 ;; main
 ;;
@@ -692,18 +679,21 @@
               (conj schema {:backbone-elements
                             (flat-backbones (:backbone-elements schema) [])})))))
 
-(defn build-all! [input output]
+(defn build-all! [ctx input output]
   (let [search-parameters-dir (io/file output "search")
-        all-schemas           (schema/retrieve input)
+        all-schemas           (schema/retrieve input {:auth (:auth ctx)})
         ;; 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
+    (println "---")
+    (println "Generating base namespace")
     (->> all-schemas
          (filter base-schema?)
          (prepared-schemas)
@@ -713,6 +703,7 @@
           (io/file output "Base.cs")))
 
     ;; create spezialization files
+    (println "Generating resource classes")
     (doseq [item (->> all-schemas
                       (filter base-schema?)
                       (filter domain-resource?)
@@ -727,6 +718,7 @@
        (generate-resource-namespace item)))
 
     ;; create resource map file
+    (println "Generating resource map")
     (->> all-schemas
          (filter base-schema?)
          (filter domain-resource?)
@@ -751,6 +743,7 @@
        (:class-file-content item)))
 
     ;; create constraints
+    (println "Generating constraints classes")
     (doseq [{:keys [name schema file-content]}
             (->> (apply-constraints
                   constraints
@@ -767,8 +760,11 @@
                                          (assoc schema
                                                 :url name'))})))]
       (save-to-file!
-       (io/file output (package->directory (:package schema)) (str (->pascal-case (url->resource-type name)) ".cs"))
+       (io/file output
+                (package->directory (:package schema))
+                (str (->pascal-case (url->resource-type name)) ".cs"))
        file-content))
 
+    (println "Generating common SDK files")
     (doseq [file dotnettpl/files]
       (spit (io/file output (:name file)) (:content file)))))

src/aidbox_sdk/generator/helpers.clj

@@ -1,5 +1,6 @@
 (ns aidbox-sdk.generator.helpers
   (:require
+   [clojure.data.json :as json]
    [clojure.string :as str]))
 
 (defn words
@@ -24,3 +25,9 @@
        (into {})))
 
 (defn safe-conj [a b] (conj a (or b {})))
+
+(defn rand-int-between [min max]
+  (int (+ min (Math/floor (rand (- max min))))))
+
+(defn parse-json [s]
+  (json/read-str s :key-fn keyword))

src/aidbox_sdk/schema.clj

@@ -1,13 +1,12 @@
 (ns aidbox-sdk.schema
   (:require [aidbox-sdk.schema.verify :as verify]
-            [clojure.data.json :as json]
+            [aidbox-sdk.generator.helpers :refer [rand-int-between parse-json]]
+            [clj-http.lite.client :as http.client]
             [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."
+  "Returns all packages in the given directory, including files in subdirectories. "
   [path]
   (let [packages (->> path
                       file-seq
@@ -28,11 +27,10 @@
 ;; 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
+  (with-open [reader (create-gzip-reader path)]
+    (->> reader
          line-seq
-         (mapv (fn [line]
-                 (json/read-str line :key-fn keyword))))))
+         (mapv parse-json))))
 
 (defn remove-invalid-schemas [schemas]
   (remove #(nil? (:package-meta %)) schemas))
@@ -48,23 +46,60 @@
              (assoc  %  :package))
        schemas))
 
+(defmulti retrieve (fn [resource _] (:type resource)))
 
-(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]
+(defmethod retrieve :file
+  [{:keys [source]} opts]
   (println "Retrieving packages from: " (str source))
-  (->> (get-packages-from-directory source)
+  (->> (get-packages-from-directory (io/as-file source))
        (mapv parse-package)
        (verify/check-compatibility!)
        (flatten)
        (remove-invalid-schemas)
        (prepare-schemas)
        (merge-duplicates)))
 
-(defmethod retrieve java.net.URL
-  [source]
-  (do "something"))
+(defn- next-timeout
+  "Timeout calculation for retrying like in kafka.
+  https://kafka.js.org/docs/retry-detailed"
+  [timeout]
+  (let [factor 0.2
+        multiplier 2]
+    (* (rand-int-between
+        (* timeout (- 1 factor))
+        (* timeout (+ 1 factor)))
+       multiplier)))
+
+(defn- retry [f & {:keys [timeout trials]
+                   :or   {timeout 3000
+                          trials  3}}]
+  (if (zero? (dec trials))
+    (f)
+    (try
+      (f)
+      (catch Throwable _
+        (Thread/sleep ^long timeout)
+        (retry f {:timeout (next-timeout timeout)
+                  :trials  (dec trials)})))))
+
+(defn fetch-n-parse [url opts]
+  (let [result (retry #(http.client/get url {:headers {"Authorization" (str "Basic " (:auth opts))}}))]
+    (some-> result :body parse-json)))
+
+(defn skip-root-package [packages]
+  (rest packages))
+
+(defmethod retrieve :url
+  [{:keys [source]} opts]
+  (let [extract-link (fn [package] (-> package :href))
+        extract-name (fn [package] (str (:name package) "#" (:version package)))
+        fhir-packages (do
+                        (println "Downloading list of dependencies from:" source)
+                        (-> (fetch-n-parse source opts)
+                            (skip-root-package)))]
+
+    (->> fhir-packages
+         (pmap (fn [package]
+                 (println "Downloading schemas for:" (extract-name package))
+                 (fetch-n-parse (extract-link package) opts)))
+         (flatten))))