diff options
Diffstat (limited to 'lib/Server/Frontend/Tickets.hs')
| -rw-r--r-- | lib/Server/Frontend/Tickets.hs | 34 |
1 files changed, 17 insertions, 17 deletions
diff --git a/lib/Server/Frontend/Tickets.hs b/lib/Server/Frontend/Tickets.hs index c542074..fc7d777 100644 --- a/lib/Server/Frontend/Tickets.hs +++ b/lib/Server/Frontend/Tickets.hs @@ -11,7 +11,7 @@ module Server.Frontend.Tickets , getTicketMapViewR , getDelAnnounceR , postAnnounceR - , getTokenBlock + , getTrackerIdBlock ) where import Server.Frontend.Routes @@ -229,9 +229,9 @@ getTicketViewR ticketId = do pure tracker lastPing <- runDB $ selectOne do - trainping <- from $ table @TrainPing - where_ (trainping ^. TrainPingTicket ==. val (coerce ticketId)) - orderBy [desc (trainping ^. TrainPingTimestamp)] + trainping <- from $ table @Ping + where_ (trainping ^. PingTicket ==. val (Just (coerce ticketId))) + orderBy [desc (trainping ^. PingTimestamp)] pure trainping anchors <- runDB $ select do @@ -244,7 +244,7 @@ getTicketViewR ticketId = do -- trackers <- runDB $ selectList -- ([ TrackerId <-. joins ] ||. [ TrackerCurrentTicket ==. Just ticketKey ]) -- [Asc TrackerExpires] - -- lastPing <- runDB $ selectFirst [ TrainPingTicket ==. coerce ticketId ] [Desc TrainPingTimestamp] + -- lastPing <- runDB $ selectFirst [ PingTicket ==. coerce ticketId ] [Desc PingTimestamp] -- anchors <- runDB $ selectList [ TrainAnchorTicket ==. ticketKey ] [] -- <&> nonEmpty . fmap entityVal @@ -264,11 +264,11 @@ getTicketViewR ticketId = do <section> <h2>_{MsgLive} <p><strong>_{MsgLastPing}: </strong> - $maybe Entity _ TrainPing{..} <- lastPing - _{MsgTrainPing (latitude trainPingGeopos) (longitude trainPingGeopos) trainPingTimestamp} + $maybe Entity _ Ping{..} <- lastPing + _{MsgPing (latitude pingGeopos) (longitude pingGeopos) pingTimestamp} (<a href="/api/debug/pings/#{UUID.toString ticketId}/#{ticketDay}">_{Msgraw}</a>) $nothing - <em>(_{MsgNoTrainPing}) + <em>(_{MsgNoPing}) <p><strong>_{MsgEstimatedDelay}</strong>: $maybe history <- anchors $maybe TrainAnchor{..} <- guessAtSeconds history nowSeconds @@ -299,9 +299,9 @@ $maybe spaceTime <- spaceTimeMaybe ^{widget} <button>_{MsgSubmit} <section> - <h2>_{MsgTokens} + <h2>_{MsgTrackerIds} <table> - <tr><th style="width: 20%">_{MsgAgent}</th><th style="width: 50%">_{MsgToken}</th><th>_{MsgExpires}</th><th>_{MsgStatus}</th> + <tr><th style="width: 20%">_{MsgAgent}</th><th style="width: 50%">_{MsgTrackerId}</th><th>_{MsgExpires}</th><th>_{MsgStatus}</th> $if null trackers <tr><td></td><td style="text-align:center"><em>(_{MsgNone}) $forall Entity (TrackerKey key) Tracker{..} <- trackers @@ -310,9 +310,9 @@ $maybe spaceTime <- spaceTimeMaybe <td title="#{key}">#{key} <td title="#{trackerExpires}">#{trackerExpires} $if trackerBlocked - <td title="_{MsgUnblockToken}"><a href="@?{(TokenBlock key, [("unblock", "true")])}">_{MsgUnblockToken}</a> + <td title="_{MsgUnblockTrackerId}"><a href="@?{(TrackerIdBlock (TrackerKey key), [("unblock", "true")])}">_{MsgUnblockTrackerId}</a> $else - <td title="_{MsgBlockToken}"><a href="@{TokenBlock key}">_{MsgBlockToken}</a> + <td title="_{MsgBlockTrackerId}"><a href="@{TrackerIdBlock (TrackerKey key)}">_{MsgBlockTrackerId}</a> |] where guessDelay history = fmap trainAnchorDelay . extrapolateAtPosition LinearExtrapolator history guessAtSeconds = extrapolateAtSeconds LinearExtrapolator @@ -437,16 +437,16 @@ getDelAnnounceR uuid = do let (TicketKey ticketId) = announcementTicket in redirect (TicketViewR ticketId) -getTokenBlock :: Token -> Handler Html -getTokenBlock token = do +getTrackerIdBlock :: TrackerId -> Handler Html +getTrackerIdBlock trackerId = do YesodRequest{..} <- getRequest let blocked = lookup "unblock" reqGetParams /= Just "true" maybe <- runDB do update \tracker -> do set tracker [TrackerBlocked =. val blocked] - where_ (tracker ^. TrackerId ==. val (TrackerKey token)) - -- Yesod.update (TrackerKey token) [ TrackerBlocked Yesod.=. blocked ] - get (TrackerKey token) + where_ (tracker ^. TrackerId ==. val trackerId) + -- Yesod.update (TrackerKey trackerId) [ TrackerBlocked Yesod.=. blocked ] + get trackerId case maybe of Just r@Tracker{..} -> do liftIO $ print r |