From 50386ffff5ecf227ba7c8bfa282845c54d242e87 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Fri, 21 May 2021 15:31:58 +0200 Subject: [PATCH 1/5] Refactor: Move Brig.User.Event* to brig-types --- libs/brig-types/brig-types.cabal | 5 +- libs/brig-types/package.yaml | 1 + .../brig-types/src/Brig/Types}/User/Event.hs | 40 +++++++++++- services/brig/brig.cabal | 4 +- services/brig/src/Brig/API/Client.hs | 2 +- services/brig/src/Brig/API/Connection.hs | 17 +++-- services/brig/src/Brig/API/Internal.hs | 2 +- services/brig/src/Brig/API/Properties.hs | 2 +- services/brig/src/Brig/API/User.hs | 2 +- services/brig/src/Brig/IO/Intra.hs | 5 +- services/brig/src/Brig/User/Event/Log.hs | 62 ------------------- 11 files changed, 59 insertions(+), 83 deletions(-) rename {services/brig/src/Brig => libs/brig-types/src/Brig/Types}/User/Event.hs (72%) delete mode 100644 services/brig/src/Brig/User/Event/Log.hs diff --git a/libs/brig-types/brig-types.cabal b/libs/brig-types/brig-types.cabal index 7ac6e6ae0d0..2414e8ab477 100644 --- a/libs/brig-types/brig-types.cabal +++ b/libs/brig-types/brig-types.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 34235c4ff601a26386a48b310d251ed69bd5ef7e6fa59da512fe9acca083ef96 +-- hash: b653eba4d855ab6675efd3519d4259c9bb49379e92b15fb7f4f9080eac634bb1 name: brig-types version: 1.35.0 @@ -41,6 +41,7 @@ library Brig.Types.User Brig.Types.User.Auth Brig.Types.User.EJPD + Brig.Types.User.Event other-modules: Paths_brig_types hs-source-dirs: @@ -63,6 +64,7 @@ library , swagger2 >=2.5 , text >=0.11 , time >=1.1 + , tinylog , types-common >=0.16 , unordered-containers >=0.2 , wire-api @@ -94,6 +96,7 @@ test-suite brig-types-tests , tasty-quickcheck , text >=0.11 , time >=1.1 + , tinylog , types-common >=0.16 , unordered-containers >=0.2 , wire-api diff --git a/libs/brig-types/package.yaml b/libs/brig-types/package.yaml index c42ba954732..f25520f8603 100644 --- a/libs/brig-types/package.yaml +++ b/libs/brig-types/package.yaml @@ -18,6 +18,7 @@ dependencies: - swagger2 >=2.5 - text >=0.11 - time >=1.1 +- tinylog - types-common >=0.16 - unordered-containers >=0.2 - wire-api diff --git a/services/brig/src/Brig/User/Event.hs b/libs/brig-types/src/Brig/Types/User/Event.hs similarity index 72% rename from services/brig/src/Brig/User/Event.hs rename to libs/brig-types/src/Brig/Types/User/Event.hs index f608bbf3178..180b6f765a3 100644 --- a/services/brig/src/Brig/User/Event.hs +++ b/libs/brig-types/src/Brig/Types/User/Event.hs @@ -17,12 +17,14 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Brig.User.Event where +module Brig.Types.User.Event where import Brig.Types +import Data.ByteString.Conversion import Data.Handle (Handle) import Data.Id import Imports +import System.Logger.Class data Event = UserEvent !UserEvent @@ -176,3 +178,39 @@ propEventUserId :: PropertyEvent -> UserId propEventUserId (PropertySet u _ _) = u propEventUserId (PropertyDeleted u _) = u propEventUserId (PropertiesCleared u) = u + +logConnection :: UserId -> UserId -> Msg -> Msg +logConnection from to = + "connection.from" .= toByteString from + ~~ "connection.to" .= toByteString to + +instance ToBytes Event where + bytes (UserEvent e) = bytes e + bytes (ConnectionEvent e) = bytes e + bytes (PropertyEvent e) = bytes e + bytes (ClientEvent e) = bytes e + +instance ToBytes UserEvent where + bytes e@UserCreated {} = val "user.new: " +++ toByteString (userEventUserId e) + bytes e@UserActivated {} = val "user.activate: " +++ toByteString (userEventUserId e) + bytes e@UserUpdated {} = val "user.update: " +++ toByteString (userEventUserId e) + bytes e@UserIdentityUpdated {} = val "user.update: " +++ toByteString (userEventUserId e) + bytes e@UserIdentityRemoved {} = val "user.identity-remove: " +++ toByteString (userEventUserId e) + bytes e@UserSuspended {} = val "user.suspend: " +++ toByteString (userEventUserId e) + bytes e@UserResumed {} = val "user.resume: " +++ toByteString (userEventUserId e) + bytes e@UserDeleted {} = val "user.delete: " +++ toByteString (userEventUserId e) + bytes e@UserLegalHoldDisabled {} = val "user.legalhold-disable: " +++ toByteString (userEventUserId e) + bytes e@UserLegalHoldEnabled {} = val "user.legalhold-enable: " +++ toByteString (userEventUserId e) + bytes (LegalHoldClientRequested payload) = val "user.legalhold-request: " +++ show payload + +instance ToBytes ConnectionEvent where + bytes e@ConnectionUpdated {} = val "user.connection: " +++ toByteString (connEventUserId e) + +instance ToBytes PropertyEvent where + bytes e@PropertySet {} = val "user.properties-set: " +++ toByteString (propEventUserId e) + bytes e@PropertyDeleted {} = val "user.properties-delete: " +++ toByteString (propEventUserId e) + bytes e@PropertiesCleared {} = val "user.properties-clear: " +++ toByteString (propEventUserId e) + +instance ToBytes ClientEvent where + bytes (ClientAdded u _) = val "user.client-add: " +++ toByteString u + bytes (ClientRemoved u _) = val "user.client-remove: " +++ toByteString u diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 5e0b82e175b..6201c7a77e9 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 2a9b5beec9b3ca122e8c67aa63e8852c74632a3e9d3dea5b1ad9ea7c7a05ed45 +-- hash: 47605047ee190f11d8d83abeb76dbdeae1a701f79348e470c419598cd05da0d8 name: brig version: 1.35.0 @@ -95,8 +95,6 @@ library Brig.User.Auth.DB.Instances Brig.User.EJPD Brig.User.Email - Brig.User.Event - Brig.User.Event.Log Brig.User.Handle Brig.User.Handle.Blacklist Brig.User.Phone diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index 872bee80c4e..2485a778a93 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -53,7 +53,7 @@ import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) import qualified Brig.User.Auth.Cookie as Auth import Brig.User.Email -import Brig.User.Event +import Brig.Types.User.Event import Control.Error import Control.Lens (view) import Data.ByteString.Conversion diff --git a/services/brig/src/Brig/API/Connection.hs b/services/brig/src/Brig/API/Connection.hs index f79db576e69..442e3a8557e 100644 --- a/services/brig/src/Brig/API/Connection.hs +++ b/services/brig/src/Brig/API/Connection.hs @@ -42,8 +42,7 @@ import qualified Brig.IO.Intra as Intra import Brig.Options (setUserMaxConnections) import Brig.Types import Brig.Types.Intra -import Brig.User.Event -import qualified Brig.User.Event.Log as Log +import Brig.Types.User.Event import Control.Error import Control.Lens (view) import Data.Id as Id @@ -95,7 +94,7 @@ createConnectionToLocalUser self crUser ConnectionRequest {crName, crMessage} co where insert s2o o2s = lift $ do Log.info $ - Log.connection self crUser + logConnection self crUser . msg (val "Creating connection") cnv <- Intra.createConnectConv self crUser (Just crName) (Just crMessage) (Just conn) s2o' <- Data.insertConnection self crUser Sent (Just crMessage) cnv @@ -119,7 +118,7 @@ createConnectionToLocalUser self crUser ConnectionRequest {crName, crMessage} co when (ucStatus s2o `notElem` [Sent, Accepted]) $ checkLimit self Log.info $ - Log.connection self (ucTo s2o) + logConnection self (ucTo s2o) . msg (val "Accepting connection") cnv <- lift $ for (ucConvId s2o) $ Intra.acceptConnectConv self (Just conn) s2o' <- lift $ Data.updateConnection s2o Accepted @@ -136,7 +135,7 @@ createConnectionToLocalUser self crUser ConnectionRequest {crName, crMessage} co when (ucStatus s2o `notElem` [Sent, Accepted]) $ checkLimit self Log.info $ - Log.connection self (ucTo s2o) + logConnection self (ucTo s2o) . msg (val "Resending connection request") s2o' <- insert (Just s2o) (Just o2s) return $ ConnectionExists s2o' @@ -210,7 +209,7 @@ updateConnection self other newStatus conn = do accept s2o o2s = do checkLimit self Log.info $ - Log.connection self (ucTo s2o) + logConnection self (ucTo s2o) . msg (val "Accepting connection") cnv <- lift . for (ucConvId s2o) $ Intra.acceptConnectConv self conn -- Note: The check for @Pending@ accounts for situations in which both @@ -227,7 +226,7 @@ updateConnection self other newStatus conn = do lift $ Just <$> Data.updateConnection s2o Accepted block s2o = lift $ do Log.info $ - Log.connection self (ucTo s2o) + logConnection self (ucTo s2o) . msg (val "Blocking connection") for_ (ucConvId s2o) $ Intra.blockConv (ucFrom s2o) conn Just <$> Data.updateConnection s2o Blocked @@ -235,7 +234,7 @@ updateConnection self other newStatus conn = do when (new `elem` [Sent, Accepted]) $ checkLimit self Log.info $ - Log.connection self (ucTo s2o) + logConnection self (ucTo s2o) . msg (val "Unblocking connection") cnv <- lift . for (ucConvId s2o) $ Intra.unblockConv (ucFrom s2o) conn when (ucStatus o2s == Sent && new == Accepted) . lift $ do @@ -248,7 +247,7 @@ updateConnection self other newStatus conn = do lift $ Just <$> Data.updateConnection s2o new cancel s2o o2s = do Log.info $ - Log.connection self (ucTo s2o) + logConnection self (ucTo s2o) . msg (val "Cancelling connection") lift . for_ (ucConvId s2o) $ Intra.blockConv (ucFrom s2o) conn o2s' <- lift $ Data.updateConnection o2s Cancelled diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 3d0a7b0dbc3..fd10c28e5a5 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -47,7 +47,7 @@ import qualified Brig.Types.User.EJPD as EJPD import qualified Brig.User.API.Auth as Auth import qualified Brig.User.API.Search as Search import qualified Brig.User.EJPD -import Brig.User.Event (UserEvent (UserUpdated), UserUpdatedData (eupSSOId, eupSSOIdRemoved), emptyUserUpdatedData) +import Brig.Types.User.Event (UserEvent (UserUpdated), UserUpdatedData (eupSSOId, eupSSOIdRemoved), emptyUserUpdatedData) import Control.Error hiding (bool) import Control.Lens (view, (.~)) import Data.Aeson hiding (json) diff --git a/services/brig/src/Brig/API/Properties.hs b/services/brig/src/Brig/API/Properties.hs index 020d25155d1..ec8b928b2d1 100644 --- a/services/brig/src/Brig/API/Properties.hs +++ b/services/brig/src/Brig/API/Properties.hs @@ -31,7 +31,7 @@ import Brig.Data.Properties (PropertiesDataError) import qualified Brig.Data.Properties as Data import qualified Brig.IO.Intra as Intra import Brig.Types -import Brig.User.Event +import Brig.Types.User.Event import Control.Error import Data.Id import Imports diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 2a940125b70..312a555f9a0 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -120,9 +120,9 @@ import Brig.Types.Code (Timeout (..)) import Brig.Types.Intra import Brig.Types.Team.Invitation (inCreatedAt, inCreatedBy) import qualified Brig.Types.Team.Invitation as Team +import Brig.Types.User.Event import Brig.User.Auth.Cookie (revokeAllCookies) import Brig.User.Email -import Brig.User.Event import Brig.User.Handle import Brig.User.Handle.Blacklist import Brig.User.Phone diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index 51338916abb..f8ba0cfb5df 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -68,8 +68,7 @@ import Brig.Data.Connection (lookupContactList) import qualified Brig.IO.Journal as Journal import Brig.RPC import Brig.Types -import Brig.User.Event -import qualified Brig.User.Event.Log as Log +import Brig.Types.User.Event import qualified Brig.User.Search.Index as Search import Control.Lens (view, (.~), (?~), (^.)) import Control.Retry @@ -522,7 +521,7 @@ createSelfConv u = do createConnectConv :: UserId -> UserId -> Maybe Text -> Maybe Message -> Maybe ConnId -> AppIO ConvId createConnectConv from to cname mess conn = do debug $ - Log.connection from to + logConnection from to . remote "galley" . msg (val "Creating connect conversation") r <- galleyRequest POST req diff --git a/services/brig/src/Brig/User/Event/Log.hs b/services/brig/src/Brig/User/Event/Log.hs deleted file mode 100644 index a6b042899b5..00000000000 --- a/services/brig/src/Brig/User/Event/Log.hs +++ /dev/null @@ -1,62 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2020 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 Brig.User.Event.Log where - -import Brig.User.Event -import Data.ByteString.Conversion -import Data.Id -import Imports -import System.Logger.Class - -connection :: UserId -> UserId -> Msg -> Msg -connection from to = - "connection.from" .= toByteString from - ~~ "connection.to" .= toByteString to - -instance ToBytes Event where - bytes (UserEvent e) = bytes e - bytes (ConnectionEvent e) = bytes e - bytes (PropertyEvent e) = bytes e - bytes (ClientEvent e) = bytes e - -instance ToBytes UserEvent where - bytes e@UserCreated {} = val "user.new: " +++ toByteString (userEventUserId e) - bytes e@UserActivated {} = val "user.activate: " +++ toByteString (userEventUserId e) - bytes e@UserUpdated {} = val "user.update: " +++ toByteString (userEventUserId e) - bytes e@UserIdentityUpdated {} = val "user.update: " +++ toByteString (userEventUserId e) - bytes e@UserIdentityRemoved {} = val "user.identity-remove: " +++ toByteString (userEventUserId e) - bytes e@UserSuspended {} = val "user.suspend: " +++ toByteString (userEventUserId e) - bytes e@UserResumed {} = val "user.resume: " +++ toByteString (userEventUserId e) - bytes e@UserDeleted {} = val "user.delete: " +++ toByteString (userEventUserId e) - bytes e@UserLegalHoldDisabled {} = val "user.legalhold-disable: " +++ toByteString (userEventUserId e) - bytes e@UserLegalHoldEnabled {} = val "user.legalhold-enable: " +++ toByteString (userEventUserId e) - bytes (LegalHoldClientRequested payload) = val "user.legalhold-request: " +++ show payload - -instance ToBytes ConnectionEvent where - bytes e@ConnectionUpdated {} = val "user.connection: " +++ toByteString (connEventUserId e) - -instance ToBytes PropertyEvent where - bytes e@PropertySet {} = val "user.properties-set: " +++ toByteString (propEventUserId e) - bytes e@PropertyDeleted {} = val "user.properties-delete: " +++ toByteString (propEventUserId e) - bytes e@PropertiesCleared {} = val "user.properties-clear: " +++ toByteString (propEventUserId e) - -instance ToBytes ClientEvent where - bytes (ClientAdded u _) = val "user.client-add: " +++ toByteString u - bytes (ClientRemoved u _) = val "user.client-remove: " +++ toByteString u From ebeac1591259d2b4bfcc7116194701ae85990241 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Fri, 21 May 2021 15:38:28 +0200 Subject: [PATCH 2/5] ormoluize --- services/brig/src/Brig/API/Client.hs | 2 +- services/brig/src/Brig/API/Internal.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index 2485a778a93..29e6c053046 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -51,9 +51,9 @@ import qualified Brig.Options as Opt import Brig.Types import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) +import Brig.Types.User.Event import qualified Brig.User.Auth.Cookie as Auth import Brig.User.Email -import Brig.Types.User.Event import Control.Error import Control.Lens (view) import Data.ByteString.Conversion diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index fd10c28e5a5..eeb4872973d 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -44,10 +44,10 @@ import Brig.Types import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) import qualified Brig.Types.User.EJPD as EJPD +import Brig.Types.User.Event (UserEvent (UserUpdated), UserUpdatedData (eupSSOId, eupSSOIdRemoved), emptyUserUpdatedData) import qualified Brig.User.API.Auth as Auth import qualified Brig.User.API.Search as Search import qualified Brig.User.EJPD -import Brig.Types.User.Event (UserEvent (UserUpdated), UserUpdatedData (eupSSOId, eupSSOIdRemoved), emptyUserUpdatedData) import Control.Error hiding (bool) import Control.Lens (view, (.~)) import Data.Aeson hiding (json) From d09594d09a1ede41adb2f1fe7c7fbf55168bc255 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 21 May 2021 21:42:12 +0200 Subject: [PATCH 3/5] Make notification checkers give complete call stack with error. --- .../galley/test/integration/API/Teams/LegalHold.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index be5c065f06b..f3ffaee66b6 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -1178,17 +1178,17 @@ assertNotification ws predicate = let j = Aeson.Object $ List1.head (ntfPayload notif) case Aeson.fromJSON j of Aeson.Success x -> predicate x - Aeson.Error s -> assertBool (s ++ " in " ++ show j) False + Aeson.Error s -> error $ s ++ " in " ++ cs (Aeson.encode j) assertNoNotification :: (HasCallStack, MonadIO m) => WS.WebSocket -> m () assertNoNotification ws = void . liftIO $ WS.assertNoEvent (5 WS.# WS.Second) [ws] -assertMatchJSON :: (FromJSON a, HasCallStack, MonadThrow m, MonadCatch m, MonadIO m) => Chan (Wai.Request, LBS) -> (a -> m ()) -> m () +assertMatchJSON :: (HasCallStack, FromJSON a, MonadThrow m, MonadCatch m, MonadIO m) => Chan (Wai.Request, LBS) -> (a -> m ()) -> m () assertMatchJSON c match = do assertMatchChan c $ \(_, reqBody) -> do case Aeson.eitherDecode reqBody of Right x -> match x - Left s -> liftIO $ assertBool (s ++ " in " ++ show reqBody) False + Left s -> error $ s ++ " in " ++ cs reqBody assertMatchChan :: (HasCallStack, MonadThrow m, MonadCatch m, MonadIO m) => Chan a -> (a -> m ()) -> m () assertMatchChan c match = go [] @@ -1202,8 +1202,8 @@ assertMatchChan c match = go [] match n refill buf `catchAll` \e -> case asyncExceptionFromException e of - Just x -> throwM (x :: SomeAsyncException) + Just x -> error $ show (x :: SomeAsyncException) Nothing -> go (n : buf) Nothing -> do refill buf - liftIO $ assertBool "Timeout" False + error "Timeout" From 458896503704e272c0ccf3f3102a797faf445eec Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Fri, 21 May 2021 17:32:25 +0200 Subject: [PATCH 4/5] mkApp also returns finalizer for logs --- services/galley/src/Galley/Run.hs | 12 +++++++----- services/galley/test/integration/API/Util.hs | 4 +++- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/services/galley/src/Galley/Run.hs b/services/galley/src/Galley/Run.hs index a41160cd29a..11fd3989357 100644 --- a/services/galley/src/Galley/Run.hs +++ b/services/galley/src/Galley/Run.hs @@ -55,7 +55,7 @@ import qualified Wire.API.Routes.Public.Galley as GalleyAPI run :: Opts -> IO () run o = do - (app, e) <- mkApp o + (app, e, appFinalizer) <- mkApp o let l = e ^. App.applog s <- newSettings $ @@ -70,10 +70,9 @@ run o = do Async.cancel deleteQueueThread Async.cancel refreshMetricsThread shutdown (e ^. cstate) - Log.flush l - Log.close l + appFinalizer -mkApp :: Opts -> IO (Application, Env) +mkApp :: Opts -> IO (Application, Env, IO ()) mkApp o = do m <- M.metrics e <- App.createEnv m o @@ -81,7 +80,10 @@ mkApp o = do validateOpts l o runClient (e ^. cstate) $ versionCheck Data.schemaVersion - return (middlewares l m $ servantApp e, e) + let finalizer = do + Log.flush l + Log.close l + return (middlewares l m $ servantApp e, e, finalizer) where rtree = compile API.sitemap app e r k = runGalley e r (route rtree r k) diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 63c34866c6f..fa0b881ec50 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -26,6 +26,7 @@ import Brig.Types import Brig.Types.Intra (UserAccount (..)) import Brig.Types.Team.Invitation import Brig.Types.User.Auth (CookieLabel (..)) +import Control.Exception (finally) import Control.Lens hiding (from, to, (#), (.=)) import Control.Monad.Catch (MonadCatch) import Control.Retry (constantDelay, limitRetries, retrying) @@ -1475,8 +1476,9 @@ defCookieLabel = CookieLabel "auth" -- services will fail. withSettingsOverrides :: MonadIO m => Opts.Opts -> WaiTest.Session a -> m a withSettingsOverrides opts action = liftIO $ do - (galleyApp, _) <- Run.mkApp opts + (galleyApp, _, finalizer) <- Run.mkApp opts WaiTest.runSession action galleyApp + `finally` liftIO finalizer waitForMemberDeletion :: UserId -> TeamId -> UserId -> TestM () waitForMemberDeletion zusr tid uid = do From c2ec9c11f370835a3bc2d01ede7548465e4d43e0 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 21 May 2021 21:46:32 +0200 Subject: [PATCH 5/5] Use real brig event types in galley tests. --- .../test/integration/API/Teams/LegalHold.hs | 122 +++++++++--------- 1 file changed, 63 insertions(+), 59 deletions(-) diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index f3ffaee66b6..2db9830657d 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -32,6 +32,7 @@ import Brig.Types.Client import Brig.Types.Provider import Brig.Types.Team.LegalHold hiding (userId) import Brig.Types.Test.Arbitrary () +import qualified Brig.Types.User.Event as Ev import qualified Cassandra.Exec as Cql import qualified Control.Concurrent.Async as Async import Control.Concurrent.Chan @@ -41,13 +42,14 @@ import Control.Lens import Control.Monad.Catch import Control.Retry (RetryPolicy, RetryStatus, exponentialBackoff, limitRetries, retrying) import qualified Data.Aeson as Aeson -import Data.Aeson.Types (FromJSON, (.:)) -import qualified Data.Aeson.Types as Aeson +import Data.Aeson.Types (FromJSON, withObject, (.:)) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS import Data.ByteString.Conversion import Data.Id +import Data.Json.Util (toUTCTimeMillis) import Data.LegalHold +import qualified Data.List.NonEmpty as NonEmpty import qualified Data.List1 as List1 import Data.Misc (PlainTextPassword) import Data.PEM @@ -55,8 +57,6 @@ import Data.Proxy (Proxy (Proxy)) import Data.Range import Data.String.Conversions (LBS, cs) import Data.Text.Encoding (encodeUtf8) -import GHC.Generics hiding (to) -import GHC.TypeLits import qualified Galley.App as Galley import qualified Galley.Data as Data import qualified Galley.Data.LegalHold as LegalHoldData @@ -229,10 +229,10 @@ testRequestLegalHoldDevice = do storedPrekeys <- Cql.runClient cassState (LegalHoldData.selectPendingPrekeys member) assertBool "user should have pending prekeys stored" (not . null $ storedPrekeys) let pluck = \case - (LegalHoldClientRequested rdata) -> do - lhcTargetUser rdata @?= member - lhcLastPrekey rdata @?= head someLastPrekeys - API.Teams.LegalHold.lhcClientId rdata @?= someClientId + (Ev.LegalHoldClientRequested rdata) -> do + Ev.lhcTargetUser rdata @?= member + Ev.lhcLastPrekey rdata @?= head someLastPrekeys + Ev.lhcClientId rdata @?= someClientId _ -> assertBool "Unexpected event" False assertNotification ws pluck -- all devices get notified. @@ -286,7 +286,7 @@ testApproveLegalHoldDevice = do UserLegalHoldEnabled userStatus let pluck = \case - ClientAdded eClient -> do + Ev.ClientAdded _ eClient -> do clientId eClient @?= someClientId clientType eClient @?= LegalHoldClientType clientClass eClient @?= Just LegalHoldClient @@ -295,7 +295,7 @@ testApproveLegalHoldDevice = do assertNotification mws' pluck -- Other team users should get a user.legalhold-enable event let pluck' = \case - UserLegalHoldEnabled' eUser -> eUser @?= member + Ev.UserLegalHoldEnabled eUser -> eUser @?= member _ -> assertBool "Unexpected event" False assertNotification ows pluck' -- We send to all members of a team. which includes the team-settings @@ -365,7 +365,7 @@ testDisableLegalHoldForUser = do requestLegalHoldDevice owner member tid !!! testResponse 201 Nothing approveLegalHoldDevice (Just defPassword) member member tid !!! testResponse 200 Nothing assertNotification mws $ \case - ClientAdded client -> do + Ev.ClientAdded _ client -> do clientId client @?= someClientId clientType client @?= LegalHoldClientType clientClass client @?= (Just LegalHoldClient) @@ -381,14 +381,14 @@ testDisableLegalHoldForUser = do assertEqual "method" "POST" (requestMethod req) assertEqual "path" (pathInfo req) ["legalhold", "remove"] assertNotification mws $ \case - ClientRemoved clientId' -> clientId' @?= someClientId + Ev.ClientEvent (Ev.ClientRemoved _ clientId') -> clientId clientId' @?= someClientId _ -> assertBool "Unexpected event" False assertNotification mws $ \case - UserLegalHoldDisabled' uid -> uid @?= member + Ev.UserEvent (Ev.UserLegalHoldDisabled uid) -> uid @?= member _ -> assertBool "Unexpected event" False -- Other users should also get the event assertNotification ows $ \case - UserLegalHoldDisabled' uid -> uid @?= member + Ev.UserLegalHoldDisabled uid -> uid @?= member _ -> assertBool "Unexpected event" False assertZeroLegalHoldDevices member @@ -1118,63 +1118,67 @@ publicKeyNotMatchingService = ---------------------------------------------------------------------- -- test helpers --- FUTUREWORK: Currently, the encoding of events is confusingly inside brig and not --- brig-types. (Look for toPushFormat in the code) We should refactor. To make --- our lives a bit easier we are going to copy these datatypes from brig verbatim -data UserEvent - = UserLegalHoldDisabled' !UserId - | UserLegalHoldEnabled' !UserId - | LegalHoldClientRequested LegalHoldClientRequestedData - deriving (Generic) - -data ClientEvent - = ClientAdded !Client - | ClientRemoved !ClientId - deriving (Generic) - -data LegalHoldClientRequestedData = LegalHoldClientRequestedData - { lhcTargetUser :: !UserId, - lhcLastPrekey :: !LastPrekey, - lhcClientId :: !ClientId - } - deriving stock (Show) - -instance FromJSON ClientEvent where - parseJSON = withObject' $ \o -> do - tag :: Text <- o .: "type" - case tag of - "user.client-add" -> ClientAdded <$> o .: "client" - "user.client-remove" -> ClientRemoved <$> (o .: "client" >>= Aeson.withObject "id" (.: "id")) - x -> fail $ "unspported event type: " ++ show x +deriving instance Show Ev.Event + +deriving instance Show Ev.UserEvent + +deriving instance Show Ev.ClientEvent + +deriving instance Show Ev.PropertyEvent + +deriving instance Show Ev.ConnectionEvent -instance FromJSON UserEvent where - parseJSON = withObject' $ \o -> do +-- (partial implementation, just good enough to make the tests work) +instance FromJSON Ev.Event where + parseJSON ev = flip (withObject "Ev.Event") ev $ \o -> do + typ :: Text <- o .: "type" + if + | typ `elem` ["user.legalhold-request", "user.legalhold-enable", "user.legalhold-disable"] -> Ev.UserEvent <$> Aeson.parseJSON ev + | typ `elem` ["user.client-add", "user.client-remove"] -> Ev.ClientEvent <$> Aeson.parseJSON ev + | otherwise -> fail $ "Ev.Event: unsupported event type: " <> show typ + +-- (partial implementation, just good enough to make the tests work) +instance FromJSON Ev.UserEvent where + parseJSON = withObject "Ev.UserEvent" $ \o -> do tag :: Text <- o .: "type" case tag of - "user.legalhold-enable" -> UserLegalHoldEnabled' <$> o .: "id" - "user.legalhold-disable" -> UserLegalHoldDisabled' <$> o .: "id" + "user.legalhold-enable" -> Ev.UserLegalHoldEnabled <$> o .: "id" + "user.legalhold-disable" -> Ev.UserLegalHoldDisabled <$> o .: "id" "user.legalhold-request" -> - LegalHoldClientRequested - <$> ( LegalHoldClientRequestedData + Ev.LegalHoldClientRequested + <$> ( Ev.LegalHoldClientRequestedData <$> o .: "id" -- this is the target user <*> o .: "last_prekey" - <*> (o .: "client" >>= Aeson.withObject "id" (.: "id")) + <*> (o .: "client" >>= withObject "id" (.: "id")) ) - x -> fail $ "unspported event type: " ++ show x - --- these are useful in other parts of the codebase. maybe move out? -type family NameOf (a :: *) :: Symbol where - NameOf a = NameOf' (Rep a a) - -type family NameOf' r :: Symbol where - NameOf' (M1 D ('MetaData name _module _package _newtype) _ _) = name + x -> fail $ "Ev.UserEvent: unsupported event type: " ++ show x -withObject' :: forall a. (KnownSymbol (NameOf a), Generic a) => (Aeson.Object -> Aeson.Parser a) -> Aeson.Value -> Aeson.Parser a -withObject' = Aeson.withObject (symbolVal @(NameOf a) Proxy) +-- (partial implementation, just good enough to make the tests work) +instance FromJSON Ev.ClientEvent where + parseJSON = withObject "Ev.ClientEvent" $ \o -> do + tag :: Text <- o .: "type" + case tag of + "user.client-add" -> Ev.ClientAdded fakeuid <$> o .: "client" + "user.client-remove" -> Ev.ClientRemoved fakeuid <$> (makeFakeClient <$> (o .: "client" >>= withObject "id" (.: "id"))) + x -> fail $ "Ev.ClientEvent: unsupported event type: " ++ show x + where + fakeuid = read @UserId "6980fb5e-ba64-11eb-a339-0b3625bf01be" + makeFakeClient cid = + Client + cid + PermanentClientType + (toUTCTimeMillis $ read "2021-05-23 09:39:15.937523809 UTC") + Nothing + Nothing + Nothing + Nothing + Nothing assertNotification :: (HasCallStack, FromJSON a, MonadIO m) => WS.WebSocket -> (a -> Assertion) -> m () assertNotification ws predicate = void . liftIO . WS.assertMatch (5 WS.# WS.Second) ws $ \notif -> do + unless ((NonEmpty.length . List1.toNonEmpty $ ntfPayload $ notif) == 1) $ + error $ "not suppored by test helper: event with more than one object in the payload: " <> cs (Aeson.encode notif) let j = Aeson.Object $ List1.head (ntfPayload notif) case Aeson.fromJSON j of Aeson.Success x -> predicate x