diff options
Diffstat (limited to '')
-rw-r--r-- | lib/API.hs | 55 |
1 files changed, 23 insertions, 32 deletions
@@ -1,15 +1,17 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} -- | 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, AdminAPI) where +module API (API, CompleteAPI, GtfsRealtimeAPI, RegisterJson(..)) where import Data.Map (Map) import Data.Proxy (Proxy (..)) -import Data.Swagger (Swagger) +import Data.Swagger (Swagger, ToSchema (..), + genericDeclareNamedSchema) import Data.Swagger.ParamSchema (ToParamSchema (..)) import Data.Text (Text) import Data.Time (Day, UTCTime) @@ -25,12 +27,22 @@ import Servant.GTFS.Realtime (Proto) import Servant.Swagger (HasSwagger (..)) import Web.Internal.FormUrlEncoded (Form) +import Data.Aeson (FromJSON (..), genericParseJSON) +import GHC.Generics (Generic) import GTFS import GTFS.Realtime.FeedEntity import GTFS.Realtime.FeedMessage (FeedMessage) import Persist import Server.ControlRoom +data RegisterJson = RegisterJson + { registerAgent :: Text } + deriving (Show, Generic) + +instance FromJSON RegisterJson where + parseJSON = genericParseJSON (aesonOptions "register") +instance ToSchema RegisterJson where + declareNamedSchema = genericDeclareNamedSchema (swaggerOptions "station") -- | The server's API (as it is actually intended). type API = "stations" :> Get '[JSON] (Map StationID Station) @@ -38,52 +50,31 @@ type API = "stations" :> Get '[JSON] (Map StationID Station) :<|> "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 + :<|> "train" :> "register" :> Capture "Trip ID" TripID :> ReqBody '[JSON] RegisterJson :> Post '[JSON] Token -- TODO: perhaps a websocket instead? - :<|> "train" :> "ping" :> ReqBody '[JSON] TripPing :> Post '[JSON] NoContent + :<|> "train" :> "ping" :> ReqBody '[JSON] TrainPing :> Post '[JSON] NoContent :<|> "train" :> "ping" :> "ws" :> WebSocket -- debug things - :<|> "debug" :> "state" :> Get '[JSON] (Map Token [TripPing]) + :<|> "debug" :> "pings" :> Get '[JSON] (Map Token [TrainPing]) + :<|> "debug" :> "pings" :> Capture "Trip ID" TripID :> Capture "day" Day :> Get '[JSON] [TrainPing] + :<|> "debug" :> "register" :> Capture "Trip ID" TripID :> Capture "day" Day :> Post '[JSON] Token :<|> "gtfs" :> GtfsRealtimeAPI - -- TODO: this should be behind auth / OpenID or something - :<|> "admin" :> AdminAPI -- | The API used for publishing gtfs realtime updates type GtfsRealtimeAPI = "servicealerts" :> Get '[Proto] FeedMessage :<|> "tripupdates" :> Get '[Proto] FeedMessage :<|> "vehiclepositions" :> Get '[Proto] FeedMessage --- | Admin API used for short-term timetable changes etc. ("leitstelle") -type AdminAPI = - "trip" :> "announce" :> ReqBody '[JSON] Announcement :> Post '[JSON] UUID - :<|> "trip" :> "announce" :> "delete" :> Capture "Announcement ID" UUID :> Post '[JSON] NoContent - :<|> "trip" :> "date" :> "add" :> Capture "Trip ID" TripID :> Capture "day" Day :> Post '[JSON] NoContent - :<|> "trip" :> "date" :> "cancel" :> Capture "Trip ID" TripID :> Capture "day" Day :> Post '[JSON] NoContent --- 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] NoContent - -- | The server's API with an additional debug route for accessing the specification -- itself. Split from API to prevent the API documenting the format in which it is -- documented, which would be silly and way to verbose. -type CompleteAPI = "debug" :> "openapi" :> Get '[JSON] Swagger - :<|> API - :<|> "cr" :> Raw +type CompleteAPI = + "api" :> "openapi" :> Get '[JSON] Swagger + :<|> "api" :> API + :<|> Raw -- hook for yesod frontend -- TODO write something useful here! (and if it's just "hey this is some websocket thingie") instance HasSwagger WebSocket where toSwagger _ = toSwagger (Proxy @(Post '[JSON] NoContent)) -{- -TODO: -there should be a basic API allowing the questions: - - what are the next trips leaving from $station? (or $geolocation?) - - all stops of a given tripID - -then the "ingress" API: - - train ping (location, estimated delay, etc.) - - cancel trip - - add trip? - --} |