Lafargue: Implement handling of incoming XMPP messages.

4 files changed, 51 insertions, 22 deletions

diff --git a/project.clj b/project.clj
index d6940c3..2809e5c 100644
--- a/project.clj
+++ b/project.clj
@@ -9,6 +9,7 @@
                  [org.clojure/core.match "0.2.0-alpha9"]
                  [org.clojure/core.unify "0.5.1"]
                  [org.clojure/data.codec "0.1.0"]
+                 [org.clojure/data.xml "0.0.3"]
                  [org.clojure/data.zip "0.1.0"]
                  [org.clojure/java.jdbc "0.1.1"]
                  [org.clojure/test.generative "0.1.3"]
diff --git a/src/mulk/benki/id.clj b/src/mulk/benki/id.clj
index e413287..efff197 100644
--- a/src/mulk/benki/id.clj
+++ b/src/mulk/benki/id.clj
@@ -82,8 +82,7 @@
 
 (defn show-profile-page []
   (layout profile-page "A Profile Page"
-    [:body
-     [:p "This is a profile page."]]))
+    [:p "This is a profile page."]))
 
 (defn render-xrds [nickname]
   {:status 200
diff --git a/src/mulk/benki/lazychat.clj b/src/mulk/benki/lazychat.clj
index 754a65a..b1e8c51 100644
--- a/src/mulk/benki/lazychat.clj
+++ b/src/mulk/benki/lazychat.clj
@@ -43,21 +43,13 @@
                     :protected (protected-targets)
                     :public    (cons nil (protected-targets)))))))
 
-(defn push-message-to-xmpp [msg]
-  (let [targets (filter integer? (determine-targets msg))]
-    (enqueue xmpp/messages {:message msg,
-                            :targets targets})))
-
-(defn start-xmpp-pump []
-  (receive-all lafargue-events push-message-to-xmpp))
-
 (defn fill-in-author-details [x]
   x)
 
-(defn create-lazychat-message! [{content  :content,  visibility :visibility
-                                 format   :format,   targets    :targets,
-                                 referees :referees, id         :id}]
-  {:pre [*user*]}
+(defn create-lazychat-message-by-user! [user
+                                        {content  :content,  visibility :visibility
+                                         format   :format,   targets    :targets,
+                                         referees :referees, id         :id}]
   (with-dbt
     (when id
       ;; FIXME: Is this assertion sufficient?  Is it too strict?
@@ -68,7 +60,7 @@
         ["INSERT INTO lazychat_messages(id, author, content, format, visibility)
                VALUES (?, ?, ?, ?, ?)
             RETURNING id"
-         id *user* content format visibility]
+         id user content format visibility]
         (doseq [referee referees]
           (sql/insert-values :lazychat_references
                              [:referrer :referee]
@@ -83,9 +75,29 @@
                     {:content  content,  :visibility visibility,
                      :format   format,   :targets    targets,
                      :referees referees, :id         id,
-                     :author   *user*,   :date       (java.util.Date.)})
+                     :author   user,     :date       (java.util.Date.)})
                    {:type ::lafargue-message}))))))
 
+(defn create-lazychat-message! [msg]
+  {:pre [*user*]}
+  (create-lazychat-message-by-user! *user* msg))
+
+(defn push-message-to-xmpp [msg]
+  (let [targets (filter integer? (determine-targets msg))]
+    (enqueue xmpp/messages {:message msg,
+                            :targets targets})))
+
+(defn- handle-xmpp-message [{sender :sender, body :body}]
+  (let [jid  (first (string/split sender #"/"))
+        user (with-dbt
+               (:user (query1 "SELECT \"user\" FROM user_jids WHERE jid = ?" jid)))]
+    (create-lazychat-message-by-user! user
+                                      {:content    body
+                                       :visibility "protected"
+                                       :format     "markdown"
+                                       :targets    []
+                                       :referees   []})))
+
 (defn select-message [id]
   (let [message  (query1 "SELECT author, content, format, visibility, date
                             FROM lazychat_messages
@@ -247,5 +259,5 @@
       (with-dbt (query1 "SELECT NEXTVAL('lazychat_messages_id_seq')")))))
 
 (defn init-lazychat! []
-  (future
-    (receive-all lafargue-events push-message-to-xmpp)))
+  (receive-all lafargue-events push-message-to-xmpp)
+  (receive-all xmpp/messages-in handle-xmpp-message))
diff --git a/src/mulk/benki/xmpp.clj b/src/mulk/benki/xmpp.clj
index 74c4933..5543402 100644
--- a/src/mulk/benki/xmpp.clj
+++ b/src/mulk/benki/xmpp.clj
@@ -16,11 +16,13 @@
   (:import [org.jivesoftware.smack ConnectionConfiguration
                                    ConnectionConfiguration$SecurityMode
                                    XMPPConnection
-                                   MessageListener]))
+                                   MessageListener
+                                   ChatManagerListener]))
 
 
-(defonce xmpp     (atom nil))
-(defonce messages (channel))
+(defonce xmpp        (atom nil))
+(defonce messages    (channel))
+(defonce messages-in (channel))
 
 
 (defn- connect []
@@ -63,7 +65,8 @@
                                 recipient
                                 (reify MessageListener
                                   (processMessage [self chat message]
-                                    nil)))]
+                                    (when-let [body (.getBody message)]
+                                      (enqueue messages-in {:sender recipient, :body body})))))]
           (.sendMessage chat notification))))))
 
 (defn- startup-client []
@@ -71,7 +74,21 @@
                (fn [{targets :targets, msg :message}]
                  (push-message targets msg))))
 
+(defn- handle-incoming-chats []
+  (doto (.getChatManager @xmpp)
+    (.addChatListener
+     (reify ChatManagerListener
+       (chatCreated [self chat local?]
+         (when-not local?
+           (.addMessageListener
+            chat
+            (reify MessageListener
+              (processMessage [self chat message]
+                (when-let [body (.getBody message)]
+                  (enqueue messages-in {:sender (.getParticipant chat) :body body})))))))))))
+
 (defn init-xmpp! []
   (future
     (reconnect!)
+    (handle-incoming-chats)
     (startup-client)))