aboutsummaryrefslogtreecommitdiff
path: root/lib/Server
diff options
context:
space:
mode:
authorstuebinm2022-07-02 18:14:47 +0200
committerstuebinm2022-07-02 18:14:47 +0200
commitd5c7beb4507f5a0ba361464173447ed3521d9973 (patch)
treef6eb32fc35053bc986fc37db5a125db800b8d8c0 /lib/Server
parent84a620a47bd23d5d0f93ae6c7abe5d622005044d (diff)
rudimentary admin api implementation
Diffstat (limited to '')
-rw-r--r--lib/Server.hs19
-rw-r--r--lib/Server/GTFSRT.hs1
2 files changed, 18 insertions, 2 deletions
diff --git a/lib/Server.hs b/lib/Server.hs
index 5ece540..2b86b6e 100644
--- a/lib/Server.hs
+++ b/lib/Server.hs
@@ -29,7 +29,7 @@ import Data.Map (Map)
import qualified Data.Map as M
import Data.Pool (Pool)
import Data.Proxy (Proxy (Proxy))
-import Data.Swagger hiding (get)
+import Data.Swagger hiding (get, delete)
import Data.Text (Text)
import Data.Time (NominalDiffTime,
UTCTime (utctDay), addUTCTime,
@@ -112,7 +112,22 @@ server gtfs@GTFS{..} dbpool = handleDebugAPI :<|> handleStations :<|> handleTime
adminServer :: GTFS -> Pool SqlBackend -> Server AdminAPI
-adminServer = undefined
+adminServer gtfs dbpool =
+ addAnnounce :<|> delAnnounce :<|> modTripDate Added Cancelled
+ :<|> modTripDate Cancelled Added :<|> extraTrip
+ where addAnnounce ann@Announcement{..} = runSql dbpool $ do
+ AnnouncementKey uuid <- insert ann
+ pure uuid
+ delAnnounce uuid = runSql dbpool $ do
+ delete (AnnouncementKey uuid)
+ modTripDate one two tripId day = runSql dbpool $ do
+ getBy (TripAndDay tripId day) >>= \case
+ Just (Entity key (ScheduleAmendment _ _ status)) -> do
+ when (status == two) $ delete key
+ Nothing -> do
+ insert (ScheduleAmendment tripId day one)
+ pure ()
+ extraTrip = error "unimplemented!"
-- TODO: proper debug logging for expired tokens
diff --git a/lib/Server/GTFSRT.hs b/lib/Server/GTFSRT.hs
index 0a654c6..bd285ff 100644
--- a/lib/Server/GTFSRT.hs
+++ b/lib/Server/GTFSRT.hs
@@ -144,6 +144,7 @@ gtfsRealtimeServer gtfs dbpool = handleServiceAlerts :<|> handleTripUpdates :<|>
, bearing = Nothing
, POS.ext'field = defaultValue
}
+ -- TODO: at least one of these should probably be given
, current_stop_sequence = Nothing
, stop_id = Nothing
, current_status = Nothing