From b893f41188eb6fe5bc1de54da7225fc150be7c7d Mon Sep 17 00:00:00 2001 From: stuebinm Date: Thu, 16 Apr 2026 12:35:31 +0200 Subject: Server.Frontend.Tracker: creation & deletion dialogs --- lib/Persist.hs | 2 +- lib/Server.hs | 2 +- lib/Server/Frontend/Routes.hs | 3 +- lib/Server/Frontend/Tickets.hs | 2 +- lib/Server/Frontend/Tracker.hs | 69 +++++++++++++++++++++++++++++++++++++----- lib/Server/Ingest.hs | 9 +++--- 6 files changed, 72 insertions(+), 15 deletions(-) (limited to 'lib') diff --git a/lib/Persist.hs b/lib/Persist.hs index d5dc712..7ff3f1d 100644 --- a/lib/Persist.hs +++ b/lib/Persist.hs @@ -134,7 +134,7 @@ Shape sql=tt_shape Tracker sql=tt_tracker Id UUID default=uuid_generate_v4() name Text Unique - expires UTCTime +-- expires UTCTime blocked Bool agent Text currentTicket TicketId Maybe diff --git a/lib/Server.hs b/lib/Server.hs index 4eb101d..3cff4c5 100644 --- a/lib/Server.hs +++ b/lib/Server.hs @@ -95,7 +95,7 @@ server gtfs metrics@Metrics{..} subscribers dbpool settings = {- handleDebugAPI handleDebugState = do now <- liftIO getCurrentTime runSql dbpool $ do - tracker <- selectList [TrackerBlocked ==. False, TrackerExpires >=. now] [] + tracker <- selectList [TrackerBlocked ==. False] [] --, TrackerExpires >=. now] [] pairs <- forM tracker $ \(Entity trackerId@(TrackerKey uuid) _) -> do entities <- selectList [PingTrackerId ==. trackerId] [] pure (uuid, fmap entityVal entities) diff --git a/lib/Server/Frontend/Routes.hs b/lib/Server/Frontend/Routes.hs index cf6e342..b84d49b 100644 --- a/lib/Server/Frontend/Routes.hs +++ b/lib/Server/Frontend/Routes.hs @@ -45,8 +45,9 @@ mkYesodData "Frontend" [parseRoutes| /ticket/announce/#UUID AnnounceR POST /ticket/del-announce/#UUID DelAnnounceR GET -/trackers TrackersR GET +/trackers TrackersR GET POST /tracker/#Text TrackerViewR GET +/tracker/#Text/delete TrackerDeleteR POST /ticker/announce TickerAnnounceR POST /ticker/delete TickerDeleteR POST diff --git a/lib/Server/Frontend/Tickets.hs b/lib/Server/Frontend/Tickets.hs index 76146df..915521d 100644 --- a/lib/Server/Frontend/Tickets.hs +++ b/lib/Server/Frontend/Tickets.hs @@ -311,7 +311,7 @@ $maybe spaceTime <- spaceTimeMaybe #{trackerAgent} #{key} - #{trackerExpires} + $if trackerBlocked _{MsgUnblockTrackerId} $else diff --git a/lib/Server/Frontend/Tracker.hs b/lib/Server/Frontend/Tracker.hs index e3d88ba..a6c3c46 100644 --- a/lib/Server/Frontend/Tracker.hs +++ b/lib/Server/Frontend/Tracker.hs @@ -1,7 +1,7 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE QuasiQuotes #-} -module Server.Frontend.Tracker (getTrackerViewR, getTrackersR) where +module Server.Frontend.Tracker (getTrackerViewR, getTrackersR, postTrackersR, postTrackerDeleteR) where import Data.Coerce (coerce) import Data.Function ((&)) import Data.Functor ((<&>)) @@ -14,7 +14,8 @@ import Database.Esqueleto.Experimental hiding ((<&>)) import Persist import Server.Frontend.Routes (FrontendMessage (..), Handler, Route (..), Widget) -import Yesod hiding (update, (=.), (==.)) +import Yesod hiding (delete, update, (=.), + (==.)) import OwnTracks.Status @@ -28,14 +29,53 @@ getTrackersR = do pure (t, p) & fmap associateJoin + createWidget <- trackerCreateWidget + defaultLayout [whamlet|

Trackers -
-