Skip to content

Commit

Permalink
Servantify Cannon's internal API (#2081)
Browse files Browse the repository at this point in the history
* Single notification pushes are strict in their HTTP body

The websockets library does not support streaming
(jaspervdj/websockets#119). So, there is no
value in superficially transforming data to a stream that later won't be
streamed. However, WebSocketsData enables us to be polymorphic in
the message type, i.e. let the endpoints type decide what to use. This
would make streaming easier to enable (if it's ever implemented by the
library) and safes us from some nasty conversion code.

* Forward the pushed notification as is

This reflects the prior behavior of Cannon (that should not change).
The type RawJson represents json content as plain text.
  • Loading branch information
supersven authored Feb 4, 2022
1 parent e8595a0 commit 8d2a0f8
Show file tree
Hide file tree
Showing 18 changed files with 246 additions and 143 deletions.
18 changes: 9 additions & 9 deletions cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -69,6 +69,15 @@ source-repository-package
location: https://github.com/haskell-servant/servant-swagger
tag: bb0a84faa073fa9530f60337610d7da3d5b9393c

source-repository-package
type: git
location: https://github.com/haskell-servant/servant.git
tag: 75db4a5327d6d04ae2460bd5ffd008fe16197ba8
subdir: servant
servant-client
servant-client-core
servant-server

source-repository-package
type: git
location: https://github.com/kim/hs-collectd
Expand Down Expand Up @@ -142,15 +151,6 @@ source-repository-package
location: https://github.com/wireapp/saml2-web-sso
tag: 4227e38be5c0810012dc472fc6931f6087fbce68

source-repository-package
type: git
location: https://github.com/wireapp/servant.git
tag: a4e15fe75f294816d9ead19ed8a48cae8e0b76e7
subdir: servant
servant-client
servant-client-core
servant-server

source-repository-package
type: git
location: https://github.com/wireapp/snappy
Expand Down
1 change: 1 addition & 0 deletions changelog.d/5-internal/servantify-cannon-internal-api
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Migrate the internal API of Cannon to Servant.
4 changes: 4 additions & 0 deletions libs/wire-api/src/Wire/API/ErrorDescription.hs
Original file line number Diff line number Diff line change
Expand Up @@ -354,3 +354,7 @@ type ChangePasswordMustDiffer = ErrorDescription 409 "password-must-differ" "For
type HandleExists = ErrorDescription 409 "handle-exists" "The given handle is already taken."

type InvalidHandle = ErrorDescription 400 "invalid-handle" "The given handle is invalid."

type PresenceNotRegistered = ErrorDescription 404 "not-found" "presence not registered"

type ClientGone = ErrorDescription 410 "general" "client gone"
29 changes: 29 additions & 0 deletions libs/wire-api/src/Wire/API/RawJson.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,29 @@
-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <[email protected]>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Wire.API.RawJson where

import Imports
import Servant

-- | Wrap json content as plain 'LByteString'
-- This type is intented to be used to receive json content as 'LByteString'.
-- Warning: There is no validation of the json content. It may be any string.
newtype RawJson = RawJson {rawJsonBytes :: LByteString}

instance {-# OVERLAPPING #-} MimeUnrender JSON RawJson where
mimeUnrender _ = pure . RawJson
34 changes: 19 additions & 15 deletions libs/wire-api/src/Wire/API/Routes/Public/Cannon.hs
Original file line number Diff line number Diff line change
Expand Up @@ -21,23 +21,27 @@ import Data.Id
import Data.Swagger
import Servant
import Servant.Swagger
import Wire.API.Routes.Named
import Wire.API.Routes.Public (ZConn, ZUser)
import Wire.API.Routes.WebSocket

type ServantAPI =
Summary "Establish websocket connection"
:> "await"
:> ZUser
:> ZConn
:> QueryParam'
[ Optional,
Strict,
Description "Client ID"
]
"client"
ClientId
-- FUTUREWORK: Consider higher-level web socket combinator
:> WebSocketPending
type PublicAPI =
Named
"await-notifications"
( Summary "Establish websocket connection"
:> "await"
:> ZUser
:> ZConn
:> QueryParam'
[ Optional,
Strict,
Description "Client ID"
]
"client"
ClientId
-- FUTUREWORK: Consider higher-level web socket combinator
:> WebSocketPending
)

swaggerDoc :: Swagger
swaggerDoc = toSwagger (Proxy @ServantAPI)
swaggerDoc = toSwagger (Proxy @PublicAPI)
1 change: 1 addition & 0 deletions libs/wire-api/wire-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,7 @@ library
Wire.API.Provider.Service.Tag
Wire.API.Push.Token
Wire.API.Push.V2.Token
Wire.API.RawJson
Wire.API.Routes.AssetBody
Wire.API.Routes.Internal.Brig
Wire.API.Routes.Internal.Brig.Connection
Expand Down
2 changes: 2 additions & 0 deletions services/cannon/cannon.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -85,6 +85,7 @@ library
, bilge >=0.12
, bytestring >=0.10
, bytestring-conversion >=0.2
, conduit >=1.3.4.2
, data-default >=0.5
, data-timeout >=0.3
, exceptions >=0.6
Expand All @@ -100,6 +101,7 @@ library
, retry >=0.7
, safe-exceptions
, servant
, servant-conduit
, servant-server
, strict >=0.3.2
, swagger >=0.2
Expand Down
2 changes: 2 additions & 0 deletions services/cannon/package.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ library:
- bilge >=0.12
- bytestring >=0.10
- bytestring-conversion >=0.2
- conduit >=1.3.4.2
- data-default >=0.5
- data-timeout >=0.3
- exceptions >=0.6
Expand All @@ -35,6 +36,7 @@ library:
- retry >=0.7
- safe-exceptions
- servant
- servant-conduit
- servant-server
- strict >=0.3.2
- swagger >=0.2
Expand Down
151 changes: 95 additions & 56 deletions services/cannon/src/Cannon/API/Internal.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE StandaloneDeriving #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <[email protected]>
Expand All @@ -16,7 +20,8 @@
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Cannon.API.Internal
( sitemap,
( InternalAPI,
internalServer,
)
where

Expand All @@ -26,61 +31,82 @@ import Cannon.Types
import Cannon.WS
import Control.Monad.Catch
import Data.Aeson (encode)
import qualified Data.ByteString.Lazy as L
import Data.Id (ConnId, UserId)
import Data.Swagger.Build.Api hiding (Response)
import Data.Id hiding (client)
import Gundeck.Types
import Gundeck.Types.BulkPush
import Imports hiding (head)
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Predicate
import Network.Wai.Routing
import Network.Wai.Utilities
import Imports
import Network.WebSockets
import Servant
import Servant.Conduit ()
import System.Logger.Class (msg, val)
import qualified System.Logger.Class as LC
import Wire.API.ErrorDescription
import Wire.API.RawJson
import Wire.API.Routes.MultiVerb
import Wire.API.Routes.Named

sitemap :: Routes ApiBuilder Cannon ()
sitemap = do
get "/i/status" (continue (const $ return empty)) true
head "/i/status" (continue (const $ return empty)) true

post "/i/push/:user/:conn" (continue pushH) $
capture "user" .&. capture "conn" .&. request

post "/i/bulkpush" (continue bulkpushH) $
request

head "/i/presences/:uid/:conn" (continue checkPresenceH) $
param "uid" .&. param "conn"

pushH :: UserId ::: ConnId ::: Request -> Cannon Response
pushH (user ::: conn ::: req) =
singlePush (readBody req) (PushTarget user conn) >>= \case
PushStatusOk -> return empty
PushStatusGone -> return $ errorRs status410 "general" "client gone"
type InternalAPI =
"i"
:> ( Named
"get-status"
( "status"
:> MultiVerb
'GET
'[PlainText]
'[RespondEmpty 200 "Service is alive."]
()
)
:<|> Named
"push-notification"
( "push"
:> Capture "user" UserId
:> Capture "conn" ConnId
:> ReqBody '[JSON] RawJson
:> MultiVerb
'POST
'[JSON]
'[ ClientGone,
RespondEmpty 200 "Successfully pushed."
]
(Maybe ())
)
:<|> Named
"bulk-push-notifications"
( "bulkpush"
:> ReqBody '[JSON] BulkPushRequest
:> Post '[JSON] BulkPushResponse
)
:<|> Named
"check-presence"
( "presences"
:> Capture "uid" UserId
:> Capture "conn" ConnId
:> MultiVerb
'HEAD
'[JSON]
'[ PresenceNotRegistered,
RespondEmpty 200 "Presence checked successfully."
]
(Maybe ())
)
)

-- | Parse the entire list of notifcations and targets, then call 'singlePush' on the each of them
-- in order.
bulkpushH :: Request -> Cannon Response
bulkpushH req = json <$> (parseBody' (JsonRequest req) >>= bulkpush)
internalServer :: ServerT InternalAPI Cannon
internalServer =
Named @"get-status" (pure ())
:<|> Named @"push-notification" pushHandler
:<|> Named @"bulk-push-notifications" bulkPushHandler
:<|> Named @"check-presence" checkPresenceHandler

-- | The typed part of 'bulkpush'.
bulkpush :: BulkPushRequest -> Cannon BulkPushResponse
bulkpush (BulkPushRequest notifs) =
BulkPushResponse . mconcat . zipWith compileResp notifs <$> (uncurry doNotif `mapM` notifs)
where
doNotif :: Notification -> [PushTarget] -> Cannon [PushStatus]
doNotif (pure . encode -> notif) = mapConcurrentlyCannon (singlePush notif)
compileResp ::
(Notification, [PushTarget]) ->
[PushStatus] ->
[(NotificationId, PushTarget, PushStatus)]
compileResp (notif, prcs) pss = zip3 (repeat (ntfId notif)) prcs pss
pushHandler :: UserId -> ConnId -> RawJson -> Cannon (Maybe ())
pushHandler user conn body =
singlePush (rawJsonBytes body) (PushTarget user conn) >>= \case
PushStatusOk -> pure $ Just ()
PushStatusGone -> pure Nothing

-- | Take a serialized 'Notification' string and send it to the 'PushTarget'.
singlePush :: Cannon L.ByteString -> PushTarget -> Cannon PushStatus
singlePush notification (PushTarget usrid conid) = do
-- | Take notification @n@ and send it to the 'PushTarget'.
singlePush :: (WebSocketsData a) => a -> PushTarget -> Cannon PushStatus
singlePush n (PushTarget usrid conid) = do
let k = mkKey usrid conid
d <- clients
LC.debug $ client (key2bytes k) . msg (val "push")
Expand All @@ -91,15 +117,28 @@ singlePush notification (PushTarget usrid conid) = do
return PushStatusGone
Just x -> do
e <- wsenv
b <- notification
runWS e $
(sendMsg b k x >> return PushStatusOk)
`catchAll` const (terminate k x >> return PushStatusGone)
runWS e $ do
catchAll
(runWS e (sendMsg n k x) >> pure PushStatusOk)
(const (terminate k x >> pure PushStatusGone))

bulkPushHandler :: BulkPushRequest -> Cannon BulkPushResponse
bulkPushHandler (BulkPushRequest ns) =
BulkPushResponse . mconcat . zipWith compileResp ns <$> (uncurry doNotify `Imports.mapM` ns)
where
doNotify :: Notification -> [PushTarget] -> Cannon [PushStatus]
doNotify (encode -> notification) =
mapConcurrentlyCannon (singlePush notification)
compileResp ::
(Notification, [PushTarget]) ->
[PushStatus] ->
[(NotificationId, PushTarget, PushStatus)]
compileResp (notif, prcs) pss = zip3 (repeat (ntfId notif)) prcs pss

checkPresenceH :: UserId ::: ConnId -> Cannon Response
checkPresenceH (u ::: c) = do
checkPresenceHandler :: UserId -> ConnId -> Cannon (Maybe ())
checkPresenceHandler u c = do
e <- wsenv
registered <- runWS e $ isRemoteRegistered u c
if registered
then return empty
else return $ errorRs status404 "not-found" "presence not registered"
then pure $ Just ()
else pure Nothing
10 changes: 4 additions & 6 deletions services/cannon/src/Cannon/API/Public.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,8 +16,7 @@
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Cannon.API.Public
( API,
publicAPIServer,
( publicAPIServer,
)
where

Expand All @@ -29,12 +28,11 @@ import Data.Id
import GHC.Base
import Network.WebSockets.Connection
import Servant
import Wire.API.Routes.Named
import Wire.API.Routes.Public.Cannon

type API = ServantAPI :<|> Raw

publicAPIServer :: ServerT ServantAPI Cannon
publicAPIServer = streamData
publicAPIServer :: ServerT PublicAPI Cannon
publicAPIServer = Named @"await-notifications" streamData

streamData :: UserId -> ConnId -> Maybe ClientId -> PendingConnection -> Cannon ()
streamData userId connId clientId con = do
Expand Down
2 changes: 1 addition & 1 deletion services/cannon/src/Cannon/App.hs
Original file line number Diff line number Diff line change
Expand Up @@ -149,7 +149,7 @@ readLoop ws s = loop
(DataMessage _ _ _ (Text "ping" _)) -> True
(DataMessage _ _ _ (Binary "ping")) -> True
_ -> False
sendAppLevelPong = sendMsgIO "pong" ws
sendAppLevelPong = sendMsgIO @ByteString "pong" ws

rejectOnError :: PendingConnection -> HandshakeException -> IO a
rejectOnError p x = do
Expand Down
Loading

0 comments on commit 8d2a0f8

Please sign in to comment.