From 8d2a0f85c9a019c0d757d760be0b02c57d8dbea5 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 4 Feb 2022 15:36:28 +0100 Subject: [PATCH] Servantify Cannon's internal API (#2081) * Single notification pushes are strict in their HTTP body The websockets library does not support streaming (https://github.com/jaspervdj/websockets/issues/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. --- cabal.project | 18 +-- .../5-internal/servantify-cannon-internal-api | 1 + .../wire-api/src/Wire/API/ErrorDescription.hs | 4 + libs/wire-api/src/Wire/API/RawJson.hs | 29 ++++ .../src/Wire/API/Routes/Public/Cannon.hs | 34 ++-- libs/wire-api/wire-api.cabal | 1 + services/cannon/cannon.cabal | 2 + services/cannon/package.yaml | 2 + services/cannon/src/Cannon/API/Internal.hs | 151 +++++++++++------- services/cannon/src/Cannon/API/Public.hs | 10 +- services/cannon/src/Cannon/App.hs | 2 +- services/cannon/src/Cannon/Run.hs | 19 ++- services/cannon/src/Cannon/WS.hs | 26 +-- services/cannon/test/Main.hs | 7 +- .../test/unit/Test/Federator/Client.hs | 2 +- services/gundeck/test/integration/API.hs | 21 ++- stack.yaml | 6 +- stack.yaml.lock | 54 +++---- 18 files changed, 246 insertions(+), 143 deletions(-) create mode 100644 changelog.d/5-internal/servantify-cannon-internal-api create mode 100644 libs/wire-api/src/Wire/API/RawJson.hs diff --git a/cabal.project b/cabal.project index be2bc1ee317..09c5a8a6a80 100644 --- a/cabal.project +++ b/cabal.project @@ -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 @@ -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 diff --git a/changelog.d/5-internal/servantify-cannon-internal-api b/changelog.d/5-internal/servantify-cannon-internal-api new file mode 100644 index 00000000000..ee053807a07 --- /dev/null +++ b/changelog.d/5-internal/servantify-cannon-internal-api @@ -0,0 +1 @@ +Migrate the internal API of Cannon to Servant. diff --git a/libs/wire-api/src/Wire/API/ErrorDescription.hs b/libs/wire-api/src/Wire/API/ErrorDescription.hs index 99e5fbe2a98..df14482b916 100644 --- a/libs/wire-api/src/Wire/API/ErrorDescription.hs +++ b/libs/wire-api/src/Wire/API/ErrorDescription.hs @@ -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" diff --git a/libs/wire-api/src/Wire/API/RawJson.hs b/libs/wire-api/src/Wire/API/RawJson.hs new file mode 100644 index 00000000000..295202c1ed0 --- /dev/null +++ b/libs/wire-api/src/Wire/API/RawJson.hs @@ -0,0 +1,29 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- 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 . + +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 diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Cannon.hs b/libs/wire-api/src/Wire/API/Routes/Public/Cannon.hs index 8f9745b5035..ceacf45518a 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Cannon.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Cannon.hs @@ -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) diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index b358f7bda5f..4a03c4b246a 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -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 diff --git a/services/cannon/cannon.cabal b/services/cannon/cannon.cabal index c8571bd1fa2..afe223905a5 100644 --- a/services/cannon/cannon.cabal +++ b/services/cannon/cannon.cabal @@ -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 @@ -100,6 +101,7 @@ library , retry >=0.7 , safe-exceptions , servant + , servant-conduit , servant-server , strict >=0.3.2 , swagger >=0.2 diff --git a/services/cannon/package.yaml b/services/cannon/package.yaml index c784a2bc4bd..274eca7524b 100644 --- a/services/cannon/package.yaml +++ b/services/cannon/package.yaml @@ -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 @@ -35,6 +36,7 @@ library: - retry >=0.7 - safe-exceptions - servant + - servant-conduit - servant-server - strict >=0.3.2 - swagger >=0.2 diff --git a/services/cannon/src/Cannon/API/Internal.hs b/services/cannon/src/Cannon/API/Internal.hs index de3f20d495b..03c895687a7 100644 --- a/services/cannon/src/Cannon/API/Internal.hs +++ b/services/cannon/src/Cannon/API/Internal.hs @@ -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 @@ -16,7 +20,8 @@ -- with this program. If not, see . module Cannon.API.Internal - ( sitemap, + ( InternalAPI, + internalServer, ) where @@ -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") @@ -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 diff --git a/services/cannon/src/Cannon/API/Public.hs b/services/cannon/src/Cannon/API/Public.hs index 8e6fff49065..0eb81bf5fb1 100644 --- a/services/cannon/src/Cannon/API/Public.hs +++ b/services/cannon/src/Cannon/API/Public.hs @@ -16,8 +16,7 @@ -- with this program. If not, see . module Cannon.API.Public - ( API, - publicAPIServer, + ( publicAPIServer, ) where @@ -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 diff --git a/services/cannon/src/Cannon/App.hs b/services/cannon/src/Cannon/App.hs index 4435d779e4c..a49e3681911 100644 --- a/services/cannon/src/Cannon/App.hs +++ b/services/cannon/src/Cannon/App.hs @@ -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 diff --git a/services/cannon/src/Cannon/Run.hs b/services/cannon/src/Cannon/Run.hs index d4902460d39..1f01bd7a90b 100644 --- a/services/cannon/src/Cannon/Run.hs +++ b/services/cannon/src/Cannon/Run.hs @@ -17,6 +17,7 @@ module Cannon.Run ( run, + CombinedAPI, ) where @@ -26,7 +27,7 @@ import Cannon.API.Public import Cannon.App (maxPingInterval) import qualified Cannon.Dict as D import Cannon.Options -import Cannon.Types (Cannon, applog, clients, mkEnv, monitor, runCannon, runCannon', runCannonToServant) +import Cannon.Types (Cannon, applog, clients, mkEnv, monitor, runCannon', runCannonToServant) import Cannon.WS hiding (env) import qualified Control.Concurrent.Async as Async import Control.Exception.Safe (catchAny) @@ -50,6 +51,8 @@ import qualified System.Logger.Extended as L import System.Random.MWC (createSystemRandom) import Wire.API.Routes.Public.Cannon +type CombinedAPI = PublicAPI :<|> InternalAPI + run :: Opts -> IO () run o = do ext <- loadExternal @@ -66,17 +69,17 @@ run o = do <*> mkClock refreshMetricsThread <- Async.async $ runCannon' e refreshMetrics s <- newSettings $ Server (o ^. cannon . host) (o ^. cannon . port) (applog e) m (Just idleTimeout) - let rtree = compile sitemap - internalApp r k = runCannon e (Network.Wai.Utilities.Server.route rtree r k) r - middleware :: Wai.Middleware + let middleware :: Wai.Middleware middleware = - servantPlusWAIPrometheusMiddleware sitemap (Proxy @ServantAPI) + servantPrometheusMiddleware (Proxy @CombinedAPI) . Gzip.gzip Gzip.def . catchErrors g [Right m] app :: Application - app = middleware (serve (Proxy @API) server) - server :: Servant.Server API - server = hoistServer (Proxy @ServantAPI) (runCannonToServant e) publicAPIServer :<|> Tagged internalApp + app = middleware (serve (Proxy @CombinedAPI) server) + server :: Servant.Server CombinedAPI + server = + hoistServer (Proxy @PublicAPI) (runCannonToServant e) publicAPIServer + :<|> hoistServer (Proxy @InternalAPI) (runCannonToServant e) internalServer runSettings s app `finally` do Async.cancel refreshMetricsThread L.close (applog e) diff --git a/services/cannon/src/Cannon/WS.hs b/services/cannon/src/Cannon/WS.hs index 76035acdc4b..cbcaaf0f72d 100644 --- a/services/cannon/src/Cannon/WS.hs +++ b/services/cannon/src/Cannon/WS.hs @@ -29,7 +29,6 @@ module Cannon.WS unregisterLocal, isRemoteRegistered, registerRemote, - sendMsg, sendMsgIO, Clock, mkClock, @@ -42,6 +41,7 @@ module Cannon.WS mkKey, key2bytes, client, + sendMsg, ) where @@ -50,6 +50,7 @@ import Bilge.RPC import Bilge.Retry import Cannon.Dict (Dict) import qualified Cannon.Dict as D +import Conduit import Control.Concurrent.Timeout import Control.Monad.Catch import Control.Retry @@ -224,16 +225,23 @@ isRemoteRegistered u c = do cs <- map connId <$> parseResponse (mkError status502 "server-error") rs return $ c `elem` cs -sendMsg :: L.ByteString -> Key -> Websocket -> WS () -sendMsg m k c = do - let kb = key2bytes k - trace $ client kb . msg (val "sendMsg: \"" +++ L.take 128 m +++ val "...\"") - liftIO $ sendMsgIO m c - -sendMsgIO :: L.ByteString -> Websocket -> IO () -sendMsgIO m c = do +sendMsgIO :: (WebSocketsData a) => a -> Websocket -> IO () +sendMsgIO m c = recoverAll retry3x $ const $ sendBinaryData (connection c) m +sendMsg :: (WebSocketsData a) => a -> Key -> Websocket -> WS () +sendMsg message k c = do + traceLog message + liftIO $ sendMsgIO message c + where + traceLog :: (WebSocketsData a) => a -> WS () + traceLog m = trace $ client kb . msg (logMsg m) + + logMsg :: (WebSocketsData a) => a -> Builder + logMsg m = val "sendMsgConduit: \"" +++ L.take 128 (toLazyByteString m) +++ val "...\"" + + kb = key2bytes k + close :: Key -> Websocket -> WS () close k c = do let kb = key2bytes k diff --git a/services/cannon/test/Main.hs b/services/cannon/test/Main.hs index cd5591198ab..534aa711a82 100644 --- a/services/cannon/test/Main.hs +++ b/services/cannon/test/Main.hs @@ -17,11 +17,10 @@ module Main where -import qualified Cannon.API.Internal +import Cannon.API.Internal +import Data.Metrics.Servant (routesToPaths) import Data.Metrics.Test (pathsConsistencyCheck) -import Data.Metrics.WaiRoute (treeToPaths) import Imports -import Network.Wai.Utilities.Server (compile) import qualified Test.Cannon.Dict as D import Test.Tasty import Test.Tasty.HUnit @@ -35,6 +34,6 @@ main = assertEqual "inconcistent sitemap" mempty - (pathsConsistencyCheck . treeToPaths . compile $ Cannon.API.Internal.sitemap), + (pathsConsistencyCheck $ routesToPaths @InternalAPI), D.tests ] diff --git a/services/federator/test/unit/Test/Federator/Client.hs b/services/federator/test/unit/Test/Federator/Client.hs index 225a2dbd071..ddd318e02d2 100644 --- a/services/federator/test/unit/Test/Federator/Client.hs +++ b/services/federator/test/unit/Test/Federator/Client.hs @@ -36,7 +36,7 @@ import qualified Network.HTTP2.Client as HTTP2 import qualified Network.Wai as Wai import qualified Network.Wai.Utilities.Error as Wai import Servant.API -import Servant.Client +import Servant.Client hiding ((//)) import Servant.Client.Core import Servant.Types.SourceT import Test.QuickCheck (arbitrary, generate) diff --git a/services/gundeck/test/integration/API.hs b/services/gundeck/test/integration/API.hs index 32e509661b7..4dad766a03b 100644 --- a/services/gundeck/test/integration/API.hs +++ b/services/gundeck/test/integration/API.hs @@ -76,6 +76,7 @@ tests s = test s "Replace presence" replacePresence, test s "Remove stale presence" removeStalePresence, test s "Single user push" singleUserPush, + test s "Single user push with large message" singleUserPushLargeMessage, test s "Push many to Cannon via bulkpush (via gundeck; group notif)" $ bulkPush False 50 8, test s "Push many to Cannon via bulkpush (via gundeck; e2e notif)" $ bulkPush True 50 8, test s "Send a push, ensure origin does not receive it" sendSingleUserNoPiggyback, @@ -195,7 +196,13 @@ removeStalePresence = do push u us = newPush u (toRecipients us) pload & pushOriginConnection .~ Just (ConnId "dev") singleUserPush :: TestM () -singleUserPush = do +singleUserPush = testSingleUserPush smallMsgPayload + where + -- JSON: {"foo":42} + smallMsgPayload = List1.singleton $ HashMap.fromList ["foo" .= (42 :: Int)] + +testSingleUserPush :: List1 Object -> TestM () +testSingleUserPush msgPayload = do ca <- view tsCannon uid <- randomId ch <- connectUser ca uid =<< randomConnId @@ -205,12 +212,18 @@ singleUserPush = do assertBool "No push message received" (isJust msg) assertEqual "Payload altered during transmission" - (Just pload) + (Just msgPayload) (ntfPayload <$> (decode . fromStrict . fromJust) msg) where - pload = List1.singleton $ HashMap.fromList ["foo" .= (42 :: Int)] - push u us = newPush (Just u) (toRecipients us) pload & pushOriginConnection .~ Just (ConnId "dev") + push u us = newPush (Just u) (toRecipients us) msgPayload & pushOriginConnection .~ Just (ConnId "dev") + +singleUserPushLargeMessage :: TestM () +singleUserPushLargeMessage = testSingleUserPush largeMsgPayload + where + -- JSON: {"list":["1","2", ... ,"10000"]} + largeMsgPayload = List1.singleton $ HashMap.fromList ["list" .= [show i | i <- [1 .. 10000] :: [Int]]] +-- | Create a number of users with a number of connections each, and connect each user's connections -- | Create a number of users with a number of connections each, and connect each user's connections -- to one of two cannons at random. Push either encrypted notifications (@isE2E == True@) or -- notifications from server (@isE2E == False@) to all connections, and make sure they all arrive at diff --git a/stack.yaml b/stack.yaml index 392e1c4906b..ec593380e81 100644 --- a/stack.yaml +++ b/stack.yaml @@ -193,10 +193,10 @@ extra-deps: - git: https://github.com/haskell-servant/servant-swagger commit: bb0a84faa073fa9530f60337610d7da3d5b9393c -# For changes from https://github.com/haskell-servant/servant/pull/1420 +# For changes from https://github.com/haskell-servant/servant/pull/1502 # Not released to hackage yet -- git: https://github.com/wireapp/servant.git - commit: a4e15fe75f294816d9ead19ed8a48cae8e0b76e7 +- git: https://github.com/haskell-servant/servant.git + commit: 75db4a5327d6d04ae2460bd5ffd008fe16197ba8 subdirs: - servant - servant-server diff --git a/stack.yaml.lock b/stack.yaml.lock index 29788eece7e..93c1f9bb6e5 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -517,55 +517,55 @@ packages: - completed: subdir: servant name: servant - version: 0.18.2 - git: https://github.com/wireapp/servant.git + version: 0.18.3 + git: https://github.com/haskell-servant/servant.git pantry-tree: - size: 2809 - sha256: 22348fceac7bca97f5c349d9db0b157e401ed273d151d8cbcbd767f4d06791e8 - commit: a4e15fe75f294816d9ead19ed8a48cae8e0b76e7 + size: 2949 + sha256: 091d8a742ea95490b787f497bfa26eaed46733945721396158f571aea7ed6dca + commit: 75db4a5327d6d04ae2460bd5ffd008fe16197ba8 original: subdir: servant - git: https://github.com/wireapp/servant.git - commit: a4e15fe75f294816d9ead19ed8a48cae8e0b76e7 + git: https://github.com/haskell-servant/servant.git + commit: 75db4a5327d6d04ae2460bd5ffd008fe16197ba8 - completed: subdir: servant-server name: servant-server - version: 0.18.2 - git: https://github.com/wireapp/servant.git + version: 0.18.3 + git: https://github.com/haskell-servant/servant.git pantry-tree: size: 2727 - sha256: 55d3c9747550555f3861b5fabfe7cc0385c64ccaf3e5b051aa3064bddb8661ad - commit: a4e15fe75f294816d9ead19ed8a48cae8e0b76e7 + sha256: 43d23c42011f5c3ff3f298b1910d7f2b43a66144e92e2e762b0efffe63634af4 + commit: 75db4a5327d6d04ae2460bd5ffd008fe16197ba8 original: subdir: servant-server - git: https://github.com/wireapp/servant.git - commit: a4e15fe75f294816d9ead19ed8a48cae8e0b76e7 + git: https://github.com/haskell-servant/servant.git + commit: 75db4a5327d6d04ae2460bd5ffd008fe16197ba8 - completed: subdir: servant-client name: servant-client - version: 0.18.2 - git: https://github.com/wireapp/servant.git + version: 0.18.3 + git: https://github.com/haskell-servant/servant.git pantry-tree: - size: 1346 - sha256: 9245621a9097c0b4d5ecbd61616d00c69112e1539db8803a0fda010de484e7ba - commit: a4e15fe75f294816d9ead19ed8a48cae8e0b76e7 + size: 1481 + sha256: 86025a0c5ae0b0da07db48eed1456011ba7c0093f2dbc04b1ef3fe99e1cc0567 + commit: 75db4a5327d6d04ae2460bd5ffd008fe16197ba8 original: subdir: servant-client - git: https://github.com/wireapp/servant.git - commit: a4e15fe75f294816d9ead19ed8a48cae8e0b76e7 + git: https://github.com/haskell-servant/servant.git + commit: 75db4a5327d6d04ae2460bd5ffd008fe16197ba8 - completed: subdir: servant-client-core name: servant-client-core - version: 0.18.2 - git: https://github.com/wireapp/servant.git + version: 0.18.3 + git: https://github.com/haskell-servant/servant.git pantry-tree: - size: 1444 - sha256: b5a7abf78d2ee0887bf05d7d4ba71e3c689b65a9b2e7386c394f4bdb6ff8e55d - commit: a4e15fe75f294816d9ead19ed8a48cae8e0b76e7 + size: 1445 + sha256: 528c07a5fe7d7482636b9e11bbb54d92930a7db3d9635f920f250fed51a8a2fd + commit: 75db4a5327d6d04ae2460bd5ffd008fe16197ba8 original: subdir: servant-client-core - git: https://github.com/wireapp/servant.git - commit: a4e15fe75f294816d9ead19ed8a48cae8e0b76e7 + git: https://github.com/haskell-servant/servant.git + commit: 75db4a5327d6d04ae2460bd5ffd008fe16197ba8 - completed: hackage: HsOpenSSL-x509-system-0.1.0.4@sha256:86be72558de4cee8f4e32f9cb8b63610d7624219910cfc205a23326078658676,1777 pantry-tree: