History Paging

project.clj

@@ -23,7 +23,7 @@
    [metosin/reitit-ring "0.3.9"
     :exclusions [commons-codec]]
    [org.apache.httpcomponents/httpcore "4.4.11"]
-   [org.clojars.akiel/datomic-spec "0.5.1"]
+   [org.clojars.akiel/datomic-spec "0.5.2"]
    [org.clojars.akiel/datomic-tools "0.4"]
    [org.clojars.akiel/env-tools "0.2.1"]
    [org.clojars.akiel/spec-coerce "0.3.1"]

src/blaze/datomic/util.clj

@@ -8,6 +8,15 @@
     [java.util Date]))
 
 
+(s/fdef resource-type*
+  :args (s/cat :db ::ds/db :eid ::ds/entity-id)
+  :ret string?)
+
+(defn resource-type*
+  [db eid]
+  (name (d/ident db (d/part eid))))
+
+
 (s/fdef resource-type
   :args (s/cat :resource ::ds/entity)
   :ret string?)
@@ -16,7 +25,7 @@
   "Returns the type of a `resource` like \"Patient\" or \"Observation\"."
   {:arglists '([resource])}
   [{:db/keys [id] :as resource}]
-  (name (d/ident (d/entity-db resource) (d/part id))))
+  (resource-type* (d/entity-db resource) id))
 
 
 (defn resource-id-attr [type]
@@ -145,18 +154,6 @@
   (= -3 (:instance/version resource)))
 
 
-(s/fdef ordinal-version
-  :args (s/cat :resource ::ds/entity)
-  :ret nat-int?)
-
-(defn ordinal-version
-  "Returns the strong monotonic increasing ordinal version of `resource`.
-
-  Ordinal versions start with 1."
-  [resource]
-  (- (bit-shift-right (:instance/version resource) 2)))
-
-
 (s/fdef list-resources
   :args (s/cat :db ::ds/db :type string?)
   :ret (s/coll-of ::ds/entity))
@@ -186,6 +183,18 @@
     (d/datoms (d/history db) :eavt eid :instance/version)))
 
 
+(s/fdef instance-version
+  :args (s/cat :resource ::ds/entity)
+  :ret nat-int?)
+
+(defn instance-version
+  "Returns the strong monotonic increasing ordinal version of `resource`.
+
+  Ordinal versions start with 1."
+  [resource]
+  (- (bit-shift-right (:instance/version resource 0) 2)))
+
+
 (s/fdef type-transaction-history
   :args (s/cat :db ::ds/db :type string?)
   :ret (s/coll-of ::ds/entity))
@@ -214,14 +223,14 @@
     (d/datoms (d/history db) :eavt :system :system/version)))
 
 
-(s/fdef resource-type-total
+(s/fdef type-total
   :args (s/cat :db ::ds/db :type string?)
   :ret nat-int?)
 
-(defn resource-type-total
+(defn type-total
   "Returns the total number of resources with `type` in `db`."
   [db type]
-  (- (get (d/entity db (keyword type)) :type/total 0)))
+  (- (:type/total (d/entity db (keyword type)) 0)))
 
 
 (s/fdef system-version
@@ -231,4 +240,14 @@
 (defn system-version
   "Returns the number of resource changes in the whole system."
   [db]
-  (- (get (d/entity db :system) :system/version 0)))
+  (- (:system/version (d/entity db :system) 0)))
+
+
+(s/fdef type-version
+  :args (s/cat :db ::ds/db :type string?)
+  :ret nat-int?)
+
+(defn type-version
+  "Returns the number of resource changes of `type`."
+  [db type]
+  (- (:type/version (d/entity db (keyword type)) 0)))

src/blaze/handler/fhir/history/util.clj

@@ -13,9 +13,13 @@
     [java.util Date]))
 
 
+(s/fdef since-t
+  :args (s/cat :db ::ds/db :query-params (s/map-of string? string?))
+  :ret (s/nilable nat-int?))
+
 (defn since-t
   "Uses the `_since` param to derive the since-t of `db`."
-  {:arglists '([db params])}
+  {:arglists '([db query-params])}
   [db {since "_since"}]
   (when since
     (d/since-t (d/since db (Date/from (Instant/parse since))))))
@@ -46,20 +50,27 @@
     (Long/parseLong page-eid)))
 
 
-(s/fdef nav-link
+(s/fdef nav-url
   :args (s/cat :match :fhir.router/match
                :query-params (s/map-of string? string?)
-               :relation string? :entry (s/tuple ::ds/entity ::ds/entity-id)))
-
-(defn nav-link
-  "Returns a nav link with `relation` and `entry` as first entry of the page."
-  {:arglists '([match query-params relation entry])}
-  [{{:blaze/keys [base-url]} :data :as match} query-params relation
-   [transaction eid]]
-  (let [t (d/tx->t (:db/id transaction))
-        path (reitit/match->path match (assoc query-params "t" t "eid" eid))]
-    {:relation relation
-     :url (str base-url path)}))
+               :t nat-int?
+               :transaction ::ds/entity
+               :eid (s/nilable ::ds/entity-id)))
+
+(defn nav-url
+  "Returns a nav URL with the entry of `transaction` and `eid` (optional) as
+  first entry of the page.
+
+  Uses `match` to generate a link based on the current path with appended
+  `query-params` and the extra paging params calculated from `t` and entry."
+  {:arglists '([match query-params t transaction eid])}
+  [{{:blaze/keys [base-url]} :data :as match} query-params t transaction eid]
+  (let [page-t (d/tx->t (:db/id transaction))
+        path (reitit/match->path
+               match
+               (cond-> (assoc query-params "t" t "page-t" page-t)
+                 eid (assoc "page-eid" eid)))]
+    (str base-url "/" path)))
 
 
 (defn- method [resource]
@@ -102,3 +113,21 @@
         :lastModified (str (datomic-util/tx-instant transaction))}}
       (not (datomic-util/deleted? resource))
       (assoc :resource (pull/pull-resource* db type resource)))))
+
+
+(s/fdef tx-db
+  :args (s/cat :db ::ds/db :since-t (s/nilable nat-int?) :page-t (s/nilable nat-int?))
+  :ret ::ds/db)
+
+(defn tx-db
+  "Returns a database which includes resources since the optional `since-t` and
+  up-to (as-of) the optional `page-t`. If both times are omitted, `db` is
+  returned unchanged.
+
+  While `page-t` is used for paging, restricting the database page by page more
+  into the past, `since-t` is used to cut the database at some point in the past
+  in order to include only resources up-to this point in time. So `page-t`
+  should be always greater or equal to `since-t`."
+  [db since-t page-t]
+  (let [tx-db (if since-t (d/since db since-t) db)]
+    (if page-t (d/as-of tx-db page-t) tx-db)))

src/blaze/handler/fhir/history_instance.clj

@@ -12,6 +12,7 @@
     [cognitect.anomalies :as anom]
     [datomic.api :as d]
     [datomic-spec.core :as ds]
+    [manifold.deferred :as md]
     [reitit.core :as reitit]
     [ring.middleware.params :refer [wrap-params]]
     [ring.util.response :as ring]))
@@ -21,48 +22,73 @@
   (:db/id (util/resource db type id)))
 
 
-(defn- total* [db eid]
-  (let [resource (d/entity db eid)]
-    ;; test for resource existence since `d/entity` always returns something
-    ;; when called with an eid
-    (if (:instance/version resource)
-      (util/ordinal-version resource)
-      0)))
-
-
 (defn- total [db since-t eid]
-  (let [total (total* db eid)]
+  (let [total (util/instance-version (d/entity db eid))]
     (if since-t
-      (- total (total* (d/as-of db since-t) eid))
+      (- total (util/instance-version (d/entity (d/as-of db since-t) eid)))
       total)))
 
 
-(defn- build-response [router db since-t params eid transactions]
-  (ring/response
-    {:resourceType "Bundle"
-     :type "history"
-     :total (total db since-t eid)
-     :entry
-     (into
-       []
-       (comp
-         (take (fhir-util/page-size params))
-         (map #(history-util/build-entry router db % eid)))
-       transactions)}))
+(defn- build-response
+  "The coll of `transactions` already starts at `page-t`."
+  [router match query-params db since-t eid transactions]
+  (let [page-size (fhir-util/page-size query-params)
+        transactions (into [] (take (inc page-size) transactions))
+        more-entries-available? (< page-size (count transactions))
+        t (or (d/as-of-t db) (d/basis-t db))
+        self-link
+        (fn [transaction]
+          {:relation "self"
+           :url (history-util/nav-url match query-params t transaction nil)})
+        next-link
+        (fn [transaction]
+          {:relation "next"
+           :url (history-util/nav-url match query-params t transaction nil)})]
+    (ring/response
+      (cond->
+        {:resourceType "Bundle"
+         :type "history"
+         :total (total db since-t eid)
+         :link []
+         :entry
+         (into
+           []
+           (comp
+             ;; we need take here again because we take page-size + 1 above
+             (take page-size)
+             (map #(history-util/build-entry router db % eid)))
+           transactions)}
+
+        (first transactions)
+        (update :link conj (self-link (first transactions)))
+
+        more-entries-available?
+        (update :link conj (next-link (peek transactions)))))))
+
+
+(defn handle [router match query-params db type id]
+  (if-let [eid (resource-eid db type id)]
+    (let [page-t (history-util/page-t query-params)
+          since-t (history-util/since-t db query-params)
+          tx-db (history-util/tx-db db since-t page-t)
+          transactions (util/instance-transaction-history tx-db eid)]
+      (build-response router match query-params db since-t eid transactions))
+    (handler-util/error-response
+      {::anom/category ::anom/not-found
+       :fhir/issue "not-found"})))
+
+
+(defn- db [conn t]
+  (if t
+    (-> (d/sync conn t) (md/chain #(d/as-of % t)))
+    (d/db conn)))
 
 
 (defn- handler-intern [conn]
-  (fn [{{:keys [type id]} :path-params :keys [query-params]
-        ::reitit/keys [router]}]
-    (let [db (d/db conn)]
-      (if-let [eid (resource-eid db type id)]
-        (let [since-t (history-util/since-t db query-params)
-              since-db (if since-t (d/since db since-t) db)
-              transactions (util/instance-transaction-history since-db eid)]
-          (build-response router db since-t query-params eid transactions))
-        (handler-util/error-response
-          {::anom/category ::anom/not-found
-           :fhir/issue "not-found"})))))
+  (fn [{::reitit/keys [router match] :keys [query-params]
+        {:keys [type id]} :path-params}]
+    (-> (db conn (fhir-util/t query-params))
+        (md/chain' #(handle router match query-params % type id)))))
 
 
 (s/def :handler.fhir/history-instance fn?)