diff options
Diffstat (limited to 'lib/Server/Ingest.hs')
| -rw-r--r-- | lib/Server/Ingest.hs | 43 |
1 files changed, 21 insertions, 22 deletions
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) |