diff options
Diffstat (limited to 'lib/Server.hs')
| -rw-r--r-- | lib/Server.hs | 23 |
1 files changed, 13 insertions, 10 deletions
diff --git a/lib/Server.hs b/lib/Server.hs index 3fc2c5a..e418226 100644 --- a/lib/Server.hs +++ b/lib/Server.hs @@ -44,7 +44,8 @@ import Server.Base (ServerState) import Server.Frontend (Frontend (..)) import Server.GTFS_RT (gtfsRealtimeServer) import Server.Ingest (handleTrackerRegister, - handleTrainPing, handleWS) + handlePing, handleWS, + handleOwntracksMessage) import Server.Subscribe (handleSubscribe) import Server.Util (Service, runLogging, runService, serveDirectoryFileServer) @@ -78,14 +79,15 @@ server -> Pool SqlBackend -> ServerConfig -> Service CompleteAPI -server gtfs metrics@Metrics{..} subscribers dbpool settings = handleDebugAPI - :<|> (handleTrackerRegister dbpool - :<|> handleTrainPing dbpool subscribers settings (throwError err401) +server gtfs metrics@Metrics{..} subscribers dbpool settings = {- handleDebugAPI + :<|> -} (handleTrackerRegister dbpool + :<|> handlePing dbpool subscribers settings (throwError err401) :<|> handleWS dbpool subscribers settings metrics :<|> handleCurrentTicker :<|> handleSubscribe dbpool subscribers :<|> handleDebugState :<|> handleDebugTrain - :<|> pure (GTFS.gtfsFile gtfs) :<|> gtfsRealtimeServer gtfs dbpool) + :<|> pure (GTFS.gtfsFile gtfs) :<|> gtfsRealtimeServer settings gtfs dbpool + :<|> owntracksServer) :<|> handleMetrics :<|> serveDirectoryFileServer (serverConfigAssets settings) :<|> pure (unsafePerformIO (toWaiAppPlain (Frontend gtfs dbpool settings))) @@ -94,8 +96,8 @@ server gtfs metrics@Metrics{..} subscribers dbpool settings = handleDebugAPI now <- liftIO getCurrentTime runSql dbpool $ do tracker <- selectList [TrackerBlocked ==. False, TrackerExpires >=. now] [] - pairs <- forM tracker $ \(Entity token@(TrackerKey uuid) _) -> do - entities <- selectList [TrainPingToken ==. token] [] + pairs <- forM tracker $ \(Entity trackerId@(TrackerKey uuid) _) -> do + entities <- selectList [PingTrackerId ==. trackerId] [] pure (uuid, fmap entityVal entities) pure (M.fromList pairs) handleCurrentTicker = runSql dbpool $ do @@ -108,11 +110,12 @@ server gtfs metrics@Metrics{..} subscribers dbpool settings = handleDebugAPI ] handleDebugTrain ticketId = runSql dbpool $ do trackers <- getTicketTrackers ticketId - pings <- forM trackers $ \(Entity token _) -> do - selectList [TrainPingToken ==. token] [] <&> fmap entityVal + pings <- forM trackers $ \(Entity trackerId _) -> do + selectList [PingTrackerId ==. trackerId] [] <&> fmap entityVal pure (concat pings) - handleDebugAPI = pure $ toSwagger (Proxy @API) + -- handleDebugAPI = pure $ toSwagger (Proxy @API) handleMetrics = exportMetricsAsText <&> (decodeUtf8 . toStrict) + owntracksServer u d location = handleOwntracksMessage dbpool subscribers settings u d location getTicketTrackers :: (MonadLogger (t (ResourceT IO)), MonadIO (t (ResourceT IO))) => UUID -> ReaderT SqlBackend (t (ResourceT IO)) [Entity Tracker] |