xAPI 2.0.0 Support

src/xapi_schema/spec.cljc

@@ -7,8 +7,11 @@
                                    MailToIRIRegEx
                                    UuidRegEx
                                    TimestampRegEx
+                                   TimestampRegEx200
                                    xAPIVersionRegEx
+                                   xAPIVersionRegEx200
                                    DurationRegEx
+                                   DurationRegEx200
                                    Sha1RegEx
                                    Sha2RegEx]]
    [clojure.spec.alpha :as s #?@(:cljs [:include-macros true])]
@@ -22,6 +25,10 @@
   "When true, coerce 0.95 context activities to conform."
   true)
 
+(def ^:dynamic *xapi-version*
+  "xAPI Statement Version to Conform"
+  "1.0.3")
+
 ;; Utils
 
 (def double-conformer
@@ -234,7 +241,11 @@
   [timestamp]
   (letfn [(parse-int [s] #?(:clj (Integer/parseInt s) :cljs (js/parseInt s)))]
     (let [[ts year month day _hour _min _sec _sec-frac _offset]
-          (re-matches TimestampRegEx timestamp)
+          (re-matches
+           (case *xapi-version*
+             "1.0.3" TimestampRegEx
+             "2.0.0" TimestampRegEx200)
+           timestamp)
           month-int (when month (parse-int month))
           year-int  (when year (parse-int year))
           day-int   (when day (parse-int day))]
@@ -269,7 +280,11 @@
 (s/def ::duration
   (s/with-gen
     (s/and string?
-           (partial re-matches DurationRegEx))
+           #(re-matches
+             (case *xapi-version*
+               "1.0.3" DurationRegEx
+               "2.0.0" DurationRegEx200)
+             %))
     #(sgen/fmap (fn [[h m s]]
                   (#?(:clj format
                       :cljs gstring/format) "PT%dH%sM%dS" h m s))
@@ -280,11 +295,12 @@
 (s/def ::version
   (s/with-gen
     (s/and string?
-           (partial re-matches xAPIVersionRegEx))
-    #(sgen/fmap (fn [i]
-                  (#?(:clj format
-                      :cljs gstring/format) "1.0.%d" i))
-                (sgen/int))))
+           #(re-matches
+             (case *xapi-version*
+               "1.0.3" xAPIVersionRegEx
+               "2.0.0" xAPIVersionRegEx200)
+             %))
+    #(sgen/return *xapi-version*)))
 
 (s/def ::sha2
   (s/with-gen
@@ -815,17 +831,17 @@
     (-> scores
         (assoc :score/min raw)
         (assoc :score/raw min))
-    
+
     (and min max (< max min))
     (-> scores
         (assoc :score/min max)
         (assoc :score/max min))
-    
+
     (and raw max (< max raw))
     (-> scores
         (assoc :score/raw max)
         (assoc :score/max raw))
-    
+
     :else
     scores))
 
@@ -973,27 +989,107 @@
 (s/def :context/extensions
   ::extensions)
 
-(s/def ::context
-  (conform-ns "context"
+;; 2.0.x compat
+
+;; contextAgents
+(s/def :contextAgent/objectType #{"contextAgent"})
+(s/def :contextAgent/agent ::agent)
+(s/def :contextAgent/relevantTypes
+  (s/every ::iri
+           :into []
+           :min-count 1))
+
+(s/def ::context-agent
+  (conform-ns "contextAgent"
+              (s/and
+               (s/keys :req [:contextAgent/objectType
+                             :contextAgent/agent]
+                       :opt [:contextAgent/relevantTypes])
+               (restrict-keys :contextAgent/objectType
+                              :contextAgent/agent
+                              :contextAgent/relevantTypes))))
+(s/def :context/contextAgents
+  (s/every ::context-agent
+           :into []))
+
+;; contextGroups
+
+(s/def :contextGroup/objectType #{"contextGroup"})
+(s/def :contextGroup/group ::group)
+(s/def :contextGroup/relevantTypes
+  (s/every ::iri
+           :into []
+           :min-count 1))
+
+(s/def ::context-group
+  (conform-ns "contextGroup"
               (s/and
-               (s/keys :opt [:context/registration
-                             :context/instructor
-                             :context/team
-                             :context/contextActivities
-                             :context/revision
-                             :context/platform
-                             :context/language
-                             :context/statement
-                             :context/extensions])
-               (restrict-keys :context/registration
-                              :context/instructor
-                              :context/team
-                              :context/contextActivities
-                              :context/revision
-                              :context/platform
-                              :context/language
-                              :context/statement
-                              :context/extensions))))
+               (s/keys :req [:contextGroup/objectType
+                             :contextGroup/group]
+                       :opt [:contextGroup/relevantTypes])
+               (restrict-keys :contextGroup/objectType
+                              :contextGroup/group
+                              :contextGroup/relevantTypes))))
+(s/def :context/contextGroups
+  (s/every ::context-group
+           :into []))
+
+;; multispec for dynamic params
+(defmulti context-version (fn [_] *xapi-version*))
+
+(defmethod context-version "1.0.3" [_]
+  (conform-ns
+   "context"
+   (s/and
+    (s/keys :opt [:context/registration
+                  :context/instructor
+                  :context/team
+                  :context/contextActivities
+                  :context/revision
+                  :context/platform
+                  :context/language
+                  :context/statement
+                  :context/extensions])
+    (restrict-keys :context/registration
+                   :context/instructor
+                   :context/team
+                   :context/contextActivities
+                   :context/revision
+                   :context/platform
+                   :context/language
+                   :context/statement
+                   :context/extensions))))
+
+(defmethod context-version "2.0.0" [_]
+  (conform-ns
+   "context"
+   (s/and
+    (s/keys :opt [:context/registration
+                  :context/instructor
+                  :context/team
+                  :context/contextActivities
+                  :context/revision
+                  :context/platform
+                  :context/language
+                  :context/statement
+                  :context/extensions
+                  :context/contextAgents
+                  :context/contextGroups])
+    (restrict-keys :context/registration
+                   :context/instructor
+                   :context/team
+                   :context/contextActivities
+                   :context/revision
+                   :context/platform
+                   :context/language
+                   :context/statement
+                   :context/extensions
+                   :context/contextAgents
+                   :context/contextGroups))))
+
+(s/def ::context
+  (s/multi-spec context-version (fn [gen-val _]
+                                  gen-val) ))
 
 ;; Attachments
 
@@ -1326,8 +1422,19 @@
                    (some-> s :statement/object :statement-ref/objectType)
                    true)))))
 
+(defn unique-statement-ids?
+  "Spec predicate to ensure that the IDs of a list of statements are unique."
+  [statements]
+  (let [ids (keep #(get % "id") statements)]
+    (or
+     (empty? ids)
+     (reduce distinct? ids)
+     ::s/invalid)))
+
 (s/def ::statements
-  (s/coll-of ::statement :into []))
+  (s/and
+   (s/coll-of ::statement :into [])
+   unique-statement-ids?))
 
 (s/def ::lrs-statements
   (s/coll-of ::lrs-statement :into []))

src/xapi_schema/spec/regex.cljc

@@ -144,13 +144,60 @@
                       dur-week)]
     (re-pattern (str "^P(?:" duration ")|P(?:" (base-timestamp) ")$"))))
 
+(defn- base-timestamp-200 []
+  (let [;; Date
+        year  "(\\d{4})"
+        month "(0[1-9]|1[0-2])"
+        day   "(0[1-9]|[12]\\d|3[01])" ; ignore month/leap year constraints
+        ;; Time
+        hour "([01]\\d|2[0-3])"
+        min  "([0-5]\\d)"
+        sec  "([0-5]\\d|60)" ; leap seconds
+        sec-frac "(\\.\\d+)"
+        ;; Time
+        time (str "(?:" hour ":" min ":" sec sec-frac "?" ")")
+        date (str "(?:" year "-" month "-" day ")")]
+    (str date "[T\\s]" time)))
+
+(def TimestampRegEx200 ; RFC 3339
+  (let [;; Time
+        hour "(?:[01]\\d|2[0-3])"
+        min  "(?:[0-5]\\d)"
+        ;; Offset
+        lookahead   "(?!-00:00)"
+        num-offset  (str "(?:[+-]" hour ":" min ")")
+        time-offset (str "(Z|" lookahead num-offset ")")]
+    (re-pattern (str "^" (base-timestamp-200) time-offset "$"))))
+
+(def DurationRegEx200 ; ISO 8601 Durations
+  (let [dy "(?:\\d+Y|\\d+\\.\\d+Y$)"
+        dm "(?:\\d+M|\\d+\\.\\d+M$)"
+        dw "(?:\\d+W|\\d+\\.\\d+W$)"
+        dd "(?:\\d+D|\\d+\\.\\d+D$)"
+        dh "(?:\\d+H|\\d+\\.\\d+H$)"
+        ds "(?:\\d+S|\\d+\\.\\d+S$)"
+        dur-date (str "(?:" dd "|" dm dd "?" "|" dy dm "?" dd "?" ")")
+        dur-time (str "(?:" ds "|" dm ds "?" "|" dh dm "?" ds "?" ")")
+        dur-week (str "(?:" dw ")")
+        duration (str "(?:" dur-date "(?:T" dur-time ")?" ")" "|"
+                      "(?:T" dur-time ")" "|"
+                      dur-week)]
+    (re-pattern (str "^P(?:" duration ")|P(?:" (base-timestamp-200) ")$"))))
+
+
 ;; Based on http://www.regexr.com/39s32
 (def xAPIVersionRegEx
   (let [suf-part "[0-9a-zA-Z-]+(?:\\.[0-9a-zA-Z-]+)*"
         suffix   (str "(\\.[0-9]+(?:-" suf-part ")?(?:\\+" suf-part ")?)?")
         ver-str  (str "^1\\.0" suffix "$")]
     (re-pattern ver-str)))
 
+(def xAPIVersionRegEx200
+  (let [suf-part "[0-9a-zA-Z-]+(?:\\.[0-9a-zA-Z-]+)*"
+        suffix   (str "(\\.[0-9]+(?:-" suf-part ")?(?:\\+" suf-part ")?)?")
+        ver-str  (str "^(1\\.0" suffix ")|(2\\.0\\.0)$")]
+    (re-pattern ver-str)))
+
 (def Base64RegEx
   (let [fs     #?(:clj "\\/" :cljs "/")
         body   (str "(?:[A-Za-z0-9\\+" fs "]{4})*")

test/xapi_schema/spec/regex_test.cljc

@@ -9,7 +9,9 @@
                                    MailToIRIRegEx
                                    UuidRegEx
                                    TimestampRegEx
+                                   TimestampRegEx200
                                    xAPIVersionRegEx
+                                   xAPIVersionRegEx200
                                    DurationRegEx
                                    Base64RegEx
                                    Sha1RegEx
@@ -145,15 +147,20 @@
     (is (not (re-matches TimestampRegEx "20150513T15Z")))
     (is (not (re-matches TimestampRegEx "20150513T15:16:00Z")))
     ;; negative offset
-    (is (not (re-matches TimestampRegEx "2008-09-15T15:53:00.601-00:00")))))
+    (is (not (re-matches TimestampRegEx "2008-09-15T15:53:00.601-00:00"))))
+  (testing "matches valid but terrible stamps in rfc3339 OUTSIDE of 8601"
+    (is (re-matches TimestampRegEx200 "2015-05-13 15:16:00Z"))))
 
 (deftest xapi-version-regex-test
   (testing "matches xAPI 1.0.X versions"
     (is (and (re-matches xAPIVersionRegEx "1.0.0")
              (re-matches xAPIVersionRegEx "1.0.2")
              (re-matches xAPIVersionRegEx "1.0")
              (re-matches xAPIVersionRegEx "1.0.32-abc.def+ghi.jkl")))
-    (is (not (re-matches xAPIVersionRegEx "0.9.5")))))
+    (is (not (re-matches xAPIVersionRegEx "0.9.5"))))
+  (testing "matches xAPI 2.0.0 version only"
+    (is (and (re-matches xAPIVersionRegEx200 "2.0.0")
+             (not (re-matches xAPIVersionRegEx200 "2.0.2"))))))
 
 (deftest duration-regex-test
   (testing "matches ISO durations"

test/xapi_schema/spec_test.cljc

@@ -389,7 +389,37 @@
                        :bad
                        {"team" {"mbox" "mailto:a@b.com"}}
                        {"team" {"mbox" "mailto:a@b.com"
-                                "objectType" "Agent"}}))))
+                                "objectType" "Agent"}})))
+  (testing "xAPI 2.0.0"
+    (binding [xs/*xapi-version* "2.0.0"]
+      (testing "contextAgents"
+        (should-satisfy+
+         ::xs/context
+         {"contextAgents"
+          [{:objectType "contextAgent"
+            :agent {"mbox" "mailto:a@b.com"
+                    "objectType" "Agent"}}]}
+         :bad
+         {"contextAgents" [{"mbox" "mailto:a@b.com"
+                            "objectType" "Agent"}]}
+         {"contextAgents"
+          [{:objectType "contextGroup"
+            :group {"mbox" "mailto:a@b.com"
+                    "objectType" "Group"}}]}))
+      (testing "contextGroups"
+        (should-satisfy+
+         ::xs/context
+         {"contextGroups"
+          [{:objectType "contextGroup"
+            :group {"mbox" "mailto:a@b.com"
+                    "objectType" "Group"}}]}
+         :bad
+         {"contextGroups" [{"mbox" "mailto:a@b.com"
+                            "objectType" "Group"}]}
+         {"contextGroups"
+          [{:objectType "contextAgent"
+            :agent {"mbox" "mailto:a@b.com"
+                    "objectType" "Agent"}}]})))))
 
 (deftest attachment-test
   (testing