Modify federation to be possible with edn schema as well

deps.edn

@@ -1,7 +1,8 @@
 {:deps {org.clojure/clojure {:mvn/version "1.10.3"}
         clj-antlr/clj-antlr {:mvn/version "0.2.12"}
         org.flatland/ordered {:mvn/version "1.15.10"}
-        org.clojure/data.json {:mvn/version "2.4.0"}}
+        org.clojure/data.json {:mvn/version "2.4.0"}
+        org.clojure/core.match {:mvn/version "1.0.0"}}
  :paths ["src" "resources"]
  :aliases
  {:dev
@@ -51,4 +52,4 @@
 
  :codox/config
  {:description "Clojure-native implementation of GraphQL"
-  :source-uri "https://github.com/walmartlabs/lacinia/blob/master/{filepath}#L{line}"}}
+  :source-uri "https://github.com/walmartlabs/lacinia/blob/master/{filepath}#L{line}"}}

dev-resources/edn-federation.edn

@@ -0,0 +1,77 @@
+{:objects
+ {:_Service
+  {:fields
+   {:sdl
+    {:type (non-null String)}}}
+  :User
+  {:fields
+   {:id
+    {:type (non-null Int)}
+    :name
+    {:type (non-null String)}}
+   :directives [{:directive-type :key :directive-args {:fields "id"}}]}
+  :Query
+  {:fields
+   {:user_by_id
+    {:type :User :args
+     {:id
+      {:type (non-null Int)}}}}}
+  :Account
+  {:fields
+   {:acct_number
+    {:type (non-null String)} :name
+    {:type (non-null String)}}
+   :directives [{:directive-type :key :directive-args {:fields "acct_number"}}]}
+  :Product
+  {:fields
+   {:upc
+    {:type (non-null String) :directives [{:directive-type :external}]} :reviewed_by
+    {:type :User}}
+   :directives [{:directive-type :key :directive-args {:fields "upc"}}
+                {:directive-type :extends}]}}
+ :scalars
+ {:_Any
+  {:parse :_Any/parser,
+   :serialize :_Any/serializer},
+  :_FieldSet
+  {:parse :_FieldSet/parser,
+   :serialize :_FieldSet/serializer}
+  :link__Import
+  {:parse :link__Import/parser,
+   :serialize :link__Import/serializer}}
+
+ :enums
+ {:link__Purpose
+  {:values [{:enum-value :SECURITY} {:enum-value :EXECUTION}]}}
+
+ :directive-defs
+ {:external
+  {:locations #{:field-definition}}
+  :requires
+  {:locations #{:field-definition}
+   :args {:fields {:type (non-null _FieldSet)}}}
+  :provides
+  {:locations #{:field-definition}
+   :args {:fields {:type (non-null _FieldSet)}}}
+  :key
+  {:locations #{:object :interface}
+   :args {:fields {:type (non-null _FieldSet)}
+          :resolvable {:type Boolean :default-value true}}}
+  :link
+  {:locations #{:schema},
+   :args {:url {:type String}, :as {:type String}, :for {:type :link__Purpose}, :import {:type (list :link__Import)}}}
+  :shareable {:locations #{:field-definition :object}},
+  :inaccessible
+  {:locations
+   #{:enum
+     :input-field-definition
+     :interface
+     :input-object
+     :enum-value
+     :scalar
+     :argument-definition
+     :union
+     :field-definition
+     :object}},
+  :override {:locations #{:field-definition}, :args {:from {:type (non-null String)}}},
+  :extends {:locations #{:interface :object}}}}

dev-resources/edn-federation.sdl

@@ -0,0 +1,34 @@
+type _Service{
+sdl: String!
+}
+type User @key(fields: "id") {
+id: Int!
+name: String!
+}
+type Query{
+user_by_id(id: Int!): User
+}
+type Account @key(fields: "acct_number") {
+acct_number: String!
+name: String!
+}
+type Product @key(fields: "upc") @extends {
+upc: String!
+reviewed_by: User
+}
+scalar _Any
+scalar _FieldSet
+scalar link__Import
+enum link__Purpose{
+SECURITY
+EXECUTION
+}
+directive @extends on INTERFACE | OBJECT
+directive @key(fields: _FieldSet!, resolvable: Boolean = true) on INTERFACE | OBJECT
+directive @external on FIELD_DEFINITION
+directive @shareable on FIELD_DEFINITION | OBJECT
+directive @requires(fields: _FieldSet!) on FIELD_DEFINITION
+directive @link(url: String, as: String, for: link__Purpose, import: [link__Import]) on SCHEMA
+directive @provides(fields: _FieldSet!) on FIELD_DEFINITION
+directive @override(from: String!) on FIELD_DEFINITION
+directive @inaccessible on ENUM | INPUT_FIELD_DEFINITION | INTERFACE | INPUT_OBJECT | ENUM_VALUE | SCALAR | ARGUMENT_DEFINITION | UNION | FIELD_DEFINITION | OBJECT

docs/federation/index.rst

@@ -14,11 +14,6 @@ service-spanning queries apart and build an overall query plan.
 Lacinia has been extended, starting in 0.38.0, to support acting as an implementing service; there is no plan
 at this time to act as a gateway.
 
-.. warning::
-
-    At this time, only a schema defined with the :doc:`Schema Definition Language </schema/parsing>`, can be extended to act as
-    a service implementation.
-
 Essentially, federation allows a set of services to each provide their own types, queries, and mutations, and organizes things so that
 each service can provide additional fields to the types provided by the other services.
 

src/com/walmartlabs/lacinia/federation.clj

@@ -14,11 +14,13 @@
 
 (ns com.walmartlabs.lacinia.federation
   (:require
-    [com.walmartlabs.lacinia.resolve :as resolve :refer [with-error]]
-    [com.walmartlabs.lacinia.internal-utils :as utils :refer [get-nested]]
-    [com.walmartlabs.lacinia.resolve-utils :as ru]
-    [com.walmartlabs.lacinia.schema :as schema]
-    [clojure.spec.alpha :as s]))
+   [com.walmartlabs.lacinia.resolve :as resolve :refer [with-error]]
+   [com.walmartlabs.lacinia.internal-utils :as utils :refer [get-nested]]
+   [com.walmartlabs.lacinia.resolve-utils :as ru]
+   [com.walmartlabs.lacinia.schema :as schema]
+   [clojure.spec.alpha :as s]
+   [clojure.string :refer [join]]
+   [clojure.core.match :refer [match]]))
 
 (def foundation-types
   "Map of annotations and types to automatically include into an SDL
@@ -119,25 +121,215 @@
 
           (ru/aggregate-results results #(maybe-wrap (reduce into [] %))))))))
 
+(defn ^:private apply-list
+  [f x]
+  (if (-> x first seq?)
+    (apply f x)
+    (f x)))
+
+(defn ^:private edn-description->sdl-description
+  [description]
+  (if (nil? description)
+    ""
+    (str "\"\"\"\n" description "\n\"\"\"\n")))
+
+(defn ^:private edn-type->sdl-type
+  [type]
+  (if (seq? type)
+    (let [[hd & tl] type]
+      (match hd
+        nil ""
+        'non-null (str (apply-list edn-type->sdl-type tl) "!")
+        'list (str "[" (apply-list edn-type->sdl-type tl) "]")
+        'String "String"
+        'Int "Int"
+        'Float "Float"
+        'Boolean "Boolean"
+        'ID "ID"
+        (object :guard keyword?) (name object)
+        (scalar :guard symbol?) (name scalar)))
+    (recur (list type))))
+
+(defn ^:private value->string
+  [value]
+  (match value
+    (string :guard string?) (str "\"" string "\"")
+    (keyword :guard keyword?) (name keyword)
+    else (str else)))
+
+(defn ^:private edn-default-value->sdl-default-value
+  [default-value]
+  (if (nil? default-value)
+    ""
+    (str " = " (value->string default-value))))
+
+(defn ^:private edn-arg-descrption->sdl-arg-description
+  [description]
+  (if (nil? description)
+    ""
+    (str "\"" description "\" ")))
+
+(defn ^:private edn-args->sdl-args
+  [args]
+  (if (nil? args)
+    ""
+    (str "(" (join ", " (map (fn [[arg-name {:keys [type default-value description]}]] (str (edn-arg-descrption->sdl-arg-description description) (name arg-name) ": " (edn-type->sdl-type type) (edn-default-value->sdl-default-value default-value))) args)) ")")))
+
+(defn ^:private edn-directive-args->sdl-directive-args
+  [directive-args]
+  (if (nil? directive-args)
+    ""
+    (str "(" (->> directive-args
+                  (map (fn [[arg-name arg-value]] (str (name arg-name) ": " (value->string arg-value))))
+                  (join ", ")) ")")))
+
+(defn ^:private edn-directives->sdl-directives
+  [directives]
+  (if (nil? directives)
+    ""
+    (str " "
+         (->> directives
+              (map (fn [{:keys [directive-type directive-args]}]
+                     (str "@" (name directive-type) (edn-directive-args->sdl-directive-args directive-args))))
+              (join " ")) " ")))
+
+(defn ^:private edn-fields->sdl-fields
+  [fields]
+  (str
+   "{\n"
+   (->> fields
+        (map (fn [[field-name {:keys [type args description]}]]
+               (str (edn-description->sdl-description description) (name field-name) (edn-args->sdl-args args) ": " (edn-type->sdl-type type))))
+        (join "\n"))
+   "\n}"))
+
+(defn ^:private edn-objects->sdl-objects
+  [objects]
+  (->> objects
+       (map (fn [[key {:keys [fields directives description]}]]
+              (str (edn-description->sdl-description description)
+                   "type "
+                   (name key)
+                   (edn-directives->sdl-directives directives)
+                   (edn-fields->sdl-fields fields))))
+       (join "\n")))
+(defn ^:private edn-queries->sdl-queries
+  [queries]
+  (str (-> queries :description edn-description->sdl-description) "type Query " (edn-fields->sdl-fields queries)))
+
+(defn ^:private edn-interfaces->sdl-interfaces
+  [interfaces]
+  (->> interfaces
+       (map (fn [[key val]]
+              (str "interface "
+                   (name key)
+                   (-> val :fields edn-fields->sdl-fields))))
+       (join "\n")))
+(defn ^:private edn-input-objects->sdl-input-objects
+  [input-objects]
+  (->> input-objects
+       (map (fn [[key val]]
+              (str "input "
+                   (name key)
+                   (-> val :fields edn-fields->sdl-fields))))
+       (join "\n")))
+(defn ^:private edn-unions->sdl-unions
+  [unions]
+  (->> unions
+       (map (fn [[union-name {members :members}]]
+              (str "union " (name union-name) " = " (->> members
+                                                         (map name)
+                                                         (join " | ")))))
+       (join "\n")))
+(defn ^:private edn-mutations->sdl-mutations
+  [mutations]
+  (str "type Mutation " (edn-fields->sdl-fields mutations)))
+
+(defn ^:private edn-enum-value->sdl-enum-value
+  [enum-value]
+  (match enum-value
+    {:enum-value value} value
+    (value :guard keyword?) value))
+
+(defn ^:private edn-enums->sdl-enums
+  [enums]
+  (->> enums
+       (map (fn [[enum-name {values :values}]]
+              (str "enum " (name enum-name) "{\n" (->> values (map edn-enum-value->sdl-enum-value) (map name) (join "\n")) "\n}")))
+       (join "\n")))
+(defn ^:private edn-scalars->sdl-scalars
+  [scalars]
+  (->> (keys scalars)
+       (map name)
+       (map #(str "scalar " %))
+       (join "\n")))
+
+(def directive-targets
+  {:enum                   "ENUM"
+   :input-field-definition "INPUT_FIELD_DEFINITION"
+   :interface              "INTERFACE"
+   :input-object           "INPUT_OBJECT"
+   :enum-value             "ENUM_VALUE"
+   :scalar                 "SCALAR"
+   :argument-definition    "ARGUMENT_DEFINITION"
+   :union                  "UNION"
+   :field-definition       "FIELD_DEFINITION"
+   :object                 "OBJECT"
+   :schema                 "SCHEMA"})
+
+(defn ^:private edn-directive-defs->sdl-directives
+  [directive-defs]
+  (->> directive-defs
+       (map (fn [[directive-name {:keys [locations args]}]]
+              (str "directive @"
+                   (name directive-name)
+                   (edn-args->sdl-args args)
+                   " on "
+                   (->> locations
+                        (map directive-targets)
+                        (join " | ")))))
+       (join "\n")))
+
+(defn generate-sdl
+  "Translate the edn lacinia schema to the SDL schema."
+  [schema]
+  (->> schema
+       (map (fn [[key val]]
+              (case key
+                :objects (edn-objects->sdl-objects val)
+                :queries (edn-queries->sdl-queries val)
+                :interfaces (edn-interfaces->sdl-interfaces val)
+                :scalars (edn-scalars->sdl-scalars val)
+                :unions (edn-unions->sdl-unions val)
+                :input-objects (edn-input-objects->sdl-input-objects val)
+                :mutations (edn-mutations->sdl-mutations val)
+                :enums (edn-enums->sdl-enums val)
+                :directive-defs (edn-directive-defs->sdl-directives val)
+                :roots "")))
+       (join "\n")))
+
 (defn inject-federation
   "Called after SDL parsing to extend the input schema
-  (not the compiled schema) with federation support."
-  [schema sdl entity-resolvers]
-  (let [entity-names (find-entity-names schema)
-        entities-resolver (entities-resolver-factory entity-names entity-resolvers)
-        query-root (get-nested schema [:roots :query] :Query)]
-    (prevent-collision schema [:unions :_Entity])
-    (prevent-collision schema [:objects query-root :fields :_service])
-    (prevent-collision schema [:objects query-root :fields :_entities])
-    (cond-> (assoc-in schema [:objects query-root :fields :_service]
-                      {:type '(non-null :_Service)
-                       :resolve (fn [_ _ _] {:sdl sdl})})
-      entity-names (-> (assoc-in [:unions :_Entity :members] entity-names)
-                       (assoc-in [:objects query-root :fields :_entities]
-                                 {:type '(non-null (list :_Entity))
-                                  :args
-                                  {:representations
-                                   {:type '(non-null (list (non-null :_Any)))}}
-                                  :resolve entities-resolver})))))
+  (not the compiled schema) with federation support.
+   If the SDL string is not given, it is automatically created through the schema."
+  ([schema entity-resolvers]
+   (inject-federation schema (generate-sdl schema) entity-resolvers))
+  ([schema sdl entity-resolvers]
+   (let [entity-names (find-entity-names schema)
+         entities-resolver (entities-resolver-factory entity-names entity-resolvers)
+         query-root (get-nested schema [:roots :query] :Query)]
+     (prevent-collision schema [:unions :_Entity])
+     (prevent-collision schema [:objects query-root :fields :_service])
+     (prevent-collision schema [:objects query-root :fields :_entities])
+     (cond-> (assoc-in schema [:objects query-root :fields :_service]
+                       {:type '(non-null :_Service)
+                        :resolve (fn [_ _ _] {:sdl sdl})})
+       entity-names (-> (assoc-in [:unions :_Entity :members] entity-names)
+                        (assoc-in [:objects query-root :fields :_entities]
+                                  {:type '(non-null (list :_Entity))
+                                   :args
+                                   {:representations
+                                    {:type '(non-null (list (non-null :_Any)))}}
+                                   :resolve entities-resolver}))))))
 
 (s/def ::entity-resolvers (s/map-of simple-keyword? ::schema/resolve))