Initial checkin
This commit is contained in:
commit
cc05911a99
|
@ -0,0 +1,9 @@
|
|||
.DS_Store
|
||||
.idea
|
||||
*.log
|
||||
tmp/
|
||||
|
||||
.cpcache/
|
||||
.nrepl-port
|
||||
target/
|
||||
result
|
|
@ -0,0 +1,16 @@
|
|||
{
|
||||
:paths ["src"]
|
||||
:deps {
|
||||
org.clojure/clojure { :mvn/version "1.11.1" }
|
||||
org.clojure/tools.cli {:mvn/version "1.0.214"}
|
||||
metosin/malli { :mvn/version "0.11.0" }
|
||||
org.fudo/fudo-clojure {
|
||||
:git/url "https://git.fudo.org/fudo-public/fudo-clojure.git"
|
||||
:git/sha "2352892ad7d7cf7c6bd294005a28d55ef224862a"
|
||||
}
|
||||
org.fudo/milquetoast {
|
||||
:git/url "https://git.fudo.org/fudo-public/milquetoast.git"
|
||||
:git/sha "ae81b91f0c710632f55b43f0193e16ab0dd81dde"
|
||||
}
|
||||
}
|
||||
}
|
|
@ -0,0 +1,71 @@
|
|||
(ns snooper.cli
|
||||
(:require [clojure.core.async :as async :refer [>!! <!!]]
|
||||
[clojure.tools.cli :as cli]
|
||||
[clojure.set :as set]
|
||||
[clojure.string :as str]
|
||||
[snooper.core :as snooper]
|
||||
[milquetoast.client :as mqtt]
|
||||
[fudo-clojure.logging :as log]))
|
||||
|
||||
(def cli-opts
|
||||
[["-v" "--verbose" "Provide verbose output."]
|
||||
|
||||
[nil "--mqtt-host HOSTNAME" "Hostname of MQTT server."]
|
||||
[nil "--mqtt-port PORT" "Port on which to connect to the MQTT server."
|
||||
:parse-fn #(Integer/parseInt %)]
|
||||
[nil "--mqtt-user USER" "User as which to connect to MQTT server."]
|
||||
[nil "--mqtt-password-file PASSWD_FILE" "File containing password for MQTT user."]
|
||||
|
||||
[nil "--event-topic EVT_TOPIC" "MQTT topic to which events should be published."
|
||||
:multi true
|
||||
:update-fn conj]
|
||||
[nil "--notification-topic NOTIFY_TOPIC" "Topic to which notifications will be sent."]])
|
||||
|
||||
(defn- msg-quit [status msg]
|
||||
(println msg)
|
||||
(System/exit status))
|
||||
|
||||
(defn- usage
|
||||
([summary] (usage summary []))
|
||||
([summary errors] (->> (concat errors
|
||||
["usage: snooper-client [opts]"
|
||||
""
|
||||
"Options:"
|
||||
summary])
|
||||
(str/join \newline))))
|
||||
|
||||
(defn- parse-opts [args required cli-opts]
|
||||
(let [{:keys [options] :as result} (cli/parse-opts args cli-opts)
|
||||
missing (set/difference required (-> options (keys) (set)))
|
||||
missing-errors (map #(format "missing required parameter: %s" (name %))
|
||||
missing)]
|
||||
(update result :errors concat missing-errors)))
|
||||
|
||||
(defn -main [& args]
|
||||
(let [required-args #{:mqtt-host :mqtt-port :mqtt-user :mqtt-password-file :event-topic :notification-topic}
|
||||
{:keys [options _ errors summary]} (parse-opts args required-args cli-opts)]
|
||||
(when (seq errors) (msg-quit 1 (usage summary errors)))
|
||||
(let [{:keys [mqtt-host
|
||||
mqtt-port
|
||||
mqtt-user
|
||||
mqtt-password-file
|
||||
notification-topic
|
||||
event-topic]} options
|
||||
catch-shutdown (async/chan)
|
||||
mqtt-client (mqtt/connect-json! :host mqtt-host
|
||||
:port mqtt-port
|
||||
:username mqtt-user
|
||||
:password (-> mqtt-password-file
|
||||
(slurp)
|
||||
(str/trim)))
|
||||
logger (log/print-logger)]
|
||||
(snooper/listen! :mqtt-client mqtt-client
|
||||
:notification-topic notification-topic
|
||||
:event-topics event-topic
|
||||
:logger logger)
|
||||
(.addShutdownHook (Runtime/getRuntime)
|
||||
(Thread. (fn [] (>!! catch-shutdown true))))
|
||||
(<!! catch-shutdown)
|
||||
;; Stopping the MQTT will stop tattler
|
||||
(mqtt/stop! mqtt-client)
|
||||
(System/exit 0))))
|
|
@ -0,0 +1,100 @@
|
|||
(ns snooper.core
|
||||
(:require [clojure.core.async :refer [go-loop alts! chan]]
|
||||
[fudo-clojure.logging :as log]
|
||||
[milquetoast.client :as mqtt]
|
||||
[malli.core :as t]))
|
||||
|
||||
(defn pthru [o] (clojure.pprint/pprint o) o)
|
||||
|
||||
(def critical-objects [:person :bear])
|
||||
(def normal-objects [:cat :dog])
|
||||
|
||||
(defn- objects-criticality [objs]
|
||||
(cond (some (partial contains? objs) critical-objects) :high
|
||||
(some (partial contains? objs) normal-objects) :medium
|
||||
:else nil))
|
||||
|
||||
(defn- objects-probability [objs]
|
||||
(let [prob (apply max (vals objs))]
|
||||
(cond (<= 0.4 prob 0.6) :possibly
|
||||
(<= 0.6 prob 0.8) :likely
|
||||
(<= 0.8 prob 0.9) :probably
|
||||
(<= 0.9 prob 1.0) :definitely
|
||||
:else nil)))
|
||||
|
||||
(defn- sized-string [min max]
|
||||
(t/schema [:string {:min min :max max}]))
|
||||
|
||||
(def Notification
|
||||
(t/schema [:map
|
||||
[:summary (sized-string 1 80)]
|
||||
[:body (sized-string 1 256)]
|
||||
[:urgency {:optional true} [:enum :low :medium :high]]]))
|
||||
|
||||
(def MotionEvent
|
||||
(t/schema [:map
|
||||
[:payload
|
||||
[:map
|
||||
[:detection
|
||||
[:map
|
||||
[:location string?]
|
||||
[:objects [:map-of keyword? number?]]
|
||||
[:detection-url string?]]]]]
|
||||
[:topic string?]]))
|
||||
|
||||
(defn- add-a-or-an [obj]
|
||||
(let [first-char (first (name obj))]
|
||||
(if (some #(= first-char %) [\a \e \i \o \u])
|
||||
(format "an %s" (name obj))
|
||||
(format "a %s" (name obj)))))
|
||||
|
||||
(defn- objects-string
|
||||
([obj0] (add-a-or-an obj0))
|
||||
([obj0 obj1] (format "%s and %s" (add-a-or-an obj0) (objects-string obj1)))
|
||||
([obj0 obj1 & objs] (format "%s, %s" (add-a-or-an obj0) (apply objects-string (concat [obj1] objs)))))
|
||||
|
||||
(defmulti event-summary :probability)
|
||||
|
||||
(defmethod event-summary :possibly [{:keys [description location]}]
|
||||
(format "There could possibly be %s at the %s" description location))
|
||||
(defmethod event-summary :likely [{:keys [description location]}]
|
||||
(format "There's might %s at the %s" description location))
|
||||
(defmethod event-summary :probably [{:keys [description location]}]
|
||||
(format "There's probably %s at the %s" description location))
|
||||
(defmethod event-summary :definitely [{:keys [description location]}]
|
||||
(format "There's %s at the %s" description location))
|
||||
(defmethod event-summary :default [_]
|
||||
nil)
|
||||
|
||||
(defmulti translate-event :type)
|
||||
|
||||
(defmethod translate-event "detection-event"
|
||||
[{{:keys [objects location detection-url]} :detection}]
|
||||
(let [criticality (objects-criticality objects)
|
||||
probability (objects-probability objects)
|
||||
description (apply objects-string (keys objects))]
|
||||
{:summary (event-summary {:criticality criticality
|
||||
:probability probability
|
||||
:location location
|
||||
:description description})
|
||||
:body detection-url
|
||||
:urgency criticality}))
|
||||
|
||||
(defn listen!
|
||||
[& {mqtt-client :mqtt-client
|
||||
notification-topic :notification-topic
|
||||
event-topics :event-topics
|
||||
logger :logger}]
|
||||
(let [incoming (map (partial mqtt/subscribe! mqtt-client) event-topics)
|
||||
valid-evt? (t/validator MotionEvent)]
|
||||
(go-loop [evts (alts! incoming)]
|
||||
(let [evt (first evts)]
|
||||
(clojure.pprint/pprint evt)
|
||||
(cond (nil? evt) (log/info! logger "stopping")
|
||||
(valid-evt? evt) (do (log/info! logger (format "received motion event id %s from %s"
|
||||
(:id evt)
|
||||
(:topic evt)))
|
||||
(mqtt/send! mqtt-client notification-topic (pthru (translate-event (:payload evt))))
|
||||
(recur (alts! incoming)))
|
||||
:else (do (log/error! logger (format "invalid motion event: %s" evt))
|
||||
(recur (alts! incoming))))))))
|
Loading…
Reference in New Issue