aboutsummaryrefslogtreecommitdiff
path: root/lib/Server/Frontend
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Server/Frontend')
-rw-r--r--lib/Server/Frontend/Routes.hs2
-rw-r--r--lib/Server/Frontend/Tracker.hs65
2 files changed, 67 insertions, 0 deletions
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)
+ |]