From 5f27e441f47f2565b941b321a9939d54357e1654 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 16 Apr 2026 01:23:50 +0200
Subject: meta: reorganisation, rename "token" to "trackerId"

---
 lib/API.hs                         | 23 +++++++--------
 lib/Config.hs                      |  5 ++--
 lib/Extrapolation.hs               |  2 +-
 lib/Persist.hs                     | 57 +++++++++++++++++++++++++-------------
 lib/Server/Base.hs                 |  4 +--
 lib/Server/Frontend/OnboardUnit.hs | 28 +++++++++----------
 lib/Server/Frontend/Routes.hs      |  5 ++--
 lib/Server/Frontend/Tickets.hs     | 34 +++++++++++------------
 lib/Server/GTFS_RT.hs              | 16 +++++------
 lib/Server/Ingest.hs               | 43 ++++++++++++++--------------
 lib/Server/Subscribe.hs            |  6 ++--
 lib/Yesod/Orphans.hs               | 11 +++++---
 12 files changed, 129 insertions(+), 105 deletions(-)

(limited to 'lib')

diff --git a/lib/API.hs b/lib/API.hs
index 416f71e..12d5ba6 100644
--- a/lib/API.hs
+++ b/lib/API.hs
@@ -54,7 +54,7 @@ import           Servant.API.ContentTypes    (Accept (..))
 
 -- | a bare ping as sent by a tracker device
 data SentPing = SentPing
-  { sentPingToken     :: TrackerId
+  { sentPingTrackerId     :: TrackerId
   , sentPingGeopos    :: Geopos
   , sentPingTimestamp :: UTCTime
   } deriving (Generic)
@@ -66,24 +66,25 @@ instance FromJSON SentPing where
 type API =
   -- ingress API (put this behind BasicAuth?)
   -- TODO: perhaps require a first ping for registration?
-       "tracker" :> "register" :> ReqBody '[JSON] RegisterJson :> Post '[JSON] Token
+       "tracker" :> "register" :> ReqBody '[JSON] RegisterJson :> Post '[JSON] TrackerId
   :<|> "tracker" :> "ping" :> ReqBody '[JSON] SentPing :> Post '[JSON] (Maybe TrainAnchor)
   :<|> "tracker" :> "ping" :> "ws" :> WebSocket
   :<|> "ticker" :> "current" :> Get '[JSON] Value
   :<|> "ticket" :> "subscribe" :> Capture "Ticket Id" UUID :> WebSocket
-  :<|> "debug" :> "pings" :> Get '[JSON] (Map Token [TrainPing])
-  :<|> "debug" :> "pings" :> Capture "Ticket Id" UUID :> Get '[JSON] [TrainPing]
+  :<|> "debug" :> "pings" :> Get '[JSON] (Map UUID [Ping])
+  :<|> "debug" :> "pings" :> Capture "Ticket Id" UUID :> Get '[JSON] [Ping]
   :<|> "gtfs.zip" :> Get '[OctetStream] GTFSFile
   :<|> "gtfs" :> GtfsRealtimeAPI
 
-type GtfsRealtimeAPI = "servicealerts" :> Get '[Proto] FeedMessage
-  :<|> "tripupdates" :> Get '[Proto] FeedMessage
-  :<|> "vehiclepositions" :> Get '[Proto] FeedMessage
+type GtfsRealtimeAPI = "servicealerts" :> QueryFlag "force" :> Get '[Proto] FeedMessage
+  :<|> "tripupdates" :> QueryFlag "force" :> Get '[Proto] FeedMessage
+  :<|> "vehiclepositions" :> QueryFlag "force" :> Get '[Proto] FeedMessage
+
 
 
 type CompleteAPI =
-  "api" :> "openapi" :> Get '[JSON] Swagger
-  :<|> "api" :> API
+  {- "api" :> "openapi" :> Get '[JSON] Swagger
+  :<|> -} "api" :> "v1" :> API
   :<|> "metrics" :> Get '[PlainText] Text
   :<|> "assets" :> Raw
   :<|> Raw -- hook for yesod frontend
@@ -107,7 +108,7 @@ instance ToSchema Value where
   declareNamedSchema _ = pure $ NamedSchema (Just "json") $ mempty
       & type_ ?~ SwaggerObject
 instance ToSchema SentPing where
-  declareNamedSchema = genericDeclareNamedSchema (GTFS.swaggerOptions "trainPing")
+  declareNamedSchema = genericDeclareNamedSchema (GTFS.swaggerOptions "ping")
 
 
 
@@ -117,7 +118,7 @@ instance HasSwagger WebSocket where
     { _swaggerPaths = singleton "/" $ mempty
       { _pathItemGet = Just $ mempty
         { _operationSummary = Just "this is a websocket endpoint!"
-        , _operationDescription = Just "this is a websocket endpoint meant for continious operations, e.g. sending many trainPings one after the other. Unfortunately OpenAPI 2.0 is not suitable to thoroughly model it (hence this text)."
+        , _operationDescription = Just "this is a websocket endpoint meant for continious operations, e.g. sending many pings one after the other. Unfortunately OpenAPI 2.0 is not suitable to thoroughly model it (hence this text)."
         , _operationSchemes = Just [ Wss ]
         , _operationConsumes = Just $ MimeList [ "application/json" ]
         , _operationProduces  = Just $ MimeList [ "application/json" ]
diff --git a/lib/Config.hs b/lib/Config.hs
index 88206f1..c7fd4e4 100644
--- a/lib/Config.hs
+++ b/lib/Config.hs
@@ -35,6 +35,7 @@ data ServerConfig = ServerConfig
   , serverConfigDebugMode    :: Bool
   , serverConfigLogin        :: Maybe UffdConfig
   , serverConfigLogging      :: LoggingConfig
+  , serverConfigBeSilent     :: Bool
   } deriving (Generic)
 
 data LoggingConfig = LoggingConfig
@@ -62,7 +63,7 @@ instance Config UffdConfig where
 
 instance Config LoggingConfig where
   readConfig = LoggingConfig
-    <$> readOptionalValue [key|ntfyToken|]
+    <$> readOptionalValue [key|ntfyTrackerId|]
     <*> readValue "tracktrain" [key|ntfyTopic|]
     <*> readValue "tracktrain" [key|name|]
 
@@ -108,4 +109,4 @@ instance Config ServerConfig where
     <*> readValue False [key|debugmode|]
     <*> readNestedOptional [key|login|]
     <*> readNested [key|logging|]
-
+    <*> readValue False [key|beSilent|]
diff --git a/lib/Extrapolation.hs b/lib/Extrapolation.hs
index 759b31e..071e5fa 100644
--- a/lib/Extrapolation.hs
+++ b/lib/Extrapolation.hs
@@ -29,7 +29,7 @@ import           Persist                             (Geopos (..),
                                                       ShapePoint (shapePointGeopos),
                                                       Station (..), Stop (..),
                                                       Ticket (..), TicketId,
-                                                      Token (..), Tracker (..),
+                                                      TrackerId (..), Tracker (..),
                                                       TrainAnchor (..))
 import           Server.Util                         (utcToSeconds)
 
diff --git a/lib/Persist.hs b/lib/Persist.hs
index 637155a..405e815 100644
--- a/lib/Persist.hs
+++ b/lib/Persist.hs
@@ -10,7 +10,7 @@
 -- also a few little convenience functions for using persistent.
 module Persist where
 
-import           Data.Aeson                  (FromJSON, ToJSON, ToJSONKey)
+import           Data.Aeson                  (FromJSON, ToJSON, ToJSONKey, Value)
 import           Data.Swagger                (ToParamSchema (..), ToSchema (..),
                                               genericDeclareNamedSchema)
 import           Data.Text                   (Text)
@@ -50,17 +50,18 @@ import           MultiLangText               (MultiLangText)
 import           Server.Util                 (runLogging)
 import           Web.PathPieces              (PathPiece)
 import           Yesod                       (Lang)
+import qualified OwnTracks
 
 
-newtype Token = Token UUID
-  deriving newtype
-   ( Show, ToJSON, FromJSON, Eq, Ord, FromHttpApiData
-   , ToJSONKey, PersistField, PersistFieldSql, PathPiece
-   , ToHttpApiData, Read )
-instance ToSchema Token where
-  declareNamedSchema _ = declareNamedSchema (Proxy @String)
-instance ToParamSchema Token where
-  toParamSchema _ = toParamSchema (Proxy @String)
+-- newtype TrackerId = TrackerId UUID
+--   deriving newtype
+--    ( Show, ToJSON, FromJSON, Eq, Ord, FromHttpApiData
+--    , ToJSONKey, PersistField, PersistFieldSql, PathPiece
+--    , ToHttpApiData, Read )
+-- instance ToSchema TrackerId where
+--   declareNamedSchema _ = declareNamedSchema (Proxy @String)
+-- instance ToParamSchema TrackerId where
+--   toParamSchema _ = toParamSchema (Proxy @String)
 
 deriving newtype instance PersistField GTFS.Seconds
 deriving newtype instance PersistFieldSql GTFS.Seconds
@@ -86,6 +87,13 @@ latitude = fst . unGeoPos
 longitude :: Geopos -> Double
 longitude = snd . unGeoPos
 
+-- TODO: this is horrible. make a custom status msg type instead?
+derivePersistFieldJSON "Value"
+
+-- We derive these here so that OwnTracks.* can become its own package eventually
+derivePersistFieldJSON "OwnTracks.Status"
+
+
 share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
 Ticket sql=tt_ticket
   Id UUID default=uuid_generate_v4()
@@ -121,27 +129,37 @@ ShapePoint sql=tt_shape_point
 
 Shape sql=tt_shape
 
--- | tokens which have been issued
-Tracker sql=tt_tracker_token
-  Id Token default=uuid_generate_v4()
+-- | trackerIds which have been issued
+Tracker sql=tt_tracker
+  Id UUID default=uuid_generate_v4()
+  name Text Unique
   expires UTCTime
   blocked Bool
   agent Text
   currentTicket TicketId Maybe
   deriving Eq Show Generic
 
+TrackerStatus sql=tt_tracker_status
+  tracker TrackerId
+  timestamp UTCTime
+  status OwnTracks.Status
+
 TrackerTicket
   ticket TicketId OnDeleteCascade OnUpdateCascade
   tracker TrackerId OnDeleteCascade OnUpdateCascade
   UniqueTrackerTicket ticket tracker
 
 -- raw frames as received from OBUs
-TrainPing json sql=tt_trip_ping
-  ticket TicketId OnDeleteCascade OnUpdateCascade
-  token TrackerId OnDeleteSetNull OnUpdateCascade
+Ping json sql=tt_trip_ping
+  ticket TicketId Maybe OnDeleteCascade OnUpdateCascade
+  trackerId TrackerId OnDeleteSetNull OnUpdateCascade
   geopos Geopos
+  -- accuracy Int Maybe
+  -- altitute Int Maybe
+  -- battery Int Maybe
+  -- TODO
   timestamp UTCTime
-  sequence Double
+  sequence Double Maybe
   deriving Show Generic Eq
 
 -- status of a train somewhen in time (may be in the future),
@@ -156,6 +174,7 @@ TrainAnchor json sql=tt_trip_anchor
   deriving Show Generic Eq
 
 -- TODO: multi-language support?
+-- announcements for the gtfs realtime
 Announcement json sql=tt_announcements
   Id UUID default=uuid_generate_v4()
   ticket TicketId OnDeleteCascade OnUpdateCascade
@@ -177,8 +196,8 @@ instance ToSchema TicketId where
   declareNamedSchema _ = declareNamedSchema (Proxy @UUID)
 instance ToSchema TrackerId where
   declareNamedSchema _ = declareNamedSchema (Proxy @UUID)
-instance ToSchema TrainPing where
-  declareNamedSchema = genericDeclareNamedSchema (GTFS.swaggerOptions "trainPing")
+instance ToSchema Ping where
+  declareNamedSchema = genericDeclareNamedSchema (GTFS.swaggerOptions "ping")
 instance ToSchema TrainAnchor where
   declareNamedSchema = genericDeclareNamedSchema (GTFS.swaggerOptions "trainAnchor")
 instance ToSchema Announcement where
diff --git a/lib/Server/Base.hs b/lib/Server/Base.hs
index 14b77ca..17b5b4a 100644
--- a/lib/Server/Base.hs
+++ b/lib/Server/Base.hs
@@ -4,6 +4,6 @@ module Server.Base (ServerState) where
 import           Control.Concurrent.STM (TQueue, TVar)
 import qualified Data.Map               as M
 import           Data.UUID              (UUID)
-import           Persist                (TrainPing)
+import           Persist                (Ping)
 
-type ServerState = TVar (M.Map UUID [TQueue (Maybe TrainPing)])
+type ServerState = TVar (M.Map UUID [TQueue (Maybe Ping)])
diff --git a/lib/Server/Frontend/OnboardUnit.hs b/lib/Server/Frontend/OnboardUnit.hs
index 6a8fe6e..967cb6c 100644
--- a/lib/Server/Frontend/OnboardUnit.hs
+++ b/lib/Server/Frontend/OnboardUnit.hs
@@ -28,7 +28,7 @@ getOnboardTrackerR = do defaultLayout [whamlet|
 
   <section>
     <h2>Tracker
-    <strong>Token:</strong> <span id="token">
+    <strong>TrackerId:</strong> <span id="trackerId">
   <section>
     <h2>Status
     <p id="status">_{MsgNone}
@@ -44,7 +44,7 @@ getOnboardTrackerR = do defaultLayout [whamlet|
 
 
   <script>
-    var token = null;
+    var trackerId = null;
 
     let euclid = (a,b) => {
       let x = a[0]-b[0];
@@ -127,7 +127,7 @@ getOnboardTrackerR = do defaultLayout [whamlet|
 
       if (ws !== undefined && ws.readyState == 1) {
           ws.send(JSON.stringify({
-              token: token,
+              trackerId: trackerId,
               geopos: [ geoloc.coords.latitude, geoloc.coords.longitude ],
               timestamp: (new Date()).toISOString()
           }));
@@ -144,28 +144,28 @@ getOnboardTrackerR = do defaultLayout [whamlet|
 
       let urlparams = new URLSearchParams(window.location.search);
 
-      token = urlparams.get("token");
+      trackerId = urlparams.get("trackerId");
 
-        if (token === null) {
-          token = await (await fetch("/api/tracker/register/", {
+        if (trackerId === null) {
+          trackerId = await (await fetch("/api/tracker/register/", {
                method: "POST",
                body: JSON.stringify({agent: "tracktrain-website"}),
                headers: {"Content-Type": "application/json"}
           })).json();
 
-          if (token.error) {
-              alert("could not obtain token: \n" + token.msg);
-              setStatus("_{MsgTokenFailed}");
+          if (trackerId.error) {
+              alert("could not obtain trackerId: \n" + trackerId.msg);
+              setStatus("_{MsgTrackerIdFailed}");
           } else {
-              console.log("got token");
-              window.location.search = `?token=${token}`;
+              console.log("got trackerId");
+              window.location.search = `?trackerId=${trackerId}`;
           }
       }
 
-      console.log(token)
+      console.log(trackerId)
 
-      if (token !== null) {
-          document.getElementById("token").innerText = token;
+      if (trackerId !== null) {
+          document.getElementById("trackerId").innerText = trackerId;
           openWebsocket();
       }
     }
diff --git a/lib/Server/Frontend/Routes.hs b/lib/Server/Frontend/Routes.hs
index 9245e6a..75b1bda 100644
--- a/lib/Server/Frontend/Routes.hs
+++ b/lib/Server/Frontend/Routes.hs
@@ -19,7 +19,7 @@ import           Data.Time.Calendar        (Day)
 import           Data.UUID                 (UUID)
 import           Database.Persist.Sql      (SqlBackend, runSqlPool)
 import qualified GTFS
-import           Persist                   (Token)
+import           Persist                   (TrackerId)
 import           Text.Blaze.Internal       (MarkupM (Empty))
 import           Yesod
 import           Yesod.Auth
@@ -50,7 +50,7 @@ mkYesodData "Frontend" [parseRoutes|
 
 /spacetime SpaceTimeDiagramR GET
 
-/token/block/#Token TokenBlock GET
+/trackerId/block/#TrackerId TrackerIdBlock GET
 
 /gtfs/trips GtfsTripsViewR GET
 /gtfs/trip/#GTFS.TripId GtfsTripViewR GET
@@ -149,3 +149,4 @@ instance YesodAuth Frontend where
     redirect ("/auth/page/uffd/forward" :: Text)
   onLogout = do
     clearSession
+
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
diff --git a/lib/Server/GTFS_RT.hs b/lib/Server/GTFS_RT.hs
index 6ef6ed2..532af89 100644
--- a/lib/Server/GTFS_RT.hs
+++ b/lib/Server/GTFS_RT.hs
@@ -46,9 +46,9 @@ import           GTFS                        (Depth (..), GTFS (..),
 import           Persist                     (Announcement (..),
                                               EntityField (..), Key (..),
                                               Station (..), Stop (..),
-                                              Ticket (..), Token (..),
+                                              Ticket (..), TrackerId (..),
                                               Tracker (..), TrainAnchor (..),
-                                              TrainPing (..), latitude,
+                                              Ping (..), latitude,
                                               longitude, runSql)
 import qualified Proto.GtfsRealtime          as RT
 import qualified Proto.GtfsRealtime_Fields   as RT
@@ -168,7 +168,7 @@ gtfsRealtimeServer settings@ServerConfig{..} gtfs@GTFS{..} dbpool =
 
       -- TODO: reimplement this (since trainpings no longer reference tickets it's gone for now)
       -- positions <- forM ticket $ \(Entity key ticket) -> do
-      --   selectFirst [TrainPingTicket ==. key] [Desc TrainPingTimestamp] >>= \case
+      --   selectFirst [PingTicket ==. key] [Desc PingTimestamp] >>= \case
       --     Nothing -> pure Nothing
       --     Just lastPing ->
       --       pure (Just $ mkPosition (lastPing, ticket))
@@ -176,8 +176,8 @@ gtfsRealtimeServer settings@ServerConfig{..} gtfs@GTFS{..} dbpool =
       pure [] -- (catMaybes positions)
 
       where
-        mkPosition :: (Entity TrainPing, Ticket) -> RT.FeedEntity
-        mkPosition (Entity key TrainPing{..}, Ticket{..}) = defMessage
+        mkPosition :: (Entity Ping, Ticket) -> RT.FeedEntity
+        mkPosition (Entity key Ping{..}, Ticket{..}) = defMessage
           & RT.id .~ T.pack (show key)
           & RT.vehicle .~ (defMessage
               & RT.trip .~ defTripDescriptor ticketTripName Nothing Nothing
@@ -186,11 +186,11 @@ gtfsRealtimeServer settings@ServerConfig{..} gtfs@GTFS{..} dbpool =
                   Just trainset -> Just $ defMessage
                     & RT.label .~ trainset
               & RT.position .~ (defMessage
-                  & RT.latitude .~ double2Float (latitude trainPingGeopos)
-                  & RT.longitude .~ double2Float (longitude trainPingGeopos)
+                  & RT.latitude .~ double2Float (latitude pingGeopos)
+                  & RT.longitude .~ double2Float (longitude pingGeopos)
               )
               -- TODO: should probably give currentStopSequence/stopId here as well
-              & RT.timestamp .~ toStupidTime trainPingTimestamp
+              & RT.timestamp .~ toStupidTime pingTimestamp
           )
 
 
diff --git a/lib/Server/Ingest.hs b/lib/Server/Ingest.hs
index 959a4c6..8ef8082 100644
--- a/lib/Server/Ingest.hs
+++ b/lib/Server/Ingest.hs
@@ -107,11 +107,10 @@ handleTrainPing dbpool subscribers cfg onError ping@SentPing{..} =
       Nothing -> runSql dbpool (guessTicketFromPing cfg ping) >>= \case
         Just ticketId -> pure ticketId
         Nothing -> do
-          logWarnN $ "Tracker "+|UUID.toString (coerce sentPingToken)|+
+          logWarnN $ "Tracker "+|UUID.toString (coerce sentPingTrackerId)|+
             " sent a ping, but no trips are running today."
           throwError err400
 
-
     runSql dbpool $ insertSentPing subscribers cfg ping tracker ticketId
 
 insertSentPing
@@ -140,9 +139,9 @@ insertSentPing subscribers cfg ping@SentPing{..} tracker@Tracker{..} ticketId =
 
 
   maybeReassign <- selectFirst
-      [ TrainPingTicket ==. ticketId ]
-      [ Desc TrainPingTimestamp ]
-    <&> find (\ping -> trainPingSequence (entityVal ping) > trainAnchorSequence anchor)
+      [ PingTicket ==. Just ticketId, PingSequence !=. Nothing ]
+      [ Desc PingTimestamp ]
+    <&> find (\ping -> fromJust (pingSequence (entityVal ping)) > trainAnchorSequence anchor)
     >> guessTicketFromPing cfg ping
     <&> find (/= ticketId)
 
@@ -154,19 +153,19 @@ insertSentPing subscribers cfg ping@SentPing{..} tracker@Tracker{..} ticketId =
 
   case maybeReassign of
     Just newTicketId -> do
-      update sentPingToken
+      update sentPingTrackerId
         [TrackerCurrentTicket =. Just newTicketId ]
-      logInfoN $ "tracker "+|UUID.toText (coerce sentPingToken)|+
+      logInfoN $ "tracker "+|UUID.toText (coerce sentPingTrackerId)|+
         "has switched direction, and was reassigned to ticket "
         +|UUID.toText (coerce newTicketId)|+"."
       insertSentPing subscribers cfg ping tracker newTicketId
     Nothing -> do
-      let trackedPing = TrainPing
-           { trainPingToken = sentPingToken
-           , trainPingGeopos = sentPingGeopos
-           , trainPingTimestamp = sentPingTimestamp
-           , trainPingSequence = trainAnchorSequence anchor
-           , trainPingTicket = ticketId
+      let trackedPing = Ping
+           { pingTrackerId = sentPingTrackerId
+           , pingGeopos = sentPingGeopos
+           , pingTimestamp = sentPingTimestamp
+           , pingSequence = Just (trainAnchorSequence anchor)
+           , pingTicket = Just ticketId
            }
 
       insert trackedPing
@@ -182,11 +181,11 @@ insertSentPing subscribers cfg ping@SentPing{..} tracker@Tracker{..} ticketId =
             & (\(stop, _, _) -> stopSequence stop)
             & fromIntegral
       when (trainAnchorSequence anchor + 0.1 >= maxSequence) $ do
-        update sentPingToken
+        update sentPingTrackerId
           [TrackerCurrentTicket =. Nothing]
         update ticketId
           [TicketCompleted =. True]
-        logInfoN $ "Tracker "+|UUID.toString (coerce sentPingToken)|+
+        logInfoN $ "Tracker "+|UUID.toString (coerce sentPingTrackerId)|+
           " has completed ticket "+|UUID.toString (coerce ticketId)|+
           " (trip "+|ticketTripName|+")"
 
@@ -214,9 +213,9 @@ handleWS dbpool subscribers cfg Metrics{..} conn = do
         liftIO $ WS.sendClose conn (C8.pack err)
         -- TODO: send a close msg (Nothing) to the subscribed queues?               decGauge metricsWSGauge
       Right ping -> do
-        -- if invalid token, send a "polite" close request. Note that the client may
+        -- if invalid trackerId, send a "polite" close request. Note that the client may
         -- ignore this and continue sending messages, which will continue to be handled.
-        handleTrainPing dbpool subscribers cfg (liftIO $ WS.sendClose conn ("" :: ByteString)) ping >>= \case
+        handlePing dbpool subscribers cfg (liftIO $ WS.sendClose conn ("" :: ByteString)) ping >>= \case
           Just anchor -> liftIO $ WS.sendTextData conn (A.encode anchor)
           Nothing     -> pure ()
 
@@ -245,11 +244,11 @@ guessTicketFromPing cfg SentPing{..} = do
             in smallestDistance))
 
     logInfoN
-      $ "Tracker "+|UUID.toString (coerce sentPingToken)|+
+      $ "Tracker "+|UUID.toString (coerce sentPingTrackerId)|+
       " is now handling ticket "+|UUID.toString (coerce (entityKey closestTicket))|+
       " (trip "+|ticketTripName (entityVal closestTicket)|+")."
 
-    update sentPingToken
+    update sentPingTrackerId
       [TrackerCurrentTicket =. Just (entityKey closestTicket)]
 
     pure (Just (entityKey closestTicket))
@@ -260,9 +259,9 @@ spaceAndTimeDiff (pos1, time1) (pos2, time2) =
   where spaceDistance = euclid pos1 pos2
         timeDiff = time1 - time2
 
--- TODO: proper debug logging for expired tokens
-isTokenValid :: Pool SqlBackend -> TrackerId -> ServiceM (Maybe Tracker)
-isTokenValid dbpool token = runSql dbpool $ get token >>= \case
+-- TODO: proper debug logging for expired trackerIds
+isTrackerIdValid :: Pool SqlBackend -> TrackerId -> ServiceM (Maybe Tracker)
+isTrackerIdValid dbpool trackerId = runSql dbpool $ get trackerId >>= \case
   Just tracker | not (trackerBlocked tracker) -> do
     ifM (hasExpired (trackerExpires tracker))
       (pure Nothing)
diff --git a/lib/Server/Subscribe.hs b/lib/Server/Subscribe.hs
index 8559659..5b0edb5 100644
--- a/lib/Server/Subscribe.hs
+++ b/lib/Server/Subscribe.hs
@@ -37,9 +37,9 @@ handleSubscribe dbpool subscribers (ticketId :: UUID) conn = liftIO $ WS.withPin
 
   -- send most recent ping, if any (so we won't have to wait for movement)
   runSqlWithoutLog dbpool (selectOne do
-        ping <- from (table @TrainPing)
-        where_ (ping ^. TrainPingTicket ==. val (coerce ticketId))
-        orderBy [desc (ping ^. TrainPingTimestamp)]
+        ping <- from (table @Ping)
+        where_ (ping ^. PingTicket ==. val (Just (coerce ticketId)))
+        orderBy [desc (ping ^. PingTimestamp)]
         pure ping)
     <&> fmap entityVal
     >>= flip whenJust (WS.sendTextData conn . A.encode)
diff --git a/lib/Yesod/Orphans.hs b/lib/Yesod/Orphans.hs
index f66f8af..dc5c77a 100644
--- a/lib/Yesod/Orphans.hs
+++ b/lib/Yesod/Orphans.hs
@@ -27,14 +27,17 @@ instance ToMarkup Day where
 instance ToMessage UTCTime where
   toMessage = formatW3
 
-instance ToMessage Token where
-  toMessage (Token uuid) = UUID.toText uuid
+instance ToMessage TrackerId where
+  toMessage (TrackerKey uuid) = UUID.toText uuid
 
 instance ToMarkup UTCTime where
   toMarkup = toMarkup . formatW3
 
-instance ToMarkup Token where
-  toMarkup (Token uuid) = toMarkup (UUID.toText uuid)
+instance ToMarkup TrackerId where
+  toMarkup (TrackerKey uuid) = toMarkup (UUID.toText uuid)
+
+instance ToMarkup UUID where
+  toMarkup uuid = toMarkup (UUID.toText uuid)
 
 instance ToMessage Double where
   toMessage = T.pack . show
-- 
cgit v1.2.3