Fix connect to custom user server

Author: Panthevm

src/clj/vd_designer/aidbox.clj

@@ -29,7 +29,8 @@
   [{:keys [box-url fhir-server-headers]}]
   (let [response @(martian/response-for (aidbox-client/aidbox-client box-url)
                                         :connect
-                                        fhir-server-headers)]
+                                        fhir-server-headers)
+        response (update response :body (fn [b] (if (string? b) (json/parse-string b true) b)))]
     (cond
       (= 503 (:status response))
       {:status 400
@@ -39,6 +40,13 @@
       {:status 400
        :body {:error (str "Can't connect to " box-url)}}
 
+      (= "OperationOutcome" (get-in response [:body :resourceType]))
+      {:status 404
+       :body {:error (->> (get-in response [:body :issue])
+                          (map :diagnostics)
+                          (interpose "; ")
+                          (apply str))}}
+
       :else
       (cond-> response
         (:body response)

src/clj/vd_designer/clients/aidbox.clj

@@ -88,18 +88,108 @@
     :consumes       ["application/json"]
     :method         :get}])
 
+(def custom-user-server-routes
+  [{:route-name     :connect
+    :path-parts     ["/ViewDefinition"]
+    :produces       ["application/json"]
+    :consumes       ["application/json"]
+    :headers-schema {(s/optional-key :Cookie)        s/Str
+                     (s/optional-key :Authorization) s/Str}
+    :method         :get}
+
+   {:route-name     :get-view-definition
+    :path-parts     ["/ViewDefinition/" :vd-id]
+    :path-schema    {:vd-id s/Str}
+    :headers-schema {(s/optional-key :Cookie)        s/Str
+                     (s/optional-key :Authorization) s/Str}
+    :produces       ["application/json"]
+    :consumes       ["application/json"]
+    :method         :get}
+
+   {:route-name     :create-view-definition
+    :path-parts     ["/ViewDefinition"]
+    :headers-schema {(s/optional-key :Cookie)        s/Str
+                     (s/optional-key :Authorization) s/Str}
+    :produces       ["application/json"]
+    :consumes       ["application/json"]
+    :method         :post
+    :body-schema    {:body s/Any}}
+
+   {:route-name     :update-view-definition
+    :path-parts     ["/ViewDefinition/" :vd-id]
+    :path-schema    {:vd-id s/Str}
+    :headers-schema {(s/optional-key :Cookie)        s/Str
+                     (s/optional-key :Authorization) s/Str}
+    :produces       ["application/json"]
+    :consumes       ["application/json"]
+    :method         :put
+    :body-schema    {:body s/Any}}
+
+   {:route-name     :delete-view-definition
+    :path-parts     ["/ViewDefinition/" :vd-id]
+    :path-schema    {:vd-id s/Str}
+    :headers-schema {(s/optional-key :Cookie)        s/Str
+                     (s/optional-key :Authorization) s/Str}
+    :produces       ["application/json"]
+    :consumes       ["application/json"]
+    :method         :delete}
+
+   {:route-name     :view-definition-run
+    :path-parts     ["/ViewDefinition/$run"]
+    :headers-schema {(s/optional-key :Cookie)        s/Str
+                     (s/optional-key :Authorization) s/Str}
+    :produces       ["application/json"]
+    :consumes       ["application/json"]
+    :method         :post
+    :body-schema    {:body s/Any}}
+
+   {:route-name     :get-view-definition-sql
+    :path-parts     ["/ViewDefinition/$sql"]
+    :headers-schema {(s/optional-key :Cookie)        s/Str
+                     (s/optional-key :Authorization) s/Str}
+    :produces       ["application/json"]
+    :consumes       ["application/json"]
+    :method         :post
+    :body-schema    {:body s/Any}}
+
+   {:route-name     :rpc
+    :path-parts     ["/rpc"]
+    :method         :post
+    ;; use middleware for this?
+    :headers-schema {(s/optional-key :Cookie)        s/Str
+                     (s/optional-key :Authorization) s/Str}
+    :produces       ["application/json"]
+    :consumes       ["application/json"]
+    :body-schema    {:body {:method                  s/Symbol
+                            (s/optional-key :params) s/Any}}}
+
+   {:route-name     :metadata
+    :query-schema   {:box-url s/Str}
+    :path-parts     ["/metadata"]
+    :produces       ["application/json"]
+    :consumes       ["application/json"]
+    :method         :get}])
+
 (defn- aidbox-client* [url title]
   (martian/bootstrap
     url
     routes
     {:interceptors (concat [(interceptors/observability title)]
                            martian-http/default-interceptors)}))
 
+(defn- custom-server-client* [url title]
+  (martian/bootstrap
+    url
+    custom-user-server-routes
+    {:interceptors (concat [(interceptors/observability title)]
+                           martian-http/default-interceptors)}))
+
+
 (defn aidbox-portal-client [url]
   (aidbox-client* url "portal"))
 
 (defn custom-server-client [url]
-  (aidbox-client* url "custom-server"))
+  (custom-server-client* url "custom-server"))
 
 (defn aidbox-client [url]
   (cond

src/clj/vd_designer/web/middleware/aidbox_proxy.clj

@@ -19,7 +19,7 @@
     ;; Verify that user has access to the server
     (when-let [user-server (user-server/get-by-account-id-and-box-url db (:id user) box-url)]
       (if (:user_servers/is_custom user-server)
-        (:user_servers/headers user-server)
+        (merge {} (:user_servers/headers user-server))
         {:Cookie (->> user-server
                       :user_servers/aidbox_auth_token
                       (format "aidbox-auth-token=%s;"))}))))