Norwegian Public Roads Administration's Traffic Data API from clojure

traffic-data-api.clj

#!/usr/bin/env boot
(set-env!
  :dependencies '[[org.clojure/clojure "1.10.0"]
                  [org.clojure/data.json "0.2.6"]
                  [district0x/graphql-query "1.0.6"]
                  [http-kit "2.3.0"]
                  [clj-gatling "0.13.0"]
                  [clj-time "0.15.0"]])


(require '[clojure.pprint :as pp]
         '[clojure.data.json :as json]
         '[org.httpkit.client :as http]
         '[graphql-query.core :refer [graphql-query]]
         '[clj-gatling.core :as clj-gatling]
         '[clj-time.core :as t])

(import '[java.time Instant ZonedDateTime])

(def zoned-date-time-re
  #"^(?:[1-9]\d{3}-(?:(?:0[1-9]|1[0-2])-(?:0[1-9]|1\d|2[0-8])|(?:0[13-9]|1[0-2])-(?:29|30)|(?:0[13578]|1[02])-31)|(?:[1-9]\d(?:0[48]|[2468][048]|[13579][26])|(?:[2468][048]|[13579][26])00)-02-29)T(?:[01]\d|2[0-3]):[0-5]\d:[0-5]\d(?:\.\d{1,9})?(?:Z|[+-][01]\d:[0-5]\d)$")


(defn try-parse-date
  "Attempt to parse value as date. Useful with json/read-str."
  [_ value]
  (if (re-matches zoned-date-time-re (str value))
    (try
      (ZonedDateTime/parse value)
      (catch Exception _
        (try
          (Instant/parse value)
          (catch Exception _ value))))
    value))


(defn read-json
  "Read json string, parsing keys to keywords, and attempting to parse values to
  dates. Non-date like values are kept as is."
  [s]
  (json/read-str
    s
    :key-fn keyword
    :value-fn try-parse-date))


(defn query
  "Create a graphql-query from a clojure data structure."
  [q]
  {:query (graphql-query {:queries [q]})})


(defn query-api
  "Query the traffic data api."
  [q]
  (-> "https://www.vegvesen.no/trafikkdata/api/"
    (http/post {:headers {"content-type" "application/json"}
                ;;:proxy-url "http://127.0.0.1:8888"
                :body    (json/write-str (query q))})
    deref
    :body
    read-json
    :data))


(defn fetch-trps
  "Fetch all trps."
  []
  (-> [:trafficRegistrationPoints [:id :name]]
    query-api
    :trafficRegistrationPoints))


(defn fetch-trp-by-id
  "Fetch trp by id."
  [id]
  (-> [:trafficRegistrationPoints {:trafficRegistrationPointIds id}
       [:id :name]]
    query-api
    :trafficRegistrationPoints
    first))


(defn fetch-mdt
  "Fetch average daily volume per month for trp and year."
  [trp-id year]
  (-> [:trafficData
       {:trafficRegistrationPointId trp-id}
       [[:volume
         [[:average
           [[:daily
             [[:byMonth
               {:year year}
               [:year
                :month
                [:total [:volume]]]]]]]]]]]]
    query-api
    (get-in [:trafficData :volume :average :daily :byMonth])))


(defn fetch-volume
  "Fetch hour volume for trp id in interval."
  [trp-id from to first after]
  (-> [:trafficData
       {:trafficRegistrationPointId trp-id}
       [[:volume
         [[:byHour
           {:from from :to to :first first :after after}
           [[:pageInfo [:endCursor :hasNextPage]]
            [:edges [:cursor [:node [:from
                                     :to
                                     [:total [:volume]]]]]]]]]]]]
    query-api
    (get-in [:trafficData :volume :byHour])))


(defn next-page-cursor
  "Lookup the cursor for the next page."
  [{:keys [pageInfo]}]
  (when (:hasNextPage pageInfo)
    (:endCursor pageInfo)))


(defn lazy-hour-volumes
  "Lazily fetch hourly traffic volume for trp id in interval."
  ([id from to] (lazy-hour-volumes id from to 10))
  ([id from to per-page] (lazy-hour-volumes id from to per-page nil))
  ([id from to first after]
   (lazy-seq (let [by-hour (fetch-volume id from to first after)]
               (cons
                 (->> by-hour :edges (map :node) doall)
                 (when-let [after (next-page-cursor by-hour)]
                   (lazy-hour-volumes id from to first after)))))))


(comment

  (-> (fetch-trp-by-id  "02489V121427")
    :name) ; VOLLEVATN


  (-> (fetch-trps)
    first
    :id) ; "02489V121427"


  (-> (fetch-trps)
    first
    :id
    (lazy-hour-volumes "2018-01-01T01:00:00+01:00"
                       "2018-01-28T01:00:00+01:00")
    first) ; ({:from ...)

  (clj-gatling/run
    {:name      "Simulation"
     :scenarios [{:name  "Scenario 1"
                  :steps [{:name    "Fetch random trp"
                           :request (fn [ctx]
                                      (assoc ctx :trp (rand-nth (fetch-trps))))}
                          {:name    "Fetch 28 days of a random month's volumes for the trp"
                           :request (fn [ctx]
                                      (let [month (format "%02d" (inc (rand-int 12)))]
                                        (->> (lazy-hour-volumes (-> ctx :trp :id)
                                                                (format "2018-%s-01T01:00:00+01:00" month)
                                                                (format "2018-%s-28T01:00:00+01:00" month))
                                          (flatten)
                                          (map (comp :volume :total))
                                          (reduce +)))
                                      )}]}]}
    {:concurrency 5
     :duration    (t/minutes 10)}))