From 9fa17f6f6ca64c1a1f7e2bb72f12d1fadac74ba8 Mon Sep 17 00:00:00 2001
From: heyarne <arne@schlueter.is>
Date: Sun, 10 May 2020 23:27:55 +0200
Subject: [PATCH] Write upload handler

---
 deps.edn                              |  3 +-
 src/heyarne/all_my_friends/server.clj | 15 ++++---
 src/heyarne/all_my_friends/views.cljs | 62 +++++++++++++++++++++++++--
 3 files changed, 68 insertions(+), 12 deletions(-)

diff --git a/deps.edn b/deps.edn
index aaa67c0..fca6444 100644
--- a/deps.edn
+++ b/deps.edn
@@ -10,7 +10,8 @@
  ;; clojurescript build tool and dependencies (see also shadow-cljs.edn)
  {:cljs {:extra-deps {thheller/shadow-cljs {:mvn/version "2.8.109"}
                       appliedscience/js-interop {:mvn/version "0.2.5"}
-                      reagent {:mvn/version "1.0.0-alpha1"}}}
+                      reagent {:mvn/version "1.0.0-alpha1"}
+                      cljs-http {:mvn/version "0.1.46"}}}
 
   ;; packaging the server as a standalone jar for production
   :uberjar {:extra-deps {luchiniatwork/cambada {:mvn/version "1.0.2"}}
diff --git a/src/heyarne/all_my_friends/server.clj b/src/heyarne/all_my_friends/server.clj
index ef0136f..a5d6dd0 100644
--- a/src/heyarne/all_my_friends/server.clj
+++ b/src/heyarne/all_my_friends/server.clj
@@ -9,12 +9,13 @@
 
 (def rfc3339 (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ssXXX"))
 
-(defn upload! [file id]
+(defn upload! [file predictions]
   (let [now (.format rfc3339 (java.util.Date.))
         uuid (java.util.UUID/randomUUID)
-        ext (re-find #"\.[\w]+$" (-> file :filename))]
-    (io/copy (-> file :tempfile)
-             (io/file (str "uploads/" id "--" now "--" uuid ext)))))
+        ext (re-find #"\.[\w]+$" (-> file :filename))
+        filename (str "uploads/" now "--" uuid)]
+    (io/copy (-> file :tempfile) (io/file (str filename ext)))
+    (spit (str filename ".json") predictions)))
 
 (def app
   (ring/ring-handler
@@ -22,10 +23,10 @@
     [["/upload"
       ;; TODO: Verify params
       {:post (fn [req]
-               (let [{:keys [file friend]} (-> req :params)]
-                 (upload! file friend)
+               (let [{:keys [snapshot predictions]} (-> req :params)]
+                 (upload! snapshot predictions)
                  {:status 201
-                  :body (str "Thanks, " friend)}))}]]
+                  :body (str "Thanks :)")}))}]]
     ["/*" (ring/create-resource-handler)])))
 
 (defonce server (atom nil))
diff --git a/src/heyarne/all_my_friends/views.cljs b/src/heyarne/all_my_friends/views.cljs
index 0b9a9d5..6fbee2b 100644
--- a/src/heyarne/all_my_friends/views.cljs
+++ b/src/heyarne/all_my_friends/views.cljs
@@ -1,5 +1,7 @@
 (ns heyarne.all-my-friends.views
   (:require [reagent.core :as r]
+            [cljs-http.client :as http]
+            [cljs.core.async :refer [<! go]]
             [heyarne.all-my-friends.facemesh :refer [webcam-facemesh]]
             [heyarne.all-my-friends.visualize :as vis]))
 
@@ -7,13 +9,41 @@
 
 (defonce state (r/atom {:status :welcome-message}))
 
+(declare dispatch)
+
 (def events
   {:welcome/continue (fn [db _]
                        (assoc db :status :running))
    :running/snapshot (fn [db result]
                        (assoc-in db [:snapshots :current] result))
    :running/discard-snapshot (fn [db _]
-                               (update db :snapshots dissoc :current))})
+                               (update db :snapshots dissoc :current))
+   :upload/post (fn [db post-body]
+                     ;; TODO: This is a bit dirty compared to the others because it
+                     ;; shoehorns http requests and database changes together
+                     (let [req (http/post "/upload" {:multipart-params post-body})]
+                       (println "request started")
+                       (go (let [{:keys [success body error-text] :as res} (<! req)]
+                             (prn res)
+                             (if success
+                               (dispatch [:upload/done (:message body)])
+                               (dispatch [:upload/error error-text]))
+                             (println "request finished")))
+                       (assoc db :in-progress? true)))
+   :upload/error (fn [db message]
+                   (dispatch [:message/show {:message message, :type :error}])
+                   (dissoc db :in-progress?))
+   :upload/done (fn [db _]
+                  (dispatch [:message/show {:message "Tippi toppi!", :type :success}])
+                  (dissoc db :in-progress?))
+   :message/show (fn [db {:keys [message type]}]
+                   (let [message-id (* (Math/random) (js/Date.now))]
+                     (when (= type :success)
+                       (js/window.setTimeout #(dispatch [:message/hide message-id]) 2500))
+                     (assoc-in db [:messages message-id] {:type type
+                                                          :message message})))
+   :message/hide (fn [db message-id]
+                   (update db :messages dissoc message-id))})
 
 (defn dispatch [[event data]]
   (when-let [handler (events event)]
@@ -39,6 +69,14 @@ Seit der globalen Covid19-Pandemie sind wir alle dazu gezwungen, auf physischen
     (.drawImage ctx video-elem 0 0 (.-width canvas) (.-height canvas))
     (.getImageData ctx 0 0 (.-width canvas) (.-height canvas))))
 
+(defn image-data->blob [img-data cb]
+  (let [canvas (js/document.createElement "canvas")
+        ctx (.getContext canvas "2d")]
+    (set! (.-width canvas) (.-width img-data))
+    (set! (.-height canvas) (.-height img-data))
+    (.putImageData ctx img-data 0 0)
+    (.toBlob canvas cb "image/png")))
+
 (defn preview [{{:keys [video predictions]} :snapshot}]
   (let [canvas (js/document.createElement "canvas")
         ctx (.getContext canvas "2d")]
@@ -55,9 +93,20 @@ Seit der globalen Covid19-Pandemie sind wir alle dazu gezwungen, auf physischen
     [:div#snapshot-preview.container
      [:p compliment]
      [preview {:snapshot current-snapshot}]
-     [:button {:on-click #(println "submit")} "Abschicken"]
+     [:button {:on-click #(image-data->blob (:video current-snapshot)
+                                            (fn [blob]
+                                              (dispatch
+                                               [:upload/post {:snapshot blob
+                                                              :predictions (js/JSON.stringify (:predictions current-snapshot))}])))}
+      "Abschicken"]
      [:button {:on-click #(dispatch [:running/discard-snapshot])} "Lieber noch eins"]]))
 
+(defn notifications [{:keys [messages]}]
+  [:ul.notifications
+   (for [[id {:keys [type message]}] messages]
+     ^{:key id} [:li.message {:class (name type)
+                              :on-click #(dispatch [:message/hide id])} message])])
+
 (defn running [{:keys [on-faces-detected halt?]}]
   (let [result (atom {:video nil
                       :predictions nil})]
@@ -75,15 +124,20 @@ Seit der globalen Covid19-Pandemie sind wir alle dazu gezwungen, auf physischen
 (defn app []
   (let [state @state
         status (:status state)
-        current-snapshot (get-in state [:snapshots :current])]
+        messages (:messages state)
+        current-snapshot (get-in state [:snapshots :current])
+        uploading? (some? (get-in state [:http/requests "/upload"]))]
+    (prn messages)
     [:<>
      [welcome-message {:hidden? (not= :welcome-message status)}]
+     [notifications {:messages messages}]
+     (when uploading?
+       [:p "Bild wird hochgeladen"])
      (when current-snapshot
        [snapshot {:current-snapshot current-snapshot}])
      (case status
        :permission-rejected [:div "Sad :("]
        :running [running {:on-faces-detected vis/draw-sketch
                           :halt? (some? current-snapshot)}]
-
        ;; default
        nil)]))