From 426ecb4e0ccc23e411039b7f075155df275b0a2d Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 16 Apr 2026 01:25:16 +0200
Subject: Server: ingest owntracks messages, frontend tracker view

---
 lib/Server/Frontend/Routes.hs  |  2 ++
 lib/Server/Frontend/Tracker.hs | 65 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 67 insertions(+)
 create mode 100644 lib/Server/Frontend/Tracker.hs

(limited to 'lib/Server/Frontend')

diff --git a/lib/Server/Frontend/Routes.hs b/lib/Server/Frontend/Routes.hs
index 75b1bda..fa3a9ce 100644
--- a/lib/Server/Frontend/Routes.hs
+++ b/lib/Server/Frontend/Routes.hs
@@ -45,6 +45,8 @@ mkYesodData "Frontend" [parseRoutes|
 /ticket/announce/#UUID AnnounceR POST
 /ticket/del-announce/#UUID DelAnnounceR GET
 
+/tracker/#Text TrackerViewR GET
+
 /ticker/announce TickerAnnounceR POST
 /ticker/delete TickerDeleteR POST
 
diff --git a/lib/Server/Frontend/Tracker.hs b/lib/Server/Frontend/Tracker.hs
new file mode 100644
index 0000000..23bbdb9
--- /dev/null
+++ b/lib/Server/Frontend/Tracker.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE QuasiQuotes    #-}
+
+module Server.Frontend.Tracker (getTrackerViewR) where
+import           Data.Coerce                     (coerce)
+import           Data.Functor                    ((<&>))
+import           Data.Text                       (Text)
+import qualified Data.Text                       as T
+import           Data.Time                       (getCurrentTime)
+import qualified Data.UUID                       as UUID
+import           Database.Esqueleto.Experimental hiding ((<&>))
+import           Persist
+import           Server.Frontend.Routes          (FrontendMessage (..), Handler,
+                                                  Route (..), Widget)
+import           Yesod                           hiding (update, (=.), (==.))
+
+import           OwnTracks.Status
+
+getTrackerViewR :: Text -> Handler Html
+getTrackerViewR name =
+  runDB (selectOne do
+    tracker <- from (table @Tracker)
+    where_ (tracker ^. TrackerName ==. val name)
+    pure tracker)
+  >>= \case
+    Nothing -> notFound
+    Just (Entity trackerId Tracker{..}) -> do
+
+      (maybeStatus, maybePing) <- runDB $ do
+        status <- selectOne do
+          status <- from (table @TrackerStatus)
+          where_ (status ^. TrackerStatusTracker ==. val trackerId)
+          orderBy [desc $ status ^. TrackerStatusTimestamp]
+          pure status
+        ping <- selectOne do
+          ping <- from (table @Ping)
+          where_ (ping ^. PingTrackerId ==. val trackerId)
+          orderBy [desc $ ping ^. PingTimestamp]
+          pure ping
+        pure (status, ping)
+
+      -- TODO: leaflet map; auto updates?
+      defaultLayout [whamlet|
+        <h1> _{MsgTracker name}
+        <em> (#{trackerId})
+        <section>
+          <h2> _{MsgLastTrackerStatus}
+          $maybe Entity _ TrackerStatus{..} <- maybeStatus
+            LocationPermission: #{show $ statusLocationPermission trackerStatusStatus} <br>
+            BatteryOptimisations: #{show $ statusBatteryOptimizations trackerStatusStatus} <br>
+            Phone in power save mode: #{show $ statusPhonePowerSaveMode trackerStatusStatus}
+          $nothing
+            <em>Status unknown
+        <section>
+          <h2> _{MsgLastTrackerPosition}
+          $maybe Entity _ Ping{..} <- maybePing
+            Position: #{show pingGeopos} <br>
+            Timestamp: #{show pingTimestamp} <br>
+            $maybe ticketId <- pingTicket
+              Ticket: <a href="@{TicketViewR (coerce ticketId)}">#{UUID.toText (coerce ticketId)}</a>
+            $nothing
+              Ticket: (no assigned ticket)
+          $nothing
+            (none)
+        |]
-- 
cgit v1.2.3