Skip to content

Commit 8ce3661

Browse files
supersvenpcapriotti
supersven
and
pcapriotti
authored
Servantify Cannon Public endpoint (#2024)
Servantify Cannon Public endpoint * Clean up * Remove servant-websockets by inlining it and fixing a subtle bug regarding failing requests * Better swagger doc inspired by MultiVerb * Add changelog entry * Update comment regarding the origin of WebSocketPending * Fix review issues Co-authored-by: Paolo Capriotti <[email protected]>
1 parent 8ba383c commit 8ce3661

File tree

13 files changed

+169
-78
lines changed

13 files changed

+169
-78
lines changed

‎cabal.project.freeze‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1957,7 +1957,6 @@ constraints: any.AC-Angle ==1.0,
19571957
any.servant-swagger-ui ==0.3.4.3.36.1,
19581958
any.servant-swagger-ui-core ==0.3.3,
19591959
any.servant-swagger-ui-redoc ==0.3.3.1.22.3,
1960-
any.servant-websockets ==2.0.0,
19611960
any.servant-yaml ==0.1.0.1,
19621961
any.serverless-haskell ==0.11.3,
19631962
any.serversession ==1.0.1,

‎changelog.d/5-internal/servantify-cannon-public-api‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
Migrate the public API of Cannon to Servant. (There is an internal API that is not yet migrated.)

‎libs/wire-api/package.yaml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -88,6 +88,8 @@ library:
8888
- wire-message-proto-lens
8989
- x509
9090
- wai
91+
- wai-websockets
92+
- websockets
9193

9294
tests:
9395
wire-api-tests:

‎services/cannon/src/Cannon/API.hs‎ renamed to ‎libs/wire-api/src/Wire/API/Routes/Public/Cannon.hs‎

Lines changed: 25 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
-- This file is part of the Wire Server implementation.
22
--
3-
-- Copyright (C) 2020 Wire Swiss GmbH <[email protected]>
3+
-- Copyright (C) 2021 Wire Swiss GmbH <[email protected]>
44
--
55
-- This program is free software: you can redistribute it and/or modify it under
66
-- the terms of the GNU Affero General Public License as published by the Free
@@ -15,19 +15,29 @@
1515
-- You should have received a copy of the GNU Affero General Public License along
1616
-- with this program. If not, see <https://www.gnu.org/licenses/>.
1717

18-
module Cannon.API
19-
( sitemap,
20-
)
21-
where
18+
module Wire.API.Routes.Public.Cannon where
2219

23-
import qualified Cannon.API.Internal as Internal
24-
import qualified Cannon.API.Public as Public
25-
import Cannon.Types (Cannon)
26-
import qualified Data.Swagger.Build.Api as Doc
27-
import Network.Wai.Routing (Routes)
20+
import Data.Id
21+
import Data.Swagger
22+
import Servant
23+
import Servant.Swagger
24+
import Wire.API.Routes.Public (ZConn, ZUser)
25+
import Wire.API.Routes.WebSocket
2826

29-
sitemap :: Routes Doc.ApiBuilder Cannon ()
30-
sitemap = do
31-
Public.sitemap
32-
Public.apiDocs
33-
Internal.sitemap
27+
type ServantAPI =
28+
Summary "Establish websocket connection"
29+
:> "await"
30+
:> ZUser
31+
:> ZConn
32+
:> QueryParam'
33+
[ Optional,
34+
Strict,
35+
Description "Client ID"
36+
]
37+
"client"
38+
ClientId
39+
-- FUTUREWORK: Consider higher-level web socket combinator
40+
:> WebSocketPending
41+
42+
swaggerDoc :: Swagger
43+
swaggerDoc = toSwagger (Proxy @ServantAPI)

‎libs/wire-api/src/Wire/API/Routes/WebSocket.hs‎

Lines changed: 89 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,89 @@
1+
-- This file is part of the Wire Server implementation.
2+
--
3+
-- Copyright (C) 2021 Wire Swiss GmbH <[email protected]>
4+
--
5+
-- This program is free software: you can redistribute it and/or modify it under
6+
-- the terms of the GNU Affero General Public License as published by the Free
7+
-- Software Foundation, either version 3 of the License, or (at your option) any
8+
-- later version.
9+
--
10+
-- This program is distributed in the hope that it will be useful, but WITHOUT
11+
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12+
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
13+
-- details.
14+
--
15+
-- You should have received a copy of the GNU Affero General Public License along
16+
-- with this program. If not, see <https://www.gnu.org/licenses/>.
17+
18+
module Wire.API.Routes.WebSocket where
19+
20+
import Control.Lens
21+
import Control.Monad.Trans.Resource
22+
import Data.HashMap.Strict.InsOrd
23+
import Data.Metrics.Servant
24+
import Data.Proxy
25+
import Data.Swagger
26+
import Imports
27+
import Network.Wai.Handler.WebSockets
28+
import Network.WebSockets
29+
import Servant.Server hiding (respond)
30+
import Servant.Server.Internal.Delayed
31+
import Servant.Server.Internal.RouteResult
32+
import Servant.Server.Internal.Router
33+
import Servant.Swagger
34+
35+
-- | A websocket that relates to a 'PendingConnection'
36+
-- Copied and adapted from: <https://hackage.haskell.org/package/servant-websockets-2.0.0/docs/Servant-API-WebSocket.html#t:WebSocketPending>
37+
data WebSocketPending
38+
39+
instance HasServer WebSocketPending ctx where
40+
type ServerT WebSocketPending m = PendingConnection -> m ()
41+
42+
hoistServerWithContext _ _ nat svr = nat . svr
43+
44+
route Proxy _ app = leafRouter $ \env request respond ->
45+
runResourceT $
46+
runDelayed app env request >>= liftIO . go request respond
47+
where
48+
go request respond (Route app') =
49+
websocketsOr defaultConnectionOptions (runApp app') (backupApp respond) request (respond . Route)
50+
go _ respond (Fail e) = respond $ Fail e
51+
go _ respond (FailFatal e) = respond $ FailFatal e
52+
53+
runApp a c = void (runHandler $ a c)
54+
55+
backupApp respond _ _ =
56+
respond $
57+
FailFatal
58+
ServerError
59+
{ errHTTPCode = 426,
60+
errReasonPhrase = "Upgrade Required",
61+
errBody = mempty,
62+
errHeaders = mempty
63+
}
64+
65+
instance HasSwagger WebSocketPending where
66+
toSwagger _ =
67+
mempty
68+
& paths
69+
. at "/"
70+
?~ ( mempty
71+
& get
72+
?~ ( mempty
73+
& responses . responses .~ resps
74+
& externalDocs
75+
?~ ( mempty
76+
& description ?~ "RFC 6455"
77+
& url .~ URL "https://datatracker.ietf.org/doc/html/rfc6455"
78+
)
79+
)
80+
)
81+
where
82+
resps :: InsOrdHashMap HttpStatusCode (Referenced Data.Swagger.Response)
83+
resps =
84+
mempty
85+
& at 101 ?~ Inline (mempty & description .~ "Connection upgraded.")
86+
& at 426 ?~ Inline (mempty & description .~ "Upgrade required.")
87+
88+
instance RoutesToPaths WebSocketPending where
89+
getRoutes = []

‎libs/wire-api/wire-api.cabal‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ cabal-version: 1.12
44
--
55
-- see: https://github.com/sol/hpack
66
--
7-
-- hash: f2aacb81c413e8753829ba09eb08d1d2524c973346739389dfeb4284d4a16ebd
7+
-- hash: 58d272ac852b49af92f6387c08a6a4f797f799df93374f68296cb67600b00653
88

99
name: wire-api
1010
version: 0.1.0
@@ -56,12 +56,14 @@ library
5656
Wire.API.Routes.MultiVerb
5757
Wire.API.Routes.Public
5858
Wire.API.Routes.Public.Brig
59+
Wire.API.Routes.Public.Cannon
5960
Wire.API.Routes.Public.Cargohold
6061
Wire.API.Routes.Public.Galley
6162
Wire.API.Routes.Public.LegalHold
6263
Wire.API.Routes.Public.Spar
6364
Wire.API.Routes.Public.Util
6465
Wire.API.Routes.QualifiedCapture
66+
Wire.API.Routes.WebSocket
6567
Wire.API.ServantProto
6668
Wire.API.Swagger
6769
Wire.API.Team
@@ -173,6 +175,8 @@ library
173175
, uuid >=1.3
174176
, vector >=0.12
175177
, wai
178+
, wai-websockets
179+
, websockets
176180
, wire-message-proto-lens
177181
, x509
178182
default-language: Haskell2010

‎services/brig/src/Brig/API/Public.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -104,6 +104,7 @@ import qualified Wire.API.Properties as Public
104104
import qualified Wire.API.Routes.MultiTablePaging as Public
105105
import Wire.API.Routes.Public.Brig (Api (updateConnectionUnqualified))
106106
import qualified Wire.API.Routes.Public.Brig as BrigAPI
107+
import qualified Wire.API.Routes.Public.Cannon as CannonAPI
107108
import qualified Wire.API.Routes.Public.Cargohold as CargoholdAPI
108109
import qualified Wire.API.Routes.Public.Galley as GalleyAPI
109110
import qualified Wire.API.Routes.Public.LegalHold as LegalHoldAPI
@@ -137,6 +138,7 @@ swaggerDocsAPI =
137138
<> LegalHoldAPI.swaggerDoc
138139
<> SparAPI.swaggerDoc
139140
<> CargoholdAPI.swaggerDoc
141+
<> CannonAPI.swaggerDoc
140142
)
141143
& S.info . S.title .~ "Wire-Server API"
142144
& S.info . S.description ?~ Brig.Docs.Swagger.contents <> mempty

‎services/cannon/cannon.cabal‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ cabal-version: 1.12
44
--
55
-- see: https://github.com/sol/hpack
66
--
7-
-- hash: 87d683d193f2ad916c72f4c84d0816911f7d894cfbffed36f361436005571339
7+
-- hash: 5c6e877bcba6cc776493801203320fecfcec06a1384cc5cb0150262e4ef0f3b8
88

99
name: cannon
1010
version: 0.31.0
@@ -25,7 +25,6 @@ flag static
2525

2626
library
2727
exposed-modules:
28-
Cannon.API
2928
Cannon.API.Internal
3029
Cannon.API.Public
3130
Cannon.App
@@ -63,6 +62,8 @@ library
6362
, mwc-random >=0.13
6463
, retry >=0.7
6564
, safe-exceptions
65+
, servant
66+
, servant-server
6667
, strict >=0.3.2
6768
, swagger >=0.2
6869
, text >=1.1
@@ -78,6 +79,7 @@ library
7879
, wai-websockets >=3.0
7980
, warp >=3.0
8081
, websockets >=0.11.2
82+
, wire-api
8183
default-language: Haskell2010
8284

8385
executable cannon

‎services/cannon/package.yaml‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,8 @@ library:
3434
- mwc-random >=0.13
3535
- retry >=0.7
3636
- safe-exceptions
37+
- servant
38+
- servant-server
3739
- strict >=0.3.2
3840
- swagger >=0.2
3941
- text >=1.1
@@ -49,6 +51,7 @@ library:
4951
- wai-websockets >=3.0
5052
- warp >=3.0
5153
- websockets >=0.11.2
54+
- wire-api
5255
executables:
5356
cannon:
5457
main: src/Main.hs

‎services/cannon/src/Cannon/API/Public.hs‎

Lines changed: 15 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -16,62 +16,27 @@
1616
-- with this program. If not, see <https://www.gnu.org/licenses/>.
1717

1818
module Cannon.API.Public
19-
( sitemap,
20-
apiDocs,
19+
( API,
20+
publicAPIServer,
2121
)
2222
where
2323

24-
import Cannon.App
24+
import Cannon.App (wsapp)
2525
import Cannon.Types
2626
import Cannon.WS
27-
import Data.Id (ClientId, ConnId, UserId)
28-
import Data.Swagger.Build.Api hiding (Response)
29-
import Imports
30-
import Network.HTTP.Types
31-
import Network.Wai
32-
import Network.Wai.Handler.WebSockets
33-
import Network.Wai.Predicate
34-
import Network.Wai.Routing
35-
import Network.Wai.Utilities
36-
import Network.Wai.Utilities.Swagger
37-
import qualified Network.WebSockets as Ws
27+
import Control.Monad.IO.Class
28+
import Data.Id
29+
import GHC.Base
30+
import Network.WebSockets.Connection
31+
import Servant
32+
import Wire.API.Routes.Public.Cannon
3833

39-
sitemap :: Routes ApiBuilder Cannon ()
40-
sitemap = do
41-
get "/await" (continue awaitH) $
42-
header "Z-User"
43-
.&. header "Z-Connection"
44-
.&. opt (query "client")
45-
.&. request
46-
document "GET" "await" $ do
47-
summary "Establish websocket connection"
48-
parameter Header "Upgrade" (string $ enum ["websocket"]) end
49-
parameter Header "Connection" (string $ enum ["upgrade"]) end
50-
parameter Header "Sec-WebSocket-Key" bytes' $
51-
description "16-bytes base64 encoded nonce"
52-
parameter Header "Sec-WebSocket-Version" (int32 $ enum [13]) end
53-
parameter Query "client" string' $ do
54-
optional
55-
description "Client ID"
56-
response 426 "Upgrade required" end
34+
type API = ServantAPI :<|> Raw
5735

58-
apiDocs :: Routes ApiBuilder Cannon ()
59-
apiDocs = do
60-
get "/await/api-docs" (continue docsH) $
61-
accept "application" "json"
62-
.&. query "base_url"
36+
publicAPIServer :: ServerT ServantAPI Cannon
37+
publicAPIServer = streamData
6338

64-
docsH :: Media "application" "json" ::: Text -> Cannon Response
65-
docsH (_ ::: url) = do
66-
let doc = mkSwaggerApi url [] sitemap
67-
return $ json doc
68-
69-
awaitH :: UserId ::: ConnId ::: Maybe ClientId ::: Request -> Cannon Response
70-
awaitH (u ::: a ::: c ::: r) = do
39+
streamData :: UserId -> ConnId -> Maybe ClientId -> PendingConnection -> Cannon ()
40+
streamData userId connId clientId con = do
7141
e <- wsenv
72-
case websocketsApp wsoptions (wsapp (mkKey u a) c e) r of
73-
Nothing -> return $ errorRs status426 "request-error" "websocket upgrade required"
74-
Just rs -> return rs -- ensure all middlewares ignore RawResponse - see Note [Raw Response]
75-
where
76-
status426 = mkStatus 426 "Upgrade Required"
77-
wsoptions = Ws.defaultConnectionOptions
42+
liftIO $ wsapp (mkKey userId connId) clientId e con

0 commit comments

Comments
 (0)