Support interface implementing another interface

resources/com/walmartlabs/lacinia/GraphqlSchema.g4

@@ -102,7 +102,7 @@ inputValueDef
   ;
 
 interfaceDef
-  : description? K_INTERFACE anyName directiveList? fieldDefs?
+  : description? K_INTERFACE anyName implementationDef? directiveList? fieldDefs?
   ;
 
 scalarDef

src/com/walmartlabs/lacinia/introspection.clj

@@ -53,11 +53,19 @@
 (defn ^:private resolve-interfaces
   [context _ object]
   (let [{:keys [::category ::type-def]} object]
-    (when (= :object category)
+    (cond
+      ;; For objects, always return the (possibly-empty) list of implemented interfaces.
+      (= :object category)
       (let [interfaces (-> type-def :implements sort seq)
             schema (get context constants/schema-key)]
         (map #(type-name->schema-type schema %)
-             interfaces)))))
+             interfaces))
+      ;; For interfaces, return the list only when they implement other interfaces.
+      (= :interface category)
+      (when-let [interfaces (-> type-def :implements sort seq)]
+        (let [schema (get context constants/schema-key)]
+          (map #(type-name->schema-type schema %)
+               interfaces))))))
 
 (defn ^:private is-deprecated?
   "The :deprecated key can either be a boolean, or a string which is the deprecation reason."

src/com/walmartlabs/lacinia/parser/schema.clj

@@ -400,13 +400,14 @@
 
 (defmethod xform :interfaceDef
   [prod]
-  (let [{:keys [anyName fieldDefs description directiveList]
+  (let [{:keys [anyName implementationDef fieldDefs description directiveList]
          :or {fieldDefs (list :fieldDefs)}} (tag prod)]
     [[:interfaces (xform anyName)]
      (-> {:fields (xform fieldDefs)}
          (common/copy-meta anyName)
          (apply-description description)
-         (apply-directives directiveList))]))
+         (apply-directives directiveList)
+         (cond-> implementationDef (assoc :implements (xform implementationDef))))]))
 
 (defmethod xform :unionDef
   [prod]

src/com/walmartlabs/lacinia/schema.clj

@@ -354,7 +354,8 @@
 ;; Here we'd prefer a version of ::fields where :resolve was not defined.
 (s/def ::interface (s/keys :opt-un [::description
                                     ::directives
-                                    ::fields]))
+                                    ::fields
+                                    ::implements]))
 ;; A list of keyword identifying objects that are part of a union.
 (s/def ::members (s/and (s/coll-of ::type-name)
                    seq))
@@ -688,6 +689,13 @@
   [i-type f-type]
   (contains? (:implements f-type) (:type-name i-type)))
 
+(defmethod check-compatible [:interface :interface]
+  [i-type f-type]
+  ;; An interface field type is compatible with an implementing-interface field type if
+  ;; the implementing interface (f-type) declares that it implements the constraining
+  ;; interface (i-type).
+  (contains? (:implements f-type) (:type-name i-type)))
+
 ;; That's as far as the spec goes, but one could imagine additonal rules
 ;; such as a union-vs-union (the field union must be a subset of the interface union),
 ;; or interface-union (all members of the union must implement the interface).
@@ -1558,12 +1566,51 @@
         map->Type
         compile-directives)))
 
+(defn ^:private expand-implements
+  "Returns the transitive closure of implements for a type. Walks up the interface
+  hierarchy so that e.g. if B implements A, and C implements B, C's :implements
+  includes both :B and :A."
+  [schema type-name]
+  (loop [result #{}
+         queue (vec (:implements (get schema type-name)))]
+    (if (empty? queue)
+      result
+      (let [iface-name (first queue)
+            remaining (rest queue)
+            iface (get schema iface-name)]
+        (recur (conj result iface-name)
+               (into (vec remaining)
+                     (remove result (:implements iface))))))))
+
 (defmethod compile-type :interface
   [interface schema]
-  (->> interface
-    map->Interface
-    compile-directives
-    (compile-fields schema)))
+  (let [interface-name (:type-name interface)
+        implements (->> interface :implements (map as-keyword) set)]
+    (doseq [iface-name implements
+            :let [type (get schema iface-name)]]
+      (when (= iface-name interface-name)
+        (throw (ex-info (format "Interface %s cannot implement itself."
+                          (q iface-name))
+                 {:interface interface-name})))
+      (when-not type
+        (throw (ex-info (format "Interface %s implements interface %s, which does not exist."
+                          (q interface-name)
+                          (q iface-name))
+                 {:interface interface-name
+                  :schema-types (type-map schema)})))
+      (when-not (= :interface (:category type))
+        (throw (ex-info (format "Interface %s implements type %s, which is not an interface."
+                          (q interface-name)
+                          (q iface-name))
+                 {:interface interface-name
+                  :schema-types (type-map schema)}))))
+    (->> interface
+      map->Interface
+      compile-directives
+      (compile-fields schema)
+      (#(if (seq implements)
+          (assoc % :implements implements)
+          %)))))
 
 (defn ^:private extract-type-name
   "Navigates a type map down to the root kind and returns the type name."
@@ -1722,28 +1769,83 @@
         ;; Validate argument directives
         (validate-directives-in-def schema arg-def :argument-definition)))))
 
+(defn ^:private all-implemented-interfaces
+  "Returns the transitive set of interface names implemented by the given type (by type-name keyword).
+  Walks up the interface hierarchy via :implements on each compiled interface definition."
+  [schema type-name]
+  (loop [result #{}
+         queue (vec (:implements (get schema type-name)))]
+    (if (empty? queue)
+      result
+      (let [iface-name (first queue)
+            remaining (subvec (vec queue) 1)]
+        (if (result iface-name)
+          (recur result remaining)
+          (recur (conj result iface-name)
+                 (into remaining
+                       (remove result (:implements (get schema iface-name))))))))))
+
 (defn ^:private prepare-and-validate-interfaces
   "Invoked after compilation to add a :members set identifying which concrete types implement
-  the interface.  Peforms final verification of types in fields and field arguments."
+  the interface.  Performs final verification of types in fields and field arguments.
+  Also validates that interfaces implementing other interfaces declare all required fields."
   [schema]
-  (let [objects (types-with-category schema :object)]
-    (map-types schema :interface
-      (fn [interface]
-        (verify-fields-and-args schema interface)
-        (validate-directives-in-def schema interface :interface)
-        (let [interface-name (:type-name interface)
-              implementors (->> objects
-                                (filter #(-> % :implements interface-name))
-                                (map :type-name)
-                                set)
-              fields' (->> interface
-                           :fields
-                           (map-vals #(assoc % :type-name interface-name))
-                           (map-vals apply-deprecated-directive))]
-          (-> interface
-              (assoc :members implementors
-                     :fields fields')
-              (dissoc :resolve)))))))
+  (let [objects (types-with-category schema :object)
+        interfaces (types-with-category schema :interface)
+        ;; Detect cycles in the interface implements graph before doing anything else.
+        _ (doseq [interface interfaces
+                  :let [interface-name (:type-name interface)
+                        transitive (all-implemented-interfaces schema interface-name)]]
+            (when (transitive interface-name)
+              (throw (ex-info (format "Interface %s is part of a circular implements chain."
+                                (q interface-name))
+                       {:interface interface-name}))))
+        ;; Expand each object's :implements set to include transitively-inherited interfaces.
+        ;; This is needed so check-compatible [:interface :object] works when an object only
+        ;; directly lists a sub-interface but not its parent interfaces.
+        schema' (reduce (fn [s obj]
+                          (let [transitive (all-implemented-interfaces s (:type-name obj))
+                                expanded (into (:implements obj #{}) transitive)]
+                            (if (= expanded (:implements obj))
+                              s
+                              (update s (:type-name obj) assoc :implements expanded))))
+                        schema
+                        objects)]
+    ;; Validate that each interface implementing another interface declares all required fields.
+    (doseq [interface interfaces
+            :let [interface-name (:type-name interface)]
+            parent-name (:implements interface)
+            :let [parent (get schema parent-name)]
+            [field-name parent-field] (:fields parent)
+            :let [iface-field (get-nested interface [:fields field-name])]]
+      (when-not iface-field
+        (throw (ex-info "Missing interface field in interface definition."
+                 {:interface interface-name
+                  :field-name field-name
+                  :parent-interface-name parent-name})))
+      (when-not (is-assignable? schema parent-field iface-field)
+        (throw (ex-info "Interface field is not compatible with implemented interface field type."
+                 {:parent-interface-name parent-name
+                  :field-name (:qualified-name iface-field)}))))
+    (let [objects' (types-with-category schema' :object)]
+      (map-types schema' :interface
+        (fn [interface]
+          (verify-fields-and-args schema' interface)
+          (validate-directives-in-def schema' interface :interface)
+          (let [interface-name (:type-name interface)
+                ;; Use objects' (with expanded :implements) to catch transitive membership.
+                implementors (->> objects'
+                                  (filter #(-> % :implements interface-name))
+                                  (map :type-name)
+                                  set)
+                fields' (->> interface
+                             :fields
+                             (map-vals #(assoc % :type-name interface-name))
+                             (map-vals apply-deprecated-directive))]
+            (-> interface
+                (assoc :members implementors
+                       :fields fields')
+                (dissoc :resolve))))))))
 
 (defn ^:private update-fields-in-object
   [object-def f]

test/com/walmartlabs/interface_test.clj

@@ -99,3 +99,76 @@
     (is (some? (compile compatible-field-nullability))
         "Object fields are allowed to be non-null, even if the interface field is nullable.")))
 
+(def interface-implements-interface
+  '{:interfaces {:node {:fields {:id {:type (non-null String)}}}
+                 :resource {:implements [:node]
+                            :fields {:id {:type (non-null String)}
+                                     :url {:type String}}}}
+    :objects {:article {:implements [:resource]
+                        :fields {:id {:type (non-null String)}
+                                 :url {:type String}
+                                 :title {:type String}}}}})
+
+(deftest interface-can-implement-interface
+  (is (some? (compile interface-implements-interface))
+      "schema with interface implementing interface should compile"))
+
+(deftest object-transitively-implements-parent-interface
+  (let [compiled (compile interface-implements-interface)]
+    ;; :article implements :resource which implements :node.
+    ;; :article should be a member of both :node and :resource.
+    (is (contains? (get-in compiled [:node :members]) :article)
+        "article should be a member of :node (transitively via :resource)")
+    (is (contains? (get-in compiled [:resource :members]) :article)
+        "article should be a member of :resource (directly)")))
+
+(deftest interface-implements-interface-missing-field
+  (let [invalid-schema (assoc-in interface-implements-interface
+                                  [:interfaces :resource :fields]
+                                  {:url {:type 'String}})]
+    ;; :resource implements :node but doesn't declare :id
+    (expect-exception
+      "Missing interface field in interface definition."
+      {:interface :resource
+       :field-name :id
+       :parent-interface-name :node}
+      (compile invalid-schema))))
+
+(deftest interface-circular-implements-fails
+  (testing "direct cycle (A implements B, B implements A)"
+    (let [invalid-schema '{:interfaces {:A {:implements [:B]
+                                            :fields {:id {:type String}}}
+                                        :B {:implements [:A]
+                                            :fields {:id {:type String}}}}}]
+      (is (thrown-with-msg? Throwable #"circular implements chain"
+                            (compile invalid-schema)))))
+
+  (testing "indirect cycle (A implements B, B implements C, C implements A)"
+    (let [invalid-schema '{:interfaces {:A {:implements [:B]
+                                            :fields {:id {:type String}}}
+                                        :B {:implements [:C]
+                                            :fields {:id {:type String}}}
+                                        :C {:implements [:A]
+                                            :fields {:id {:type String}}}}}]
+      (is (thrown-with-msg? Throwable #"circular implements chain"
+                            (compile invalid-schema))))))
+
+(deftest interface-cannot-implement-itself
+  (let [invalid-schema '{:interfaces {:node {:implements [:node]
+                                             :fields {:id {:type String}}}}}]
+    (expect-exception
+      "Interface `node' cannot implement itself."
+      {:interface :node}
+      (compile invalid-schema))))
+
+(deftest interface-implements-non-interface-fails
+  ;; :resource tries to implement :article which is an object, not an interface
+  (let [invalid-schema '{:interfaces {:node {:fields {:id {:type String}}}
+                                      :resource {:implements [:article]
+                                                 :fields {:id {:type String}}}}
+                         :objects {:article {:implements [:node]
+                                             :fields {:id {:type String}}}}}]
+    (is (thrown-with-msg? Throwable
+                          #"Interface `resource' implements type `article', which is not an interface."
+                          (compile invalid-schema)))))
+

test/com/walmartlabs/lacinia/parser/schema_test.clj

@@ -180,6 +180,26 @@
              {:type 'String}}}}}
          (parse-string "interface Flow { ebb : String }"))))
 
+(deftest schema-interface-implements-interface
+  (is (= {:interfaces
+          {:Node {:fields {:id {:type 'ID}}}
+           :Post {:fields {:id {:type 'ID}
+                           :title {:type 'String}}
+                  :implements [:Node]}}}
+         (parse-string "interface Node { id: ID } interface Post implements Node { id: ID title: String }"))))
+
+(deftest schema-interface-implements-multiple-interfaces
+  (is (= {:interfaces
+          {:Node {:fields {:id {:type 'ID}}}
+           :Timestamped {:fields {:createdAt {:type 'String}}}
+           :Post {:fields {:id {:type 'ID}
+                           :createdAt {:type 'String}
+                           :title {:type 'String}}
+                  :implements [:Node :Timestamped]}}}
+         (parse-string (str "interface Node { id: ID } "
+                            "interface Timestamped { createdAt: String } "
+                            "interface Post implements Node & Timestamped { id: ID createdAt: String title: String }")))))
+
 (deftest schema-union
 
   (testing "basic union type"