diff options
Diffstat (limited to 'lib/API.hs')
| -rw-r--r-- | lib/API.hs | 56 |
1 files changed, 36 insertions, 20 deletions
@@ -5,31 +5,33 @@ -- | The sole authorative definition of this server's API, given as a Servant-style -- Haskell type. All other descriptions of the API are generated from this one. -module API (API, CompleteAPI, GtfsRealtimeAPI) where +module API (API, CompleteAPI, GtfsRealtimeAPI, AdminAPI) where -import Data.Map (Map) -import Data.Proxy (Proxy (..)) -import Data.Swagger (Swagger) -import Data.Swagger.ParamSchema (ToParamSchema (..)) -import Data.Time (Day, UTCTime) +import Data.Map (Map) +import Data.Proxy (Proxy (..)) +import Data.Swagger (Swagger) +import Data.Swagger.ParamSchema (ToParamSchema (..)) +import Data.Text (Text) +import Data.Time (Day, UTCTime) import GTFS +import GTFS.Realtime.FeedEntity +import GTFS.Realtime.FeedMessage (FeedMessage) import Persist -import Servant (Application, - FromHttpApiData (parseUrlPiece), - Server, err401, err404, serve, - throwError, type (:>)) -import Servant.API (Capture, FromHttpApiData, Get, JSON, - Post, QueryParam, ReqBody, - type (:<|>) ((:<|>))) -import Servant.GTFS.Realtime (Proto) -import GTFS.Realtime.FeedEntity -import GTFS.Realtime.FeedMessage (FeedMessage) +import Servant (Application, + FromHttpApiData (parseUrlPiece), + Server, err401, err404, serve, + throwError, type (:>)) +import Servant.API (Capture, FromHttpApiData, Get, JSON, + Post, QueryParam, ReqBody, + type (:<|>) ((:<|>))) +import Servant.GTFS.Realtime (Proto) +import Data.UUID (UUID) -- | The server's API (as it is actually intended). type API = "stations" :> Get '[JSON] (Map StationID Station) - :<|> "timetable" :> Capture "Station ID" StationID :> QueryParam "day" Day :> Get '[JSON] (Map TripID (Trip Deep)) - :<|> "trip" :> Capture "Trip ID" TripID :> Get '[JSON] (Trip Deep) + :<|> "timetable" :> Capture "Station ID" StationID :> QueryParam "day" Day :> Get '[JSON] (Map TripID (Trip Deep Deep)) + :<|> "trip" :> Capture "Trip ID" TripID :> Get '[JSON] (Trip Deep Deep) -- ingress API (put this behind BasicAuth?) -- TODO: perhaps require a first ping for registration? :<|> "train" :> "register" :> Capture "Trip ID" TripID :> Post '[JSON] Token @@ -38,11 +40,22 @@ type API = "stations" :> Get '[JSON] (Map StationID Station) -- debug things :<|> "debug" :> "state" :> Get '[JSON] (Map Token [TripPing]) :<|> "gtfs" :> GtfsRealtimeAPI + :<|> "admin" :> AdminAPI -- | The API used for publishing gtfs realtime updates type GtfsRealtimeAPI = "servicealerts" :> Get '[Proto] FeedMessage - :<|> "tripupdates" :> Get '[Proto] FeedEntity - :<|> "vehiclepositions" :> Get '[Proto] FeedEntity + :<|> "tripupdates" :> Get '[Proto] FeedMessage + :<|> "vehiclepositions" :> Get '[Proto] FeedMessage + +-- | Admin API used for short-term timetable changes etc. ("leitstelle") +type AdminAPI = + "trip" :> "announce" :> Capture "Trip ID" TripID :> QueryParam "day" Day :> ReqBody '[JSON] Text :> Post '[JSON] UUID + :<|> "trip" :> "announce" :> "delete" :> Capture "Announcement ID" UUID :> Post '[JSON] () + :<|> "trip" :> "date" :> "add" :> Capture "Trip ID" TripID :> Post '[JSON] () + :<|> "trip" :> "date" :> "cancel" :> Capture "Trip ID" TripID :> Post '[JSON] () +-- TODO for this to be useful there ought to be a half-deep Trip type +-- (that has stops but not shapes) + :<|> "extraordinary" :> "trip" :> ReqBody '[JSON] (Trip Deep Shallow) :> Post '[JSON] () -- | The server's API with an additional debug route for accessing the specification @@ -52,9 +65,12 @@ type CompleteAPI = "debug" :> "openapi" :> Get '[JSON] Swagger :<|> API + instance ToParamSchema (Maybe UTCTime) where toParamSchema _ = toParamSchema (Proxy @UTCTime) + + {- TODO: there should be a basic API allowing the questions: |