From a83ae9ec2ba6fad2b8dd066416038fbed174e3f3 Mon Sep 17 00:00:00 2001
From: unwox <me@unwox.com>
Date: Tue, 24 Dec 2024 16:09:38 +0600
Subject: add metrics for tracking user activity

---
 bin/fetch.fnl |  6 ++++++
 bin/serve.fnl | 40 ++++++++++++++++++++++++++++++++++++----
 2 files changed, 42 insertions(+), 4 deletions(-)

diff --git a/bin/fetch.fnl b/bin/fetch.fnl
index 5d998f7..26566f7 100644
--- a/bin/fetch.fnl
+++ b/bin/fetch.fnl
@@ -54,6 +54,12 @@
     creation_time DATETIME NOT NULL
   );
 
+  CREATE TABLE IF NOT EXISTS metrics(
+    fingerprint TEXT NOT NULL,
+    url TEXT NOT NULL,
+    creation_time DATETIME NOT NULL
+  );
+
   CREATE TABLE IF NOT EXISTS cache(
     key TEXT NOT NULL PRIMARY KEY,
     value TEXT
diff --git a/bin/serve.fnl b/bin/serve.fnl
index b498ece..fdd553f 100644
--- a/bin/serve.fnl
+++ b/bin/serve.fnl
@@ -184,6 +184,26 @@
        OFFSET ?"
       [limit (% the-number (- total limit))])))
 
+(fn now []
+  (os.date "%Y-%m-%d %H:%M:%S"))
+
+(fn store-metric [headers url]
+  (local fingerprint
+    (must (luna.crypto.sha1
+            (.. (or headers.User-Agent "") ":"
+                (or headers.X-Forwarded-For
+                    headers.Forwarded
+                    headers.X-Real-Ip
+                    "")))))
+  (must
+   (luna.db.exec
+     db
+     "INSERT INTO metrics(fingerprint, url, creation_time) VALUES (?, ?, ?)"
+     [fingerprint url (now)])))
+
+(fn tracked-url [url]
+  (.. "/track?url=" (must (luna.http.encode-url url))))
+
 (fn all-tags []
   (map
     (fn [_ v] (. v 1))
@@ -331,12 +351,13 @@
 
 (fn site-name-template [name]
   (local module (require (.. "parser." name)))
-  [:a {:class "site-icon" :href (.. module.url "?from=everytea.ru")}
+  [:a {:class "site-icon"
+       :href (tracked-url (.. module.url "?from=everytea.ru"))}
    [:img {:src (.. "/static/" name ".png") :alt (.. "Логотип " module.title)}]
    module.title])
 
 (fn item-template [product]
-  (local link (.. product.url "?from=everytea.ru"))
+  (local link (tracked-url (.. product.url "?from=everytea.ru")))
   [:div {:class "tile"}
    [:a {:href link :class "img-link" :rel "nofollow"}
     [:img {:class "img" :src product.image :title product.title
@@ -545,10 +566,12 @@
        [:footer {}
         [:small {:class "text"} [:NO-ESCAPE texts.footer-text]]]]]]]])
 
-(fn root-handler [{: path : query}]
+(fn root-handler [{: headers : path : query}]
+  (local path-with-query (.. path "?" (serialize-query query)))
   ;; FIXME: do not run render-listing when cache is hit
-  (local cache-key (.. "page:" path "?" (serialize-query query)))
+  (local cache-key (.. "page:" path-with-query))
   (local cached (cache.get db cache-key))
+  (store-metric headers path-with-query)
 
   (fn render-listing [form category]
     (local headers {:content-type "text/html"})
@@ -624,8 +647,17 @@
   (values 200 {:content-type "text/plain"}
           "User-agent: *\nAllow: /"))
 
+(fn track-handler [{: headers : query}]
+  (local redirect-url (?. query :url 1))
+  (if redirect-url
+    (do
+      (store-metric headers redirect-url)
+      (values 307 {:Location redirect-url} ""))
+    (values 400 {} "bad redirect url")))
+
 (must (luna.router.route "GET /" root-handler))
 (must (luna.router.route "GET /robots.txt" robots-handler))
+(must (luna.router.route "GET /track" track-handler))
 (must (luna.router.static "GET /static/" "static/"))
 
 (when luna.debug
-- 
cgit v1.2.3