(ns lemondronor.circlebot (:require ["commander" :as commander] ["fs" :as fs] [cljs.pprint :as pprint] [cljs.reader :as reader] [clojure.set :as set] [clojure.string :as string] [fipp.edn :as fippedn] [kitchen-async.promise :as p] [lemondronor.circlebot.adsbx :as adsbx] [lemondronor.circlebot.generation :as generation] [lemondronor.circlebot.geo :as geo] [lemondronor.circlebot.logging :as logging] [lemondronor.circlebot.pelias :as pelias] [lemondronor.circlebot.twitter :as twitter] [lemondronor.circlebot.util :as util] ["sqlite" :as sqlite])) (logging/deflog "circlebot" logger) (defn get-basestation-sqb-record [icao db-path] (log-info "%s: Looking up in %s" icao db-path) (p/let [record (p/-> (sqlite/open db-path clj->js { js/Promise js/Promise }) (.get "SELECT Registration, Type, RegisteredOwners from Aircraft where ModeS = ?" icao))] (log-info "%s: basestation.sqb: %s" icao (js->clj record :keywordize-keys true)) (js->clj record :keywordize-keys true))) (defn parse-adsbexchange-ac-element [e] (let [nilstr #(if (= % "") nil %) numstr #(if (= % "") nil (js/parseFloat %))] {:postime (numstr (e "postime")) :lat (numstr (e "lat")) :lon (numstr (e "lon")) :icao (e "icao") :registration (e "reg") :alt (numstr (e "alt")) :mlat? (= (e "mlat") "1") :speed (numstr (e "spd")) :squawk (nilstr (e "sqk")) :military? (= (e "mil") "1") :callsign (nilstr (e "call")) :type (nilstr (e "type"))})) (defn parse-adsbexchange-live-data [json-str] {:aircraft (map parse-adsbexchange-ac-element (get (js->clj (.parse js/JSON json-str)) "ac"))}) (defn get-adsbexchange-live-data [{:keys [url lat lon radius-nm api-key]}] (let [url (->> [url "lat" lat "lon" lon "dist" radius-nm] (map str) (string/join "/"))] (p/let [http-result (util/http-get url {:headers {:api-auth api-key}})] (let [result (parse-adsbexchange-live-data http-result)] (log-verbose "Got %s aircraft from API" (count (:aircraft result))) result)))) ;; We keep position reports going back this far. (def max-history-age-ms (* 25 60 1000)) ;; Given a vector of position history, removes old entries. (defn prune-history [history now] (let [h (filterv #(< (- now (:time %)) max-history-age-ms) history)] h)) (defn update-history-db-record [db ac] (let [icao (:icao ac) new-history-entry {:lat (:lat ac) :lon (:lon ac) :time (:postime ac)}] (if (contains? db icao) (let [old-record (db icao) history (:history (db icao)) updated-record (-> old-record (merge ac) (assoc :history (conj history new-history-entry)))] (assoc db icao updated-record)) (assoc db icao (assoc ac :history [new-history-entry]))))) (defn update-history-db-add-new-data [db new-data now] (let [initial-count (count db) initial-icaos (set (keys db)) updated-db (reduce update-history-db-record db new-data) new-count (count updated-db) new-icaos (set/difference (set (keys updated-db)) initial-icaos)] (log-verbose "Added %s new aircraft records (%s). %s total." (- new-count initial-count) (string/join "," new-icaos) new-count) updated-db)) (defn prune-histories [db now] (reduce-kv (fn [m k v] (assoc m k (update v :history prune-history now))) {} db)) ;; Removes entries for any aircraft that we haven't seen in a while. (defn prune-records [db now] (let [initial-count (count db) initial-icaos (set (keys db)) pruned-db (reduce-kv (fn [m k v] (if (or (> (count (:history v)) 0) (if-let [ended-circling-time (:ended-circling-time v)] (< (- now ended-circling-time) (* 30 60 1000)))) (assoc m k v) m)) {} db) new-count (count pruned-db) pruned-icaos (set/difference initial-icaos (set (keys pruned-db)))] (log-verbose "Pruned %s stale aircraft records (%s). %s remain" (- initial-count new-count) (string/join "," pruned-icaos) new-count) pruned-db)) (defn debug-print [& args] (apply println (drop 1 args)) (println (first args)) (first args)) (defn update-history-db [db new-data now] (-> db (update-history-db-add-new-data new-data now) (prune-histories now) (prune-records now))) (defn write-history-db [db path] (fs/writeFileSync path (with-out-str (fippedn/pprint db))) db) ;; Reads the history database from a path. Returns a promise that ;; resolves to the database value. (defn read-history-db [path] (p/let [edn-str (util/read-file path {:encoding "utf-8"}) db (reader/read-string edn-str)] (log-verbose "Loaded %s aircraft from database %s" (count db) path) db)) (defn current-time [] (/ (.getTime (js/Date.)) 1)) ;; This is how many degrees of turning we need to see over ;; max-history-age-ms ms to consider it a potential circling aircraft. (def curviness-threshold-degrees 1440) (defn ac-desc [ac] (str (:icao ac) " " (:lat ac) " " (:lon ac) " #" (:registration ac) " " (:alt ac) " " (:curviness ac) " " (:normalized-curviness ac))) (defn screenshot [icao lat lon] (p/let [image-path (adsbx/screenshot-aircraft icao lat lon {:timeout 30000 ;;:headless? false ;; :viewport {:width 1600 :height 800} ;; :clip {:width 1600 :height 800 :x 0 :y 0} :vrs-settings (fs/readFileSync "vrs-settings.json" "utf-8")})] (log-warn "%s: Got screenshot" icao) image-path)) (defn circling? [ac] (and (> (geo/flight-curviness (:history ac)) curviness-threshold-degrees) (> (:alt ac) 300))) ;; Returns a vector of two elements, ;; [updated-database potentially-circling-aircraft] (defn detect-circles [db now] (log-verbose "Detecting circles") (loop [old-db (seq db) new-db {} potential-circles '()] (if (seq old-db) (let [[icao ac] (first old-db) curviness (geo/flight-curviness (:history ac)) ac (assoc ac :curviness curviness :normalized-curviness (geo/flight-normalized-curviness (:history ac))) currently-circling? (circling? ac) previously-circling? (:started-circling-time ac)] (cond (and currently-circling? (not previously-circling?) (or (nil? (:ended-circling-time ac)) (> (- now (:ended-circling-time ac)) (* 30 60 1000)))) (let [new-ac (assoc ac :started-circling-time now)] (recur (rest old-db) (assoc new-db icao new-ac) (conj potential-circles new-ac))) (and previously-circling? (not currently-circling?)) (let [started-circling-time (:started-circling-time ac) new-ac (assoc ac :started-circling-time nil :ended-circling-time now)] (log-info "%s: Circle terminated after %s secs: %s" icao (/ (- now started-circling-time) 1000) (ac-desc ac)) (recur (rest old-db) (assoc new-db icao new-ac) potential-circles)) :else (recur (rest old-db) (assoc new-db icao ac) potential-circles))) [new-db potential-circles]))) (defn parse-number [s] (let [v (js/parseFloat s)] (if (js/isNaN v) (throw (str "Not a number: " s)) v))) (defn debug-prn [x msg] (println msg (with-out-str (fippedn/pprint x))) x) (defn closest-airport [config lat lon] (p/let [results (pelias/nearby (:pelias config) lat lon {:categories "transport:air:aerodrome" :boundary.circle.radius 7})] (-> results (get :features) (->> (sort-by #(get-in % [:properties :distance]))) first))) (defn log-table [table keys] (let [s (with-out-str (pprint/print-table keys table)) lines (string/split-lines s)] (doseq [l lines] (log-info "%s" l))) ) (def description-templates (map generation/parse-template [(str "[{registration}|{registration}, a {type},|{militaryregistration}, a military aircraft,|" "{militaryregistration}, a military {type},|" "Aircraft with unknown registration, ICAO {icao}|" "Military aircraft with unknown registration, ICAO {militaryicao}] " "?:[(callsign {callsign}) ]" "is circling over [{neighbourhood}, {locality}|{neighbourhood}, {county}|{locality}] " "?:[at {alt} feet, ]" "?:[speed {speed} MPH, ]" "?:[squawking {squawk}, ]" "?:[{nearbydistance} miles from {nearbylandmark} ]" "?:[#{registration}|#{militaryregistration}]")])) (defn expand-template [data] (let [results (take 3 (generation/expand description-templates data {:weights {:militaryregistration 4 :registration 3 :militaryicao 2 :icao 1 :neighbourhood 3 :locality 3}}))] (log-info "Top description candidates (%s total):" (count results)) (log-table results [:score :text]) (first results))) (defn km->miles [km] (* km 0.621371)) (defn to-fixed [n d] (.toFixed n d)) (defn generate-description [ac sqb reverse wiki-nearby nearby] (let [rev-props (:properties reverse) nearby (:properties (first nearby)) wiki-nearby (:properties (first wiki-nearby)) info (cond-> (-> ac (dissoc :history :type) (merge rev-props)) (:Type sqb) (assoc :type (:Type sqb)) (:military? ac) (-> (assoc :militaryregistration (:registration ac) :militaryicao (:icao ac))) wiki-nearby (assoc :nearbylandmark (:name wiki-nearby) :nearbydistance (-> wiki-nearby :distance km->miles (to-fixed 2))) (and nearby (not wiki-nearby)) (assoc :nearbylandmark (:name nearby) :nearbydistance (-> nearby :distance km->miles (to-fixed 2))) (:speed ac) (assoc :speed (.toFixed (* (:speed ac) 1.15078) 0)) (= (:registration ac) (:callsign ac)) (dissoc :callsign) ;; TODO: If layer is "county", find the nearest city. ) expansion (expand-template info)] (:text expansion))) (defn feature-has-wikipedia-page? [f] (get-in f [:addendum :osm :wikipedia])) (defn recent-history [history] (let [most-recent-time (:time (last history)) cutoff-time (- most-recent-time (* 6 60 1000)) recent-hist (filter #(> (:time %) cutoff-time) history)] recent-hist)) ;; If the centroid of the aircraft's positions is less than this close ;; to an airport, then it's probably just doinf flight training. (def minimum-airport-distance-km 2.5) ;;(def minimum-airport-distance-miles 0) (defn process-potential-circle [ac config now] (p/let [icao (:icao ac) recent-positions (recent-history (:history ac)) _ (log-info "%s: Recent history has %s positions, most recent is %s secs old" icao (count recent-positions) (/ (- now (:time (last recent-positions))) 1000)) centroid (geo/centroid recent-positions) lat (:lat centroid) lon (:lon centroid) _ (log-info "%s: Recent centroid: %s %s" icao lat lon) airport (closest-airport config lat lon) airport-properties (:properties airport)] (if airport (log-info "%s: Closest airport is %s, distance: %s km" (:icao ac) (:label airport-properties) (:distance airport-properties)) (log-info "%s: No airports nearby" (:icao ac))) (if (and airport-properties (<= (:distance airport-properties) minimum-airport-distance-km)) (log-info "%s: Filtering out because it's %s km (minimum is %s) from %s" (:icao ac) (:distance airport-properties) minimum-airport-distance-km (:label airport-properties) ()) (do (p/let [coarse (pelias/reverse (:pelias config) lat lon {:layers "coarse"})] (let [coarse (first (:features coarse))] (log-info "%s: Reverse geocode: %s" icao (:properties coarse)) ;; Note that if we're over the ocean we get null :( (p/then (p/all [(screenshot (:icao ac) lat lon) (p/let [nearby (pelias/nearby (:pelias config) lat lon {:boundary.circle.radius 100 :layers "venue" :size 50}) nearby (:features nearby) wiki-nearby (filter feature-has-wikipedia-page? nearby) sqb (if-let [sqb-path (:basestation-sqb config)] (get-basestation-sqb-record icao sqb-path))] (log-info "%s: Nearby geo search: %s potential landmarks, %s with wikipedia pages" icao (count nearby) (count wiki-nearby)) (log-info "%s" (->> nearby (take 3) (map :properties))) (log-info "Nearest venues:") (log-table (->> nearby (take 3) (map :properties)) [:distance :label :locality :neighborhood :county :gid]) (log-info "Nearest venues with locality:") (log-table (->> nearby (map :properties) (filter :locality) (take 3)) [:distance :label :locality :neighborhood :county :gid]) (doseq [f wiki-nearby] (log-info "%s: Wiki landmark: %s %s" icao (get-in f [:properties :label] f) (get-in f [:properties :addendum] f))) (let [description (generate-description ac sqb coarse wiki-nearby nearby)] (log-warn "Description: %s" description) description))]) (fn [[image-path description]] (if (or (nil? coarse) ;; TODO: Filter using the layer hierarchy; we want ;; anything smaller than "region" (state). (= (get-in coarse [:properties :name]) "California")) (log-info "%s: Filtering out because it is outside Los Angeles County" (:icao ac)) (if (and image-path description) (if (get-in config [:twitter :enabled?]) (twitter/tweet (twitter/twit (:twitter config)) description [image-path]) (log-warn "Skipping tweeting")) (log-warn "Skipping tweet %s %s" image-path description))))))))))) (defn process-potential-circles [acs config now] (p/loop [acs acs] (when (seq acs) (p/do (process-potential-circle (first acs) config now) (p/recur (rest acs)))))) (def history-db-path "advisory-circular.db") (def secrets-path "secrets.yaml") (defn build-config [secrets commander] (-> (merge-with merge secrets {:adsbx {:url (.-adsbxUrl commander)}} {:twitter {:enabled? (.-tweeting commander)}} {:pelias {:url (.-peliasUrl commander)}}) (assoc :basestation-sqb (.-basestationSqb commander) :lat (.-lat commander) :lon (.-lon commander) :radius-nm (.-radius commander)))) (defn main [& args] (-> commander (.requiredOption "--lat " "Latitude of the circle of region of interest" parse-number) (.requiredOption "--lon " "Longitude of the circle of the region of interest" parse-number) (.requiredOption "--adsbx-url " "ADSBX API url") (.requiredOption "--pelias-url " "Base pelias geocoder URL") (.option "--radius " "Radius of the circle of interest, in nautical miles" 20 parse-number) (.option "--basestation-sqb " "Path to a basestation.sqb database file") (.option "--no-tweeting" "Do not tweet.") (.parse (.-argv js/process))) (let [start-time (current-time)] (p/then (p/all [(read-history-db history-db-path) (util/read-config secrets-path)]) (fn [[db secrets]] (p/let [config (build-config secrets commander) data (get-adsbexchange-live-data {:url (get-in config [:adsbx :url]) :api-key (get-in config [:adsbx :api-key]) :lat (:lat config) :lon (:lon config) :radius-nm (:radius-nm config)}) now (current-time) [new-db potential-circles] (-> db (update-history-db (:aircraft data) now) (detect-circles now))] (p/do (when potential-circles (doseq [ac potential-circles] (log-warn "%s: New circle detected: %s" (:icao ac) (ac-desc ac))) (process-potential-circles potential-circles config now)) (write-history-db new-db history-db-path) (let [end-time (current-time)] (log-info "Completed processing in %s seconds: tracking %s aircraft; %s potential circles" (/ (- end-time start-time) 1000) (count new-db) (count potential-circles)))))))))