advisory-circular/src/main/lemondronor/circlebot.cljs

(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}, {type|a-an},|{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 <lat>" "Latitude of the circle of region of interest" parse-number)
      (.requiredOption "--lon <lat>" "Longitude of the circle of the region of interest" parse-number)
      (.requiredOption "--adsbx-url <url>" "ADSBX API url")
      (.requiredOption "--pelias-url <url>" "Base pelias geocoder URL")
      (.option "--radius <radius>" "Radius of the circle of interest, in nautical miles" 20 parse-number)
      (.option "--basestation-sqb <path>" "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)))))))))