aboutsummaryrefslogtreecommitdiff
path: root/lib/API.hs
blob: 845ad06afcce836ef974d4bf98af9a81baf47c3d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
{-# LANGUAGE DataKinds         #-}
{-# 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

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           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 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
  -- TODO: perhaps a websocket instead?
  :<|> "train" :> "ping" :> ReqBody '[JSON] TripPing :> Post '[JSON] ()
  -- debug things
  :<|> "debug" :> "state" :> Get '[JSON] (Map Token [TripPing])
  :<|> "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] ()
  :<|> "trip" :> "date" :> "add" :> Capture "Trip ID" TripID :> Capture "day" Day :> Post '[JSON] ()
  :<|> "trip" :> "date" :> "cancel" :> Capture "Trip ID" TripID :> Capture "day" Day :> 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
-- 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



instance ToParamSchema (Maybe UTCTime) where
  toParamSchema _ = toParamSchema (Proxy @UTCTime)



{-
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?

-}