<commit_before>(ns clinicico.server.handler
  (:gen-class)
  (:use [org.httpkit.server]
        [compojure.core :only [context ANY GET OPTIONS routes defroutes]]
        [compojure.handler :only [api site]]
        [clinicico.server.util]
        [clinicico.server.middleware]
        [ring.middleware.jsonp]
        [liberator.core :only [resource defresource request-method-in]])
  (:require [clojure.tools.logging :as log]
            [clojure.java.io :only [reader] :as io]
            [clojure.string :only [replace] :as s]
            [ring.util.response :as resp]
            [ring.middleware.reload :as reload]
            [cheshire.core :as json]
            [clinicico.server.resource :as hal]
            [clinicico.server.http :as http]
            [clinicico.server.store :as store]
            [clinicico.server.tasks :only [initialize publish-task
                                           status task-available?] :as tasks]))

(declare in-dev?)

(defn represent-task
  [task url]
  (let [status-url (str url (when-not (.endsWith url "/") "/") "status")
        resource
        (-> (hal/new-resource url)
            (hal/add-link :href status-url
                          :rel "status"
                          :websocket (s/replace status-url #"http(s)?" "ws")
                          :comment "XHR long-polling and WebSocket for status updates")
            (hal/add-properties task))]
    (if (contains? task :results)
      (hal/add-link resource
                    :href (str (http/url-base) "/results/" (:id task))
                    :rel "results")
      resource)))

(defn handle-new-task
  [ctx]
  (let [task (:task ctx)
        url (http/url-from (:request ctx) (:id task))
        resource (represent-task task url)]
    {:status 202
     :headers {"Location" url
               "Content-Type" "application/json"}
     :body (hal/resource->representation resource :json)}))

(def listeners (atom {}))

(defn broadcast-update
  [task]
  (let [id (:id task)
        method (:method task)
        resource (represent-task task (str (http/url-base) "/tasks/" method "/" id "/"))]
    (doseq [client (get @listeners id)]
      (send! client (hal/resource->representation resource :json)))))

(defn task-status
  [request]
  (with-channel request channel
    (let [id (get-in request [:route-params :id])
          status (tasks/status id)
          current-listeners (get @listeners id #{})]
      (if (nil? status)
        (send! channel (resp/status (resp/response "Task not found") 404))
        (do
          (swap! listeners assoc id (merge current-listeners channel))
          (when (or (contains? #{"failed" "completed"} (:status status))
                    (get-in request [:params :latest]))
            (broadcast-update status))
          (on-close channel (fn [_]
                              (swap! listeners dissoc id))))))))

(defresource tasks-resource
  :available-media-types ["application/json"]
  :available-charsets ["utf-8"]
  :method-allowed? (request-method-in :options :post :get)
  :generate-options-header (fn [_] {"Allow" "OPTIONS, GET, POST"})
  :service-available? (fn [ctx]
                        (tasks/task-available?
                          (get-in ctx [:request :route-params :method])))
  :handle-ok (fn [ctx] (json/encode {:status "Up and running"}))
  :handle-created handle-new-task
  :post! (fn [ctx]
           (let [callback broadcast-update
                 method (get-in ctx [:request :route-params :method])
                 body (get-in ctx [:request :body])
                 payload (when body (slurp body))]
             (assoc ctx :task (tasks/publish-task method payload callback)))))

(defresource task-resource
  :available-media-types ["application/json"]
  :available-charsets ["utf-8"]
  :method-allowed? (request-method-in :options :delete :get)
  :generate-options-header (fn [_] {"Allow" "OPTIONS, GET, DELETE"})
  :exists? (fn [ctx] (not (nil?
                            (tasks/status
                              (get-in ctx [:request :params :id])))))
  :handle-ok (fn [ctx]
               (let [id (get-in ctx [:request :params :id])
                     task (tasks/status id)
                     resource (represent-task task (http/url-from (:request ctx)))]
                 (if (get task :results false)
                   {:body nil
                    :status 303
                    :headers {"Location"
                              (str (http/url-base (:request ctx)) "/results/" id)}}
                   (hal/resource->representation resource :json)))))

(defn represent-result
  [result]
  (let [location (str (http/url-base) "/results/" (:id result) "/")
        self {:rel "self" :href location}
        files (:files result)
        embedded (map (fn [x] {:href (str location (:name x))
                               :type (:mime x)}) files)]
    (assoc
      (dissoc result :files) :_links [self] :_embedded {:_files embedded})))


(defresource result-resource
  :available-media-types ["application/json"]
  :available-charsets ["utf-8"]
  :method-allowed? (request-method-in :options :get)
  :generate-options-header (fn [_] {"Allow" "OPTIONS, GET"})
  :exists? (fn [ctx]
             (let [id (get-in ctx [:request :params :id])
                   result (store/get-result id)]
               (if (nil? result)
                 [false {}]
                 {::result result})))
  :handle-ok (fn [ctx] (json/encode (represent-result (::result ctx)))))

(def match-uuid #"[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}")
(defn assemble-routes []
  (->
    (routes
      (context "/results" []
               (GET "/:id/:file" [id file]
                    (let [record (store/get-file id file)]
                      (if (nil? record)
                        (resp/not-found nil)
                        (-> (resp/response (.getInputStream record))
                            (resp/content-type (:content-type (.getContentType record)))
                            (resp/header "Content-Length" (.getLength record))))))
               (ANY ["/:id" :id match-uuid] [id] result-resource))
      (context "/tasks" []
               (ANY "/:method" [method] tasks-resource)
               (GET ["/:method/:id/status" :id match-uuid] [method id] task-status)
               (OPTIONS ":/method/:id/status" [] (http/options #{:options :get}))
               (ANY ["/:method/:id" :id match-uuid] [method id] task-resource))
      (GET "/" [] (resp/resource-response "index.html" {:root "public"}))
      (ANY "/*" [] static))))

(def app
  (->
    (assemble-routes)
    (wrap-json-with-padding)
    (api)
    (ignore-trailing-slash)
    (wrap-cors-request)
    (wrap-request-logger)
    (wrap-exception-handler)
    (wrap-response-logger)))

(defn -main
  [& args]
  (def in-dev? (= "--development" (first args)))
  (let [handler (if in-dev? (reload/wrap-reload app) app)]
    (tasks/initialize)
    (run-server handler {:port 3000})))
<commit_msg>Use correct route for OPTIONS on status<commit_after>(ns clinicico.server.handler
  (:gen-class)
  (:use [org.httpkit.server]
        [compojure.core :only [context ANY GET OPTIONS routes defroutes]]
        [compojure.handler :only [api site]]
        [clinicico.server.util]
        [clinicico.server.middleware]
        [ring.middleware.jsonp]
        [liberator.core :only [resource defresource request-method-in]])
  (:require [clojure.tools.logging :as log]
            [clojure.java.io :only [reader] :as io]
            [clojure.string :only [replace] :as s]
            [ring.util.response :as resp]
            [ring.middleware.reload :as reload]
            [cheshire.core :as json]
            [clinicico.server.resource :as hal]
            [clinicico.server.http :as http]
            [clinicico.server.store :as store]
            [clinicico.server.tasks :only [initialize publish-task
                                           status task-available?] :as tasks]))

(declare in-dev?)

(defn represent-task
  [task url]
  (let [status-url (str url (when-not (.endsWith url "/") "/") "status")
        resource
        (-> (hal/new-resource url)
            (hal/add-link :href status-url
                          :rel "status"
                          :websocket (s/replace status-url #"http(s)?" "ws")
                          :comment "XHR long-polling and WebSocket for status updates")
            (hal/add-properties task))]
    (if (contains? task :results)
      (hal/add-link resource
                    :href (str (http/url-base) "/results/" (:id task))
                    :rel "results")
      resource)))

(defn handle-new-task
  [ctx]
  (let [task (:task ctx)
        url (http/url-from (:request ctx) (:id task))
        resource (represent-task task url)]
    {:status 202
     :headers {"Location" url
               "Content-Type" "application/json"}
     :body (hal/resource->representation resource :json)}))

(def listeners (atom {}))

(defn broadcast-update
  [task]
  (let [id (:id task)
        method (:method task)
        resource (represent-task task (str (http/url-base) "/tasks/" method "/" id "/"))]
    (doseq [client (get @listeners id)]
      (send! client (hal/resource->representation resource :json)))))

(defn task-status
  [request]
  (with-channel request channel
    (let [id (get-in request [:route-params :id])
          status (tasks/status id)
          current-listeners (get @listeners id #{})]
      (if (nil? status)
        (send! channel (resp/status (resp/response "Task not found") 404))
        (do
          (swap! listeners assoc id (merge current-listeners channel))
          (when (or (contains? #{"failed" "completed"} (:status status))
                    (get-in request [:params :latest]))
            (broadcast-update status))
          (on-close channel (fn [_]
                              (swap! listeners dissoc id))))))))

(defresource tasks-resource
  :available-media-types ["application/json"]
  :available-charsets ["utf-8"]
  :method-allowed? (request-method-in :options :post :get)
  :generate-options-header (fn [_] {"Allow" "OPTIONS, GET, POST"})
  :service-available? (fn [ctx]
                        (tasks/task-available?
                          (get-in ctx [:request :route-params :method])))
  :handle-ok (fn [ctx] (json/encode {:status "Up and running"}))
  :handle-created handle-new-task
  :post! (fn [ctx]
           (let [callback broadcast-update
                 method (get-in ctx [:request :route-params :method])
                 body (get-in ctx [:request :body])
                 payload (when body (slurp body))]
             (assoc ctx :task (tasks/publish-task method payload callback)))))

(defresource task-resource
  :available-media-types ["application/json"]
  :available-charsets ["utf-8"]
  :method-allowed? (request-method-in :options :delete :get)
  :generate-options-header (fn [_] {"Allow" "OPTIONS, GET, DELETE"})
  :exists? (fn [ctx] (not (nil?
                            (tasks/status
                              (get-in ctx [:request :params :id])))))
  :handle-ok (fn [ctx]
               (let [id (get-in ctx [:request :params :id])
                     task (tasks/status id)
                     resource (represent-task task (http/url-from (:request ctx)))]
                 (if (get task :results false)
                   {:body nil
                    :status 303
                    :headers {"Location"
                              (str (http/url-base (:request ctx)) "/results/" id)}}
                   (hal/resource->representation resource :json)))))

(defn represent-result
  [result]
  (let [location (str (http/url-base) "/results/" (:id result) "/")
        self {:rel "self" :href location}
        files (:files result)
        embedded (map (fn [x] {:href (str location (:name x))
                               :type (:mime x)}) files)]
    (assoc
      (dissoc result :files) :_links [self] :_embedded {:_files embedded})))


(defresource result-resource
  :available-media-types ["application/json"]
  :available-charsets ["utf-8"]
  :method-allowed? (request-method-in :options :get)
  :generate-options-header (fn [_] {"Allow" "OPTIONS, GET"})
  :exists? (fn [ctx]
             (let [id (get-in ctx [:request :params :id])
                   result (store/get-result id)]
               (if (nil? result)
                 [false {}]
                 {::result result})))
  :handle-ok (fn [ctx] (json/encode (represent-result (::result ctx)))))

(def match-uuid #"[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}")
(defn assemble-routes []
  (->
    (routes
      (context "/results" []
               (GET "/:id/:file" [id file]
                    (let [record (store/get-file id file)]
                      (if (nil? record)
                        (resp/not-found nil)
                        (-> (resp/response (.getInputStream record))
                            (resp/content-type (:content-type (.getContentType record)))
                            (resp/header "Content-Length" (.getLength record))))))
               (ANY ["/:id" :id match-uuid] [id] result-resource))
      (context "/tasks" []
               (OPTIONS ["/:method/:id/status" :id match-uuid] [] (http/options #{:options :get}))
               (GET ["/:method/:id/status" :id match-uuid] [method id] task-status)
               (ANY "/:method" [method] tasks-resource)
               (ANY ["/:method/:id" :id match-uuid] [method id] task-resource))
      (GET "/" [] (resp/resource-response "index.html" {:root "public"}))
      (ANY "/*" [] static))))

(def app
  (->
    (assemble-routes)
    (wrap-json-with-padding)
    (api)
    (ignore-trailing-slash)
    (wrap-cors-request)
    (wrap-request-logger)
    (wrap-exception-handler)
    (wrap-response-logger)))

(defn -main
  [& args]
  (def in-dev? (= "--development" (first args)))
  (let [handler (if in-dev? (reload/wrap-reload app) app)]
    (tasks/initialize)
    (run-server handler {:port 3000})))

{'fraction_non_alphanumeric': 0.15812424047465867, 'fraction_numerical': 0.004575023232539853, 'mean_word_length': 2.022904062229905, 'pattern_counts': {'":': 1, '<': 3, '<?xml version=': 0, '>': 17, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3505740', 'n_tokens_mistral': 4331, 'n_tokens_neox': 4168, 'n_words': 1104}