From 0197560d9d9ea6ac95146906964fc2408fbf1a31 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 2 Jul 2022 23:55:22 +0200
Subject: websockets and better (empty) response messages

(tough mostly untested)
---
 lib/API.hs | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

(limited to 'lib/API.hs')

diff --git a/lib/API.hs b/lib/API.hs
index 845ad06..8d352e1 100644
--- a/lib/API.hs
+++ b/lib/API.hs
@@ -22,9 +22,11 @@ import           Servant                   (Application,
                                             Server, err401, err404, serve,
                                             throwError, type (:>))
 import           Servant.API               (Capture, FromHttpApiData, Get, JSON,
-                                            Post, QueryParam, ReqBody,
-                                            type (:<|>) ((:<|>)))
+                                            NoContent, Post, QueryParam,
+                                            ReqBody, type (:<|>) ((:<|>)))
+import           Servant.API.WebSocket     (WebSocket)
 import           Servant.GTFS.Realtime     (Proto)
+import           Servant.Swagger           (HasSwagger (..))
 
 import           Data.UUID                 (UUID)
 
@@ -36,7 +38,8 @@ type API = "stations" :> Get '[JSON] (Map StationID Station)
   -- 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] ()
+  :<|> "train" :> "ping" :> ReqBody '[JSON] TripPing :> Post '[JSON] NoContent
+  :<|> "train" :> "ping" :> "ws" :> WebSocket
   -- debug things
   :<|> "debug" :> "state" :> Get '[JSON] (Map Token [TripPing])
   :<|> "gtfs" :> GtfsRealtimeAPI
@@ -51,12 +54,12 @@ type GtfsRealtimeAPI = "servicealerts" :> 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] ()
+  :<|> "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] ()
+  :<|> "extraordinary" :> "trip" :> ReqBody '[JSON] (Trip Deep Shallow) :> Post '[JSON] NoContent
 
 
 -- | The server's API with an additional debug route for accessing the specification
@@ -70,8 +73,9 @@ type CompleteAPI = "debug" :> "openapi" :> Get '[JSON] Swagger
 instance ToParamSchema (Maybe UTCTime) where
   toParamSchema _ = toParamSchema (Proxy @UTCTime)
 
-
-
+-- 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:
-- 
cgit v1.2.3