[websockets] fix routing (frontend is a catch-all)

parent f824ffaf
...@@ -44,8 +44,9 @@ data NamedAPI mode = NamedAPI ...@@ -44,8 +44,9 @@ data NamedAPI mode = NamedAPI
{ swaggerAPI :: mode :- SwaggerSchemaUI "swagger-ui" "swagger.json" { swaggerAPI :: mode :- SwaggerSchemaUI "swagger-ui" "swagger.json"
, backendAPI :: mode :- NamedRoutes BackEndAPI , backendAPI :: mode :- NamedRoutes BackEndAPI
, graphqlAPI :: mode :- NamedRoutes GraphQLAPI , graphqlAPI :: mode :- NamedRoutes GraphQLAPI
, frontendAPI :: mode :- FrontEndAPI
, wsAPI :: mode :- NamedRoutes Dispatcher.WSAPI , wsAPI :: mode :- NamedRoutes Dispatcher.WSAPI
-- NOTE: FrontEndAPI is Raw and is a catch-all so needs to be at the end!
, frontendAPI :: mode :- FrontEndAPI
} deriving Generic } deriving Generic
......
...@@ -61,12 +61,12 @@ server env = ...@@ -61,12 +61,12 @@ server env =
(Proxy :: Proxy AuthContext) (Proxy :: Proxy AuthContext)
(transformJSONGQL errScheme) (transformJSONGQL errScheme)
GraphQL.api GraphQL.api
, frontendAPI = frontEndServer
, wsAPI = hoistServer , wsAPI = hoistServer
(Proxy :: Proxy (NamedRoutes Dispatcher.WSAPI)) (Proxy :: Proxy (NamedRoutes Dispatcher.WSAPI))
-- (Proxy :: Proxy AuthContext) -- (Proxy :: Proxy AuthContext)
(transformJSON errScheme) (transformJSON errScheme)
Dispatcher.wsServer Dispatcher.wsServer
, frontendAPI = frontEndServer
} }
where where
transformJSON :: forall a. GargErrorScheme -> GargM Env BackendInternalError a -> Handler a transformJSON :: forall a. GargErrorScheme -> GargM Env BackendInternalError a -> Handler a
......
...@@ -108,8 +108,7 @@ newtype WSAPI mode = WSAPI { ...@@ -108,8 +108,7 @@ newtype WSAPI mode = WSAPI {
wsAPIServer :: mode :- "ws" :> Summary "WebSocket endpoint" :> WS.WebSocketPending wsAPIServer :: mode :- "ws" :> Summary "WebSocket endpoint" :> WS.WebSocketPending
} deriving Generic } deriving Generic
-- wsServer :: IsGargServer env err m => Settings -> SSet.Set Subscription -> WSAPI (AsServerT m)
-- wsServer authSettings subscriptions = WSAPI { wsAPI = streamData }
wsServer :: ( IsGargServer env err m, HasDispatcher env, HasSettings env ) => WSAPI (AsServerT m) wsServer :: ( IsGargServer env err m, HasDispatcher env, HasSettings env ) => WSAPI (AsServerT m)
wsServer = WSAPI { wsAPIServer = streamData } wsServer = WSAPI { wsAPIServer = streamData }
where where
...@@ -129,7 +128,7 @@ wsServer = WSAPI { wsAPIServer = streamData } ...@@ -129,7 +128,7 @@ wsServer = WSAPI { wsAPIServer = streamData }
-- Sec-WebSocket-Key so we want to make that even more unique. -- Sec-WebSocket-Key so we want to make that even more unique.
uuid <- liftBase $ UUID.nextRandom uuid <- liftBase $ UUID.nextRandom
let key = key' <> "-" <> show uuid let key = key' <> "-" <> show uuid
liftBase $ putText $ show $ WS.requestHeaders reqHead -- liftBase $ putText $ show $ WS.requestHeaders reqHead
c <- liftBase $ WS.acceptRequest pc c <- liftBase $ WS.acceptRequest pc
let ws = WSKeyConnection (key, c) let ws = WSKeyConnection (key, c)
_ <- liftBase $ Async.concurrently (wsLoop authSettings subscriptions ws) (pingLoop ws) _ <- liftBase $ Async.concurrently (wsLoop authSettings subscriptions ws) (pingLoop ws)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment