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