From e819f42ff9a16e31c08f1b2cd55350157cead30b Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 22 May 2023 16:44:07 +0200 Subject: [PATCH] Use `Domain` type everywhere. --- integration/test/API/GalleyInternal.hs | 4 ++-- integration/test/Test/B2B.hs | 2 +- integration/test/Test/Brig.hs | 6 +++--- integration/test/Test/Demo.hs | 20 ++++++++++---------- integration/test/Testlib/App.hs | 9 +++++---- integration/test/Testlib/Cannon.hs | 4 ++-- integration/test/Testlib/ModService.hs | 3 +-- integration/test/Testlib/PTest.hs | 9 --------- 8 files changed, 24 insertions(+), 33 deletions(-) diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs index 56e811626a..62b265fa9c 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -9,7 +9,7 @@ putTeamMember user team perms = do tid <- asString team req <- baseRequest - ownDomain + OwnDomain Galley Unversioned ("/i/teams/" <> tid <> "/members") @@ -31,5 +31,5 @@ putTeamMember user team perms = do getTeamFeature :: HasCallStack => String -> String -> App Response getTeamFeature featureName tid = do - req <- baseRequest ownDomain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName] + req <- baseRequest OwnDomain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName] submit "GET" $ req diff --git a/integration/test/Test/B2B.hs b/integration/test/Test/B2B.hs index 48267add7e..ba9df150f5 100644 --- a/integration/test/Test/B2B.hs +++ b/integration/test/Test/B2B.hs @@ -6,5 +6,5 @@ import Testlib.Prelude testConnectUsers :: App () testConnectUsers = do - _alice <- randomUser ownDomain def + _alice <- randomUser OwnDomain def pure () diff --git a/integration/test/Test/Brig.hs b/integration/test/Test/Brig.hs index 61a39af82d..e74d0e9157 100644 --- a/integration/test/Test/Brig.hs +++ b/integration/test/Test/Brig.hs @@ -10,8 +10,8 @@ import Testlib.Prelude testSearchContactForExternalUsers :: HasCallStack => App () testSearchContactForExternalUsers = do - owner <- randomUser ownDomain def {Internal.team = True} - partner <- randomUser ownDomain def {Internal.team = True} + owner <- randomUser OwnDomain def {Internal.team = True} + partner <- randomUser OwnDomain def {Internal.team = True} bindResponse (Internal.putTeamMember partner (partner %. "team") (API.teamRole "partner")) $ \resp -> resp.status `shouldMatchInt` 200 @@ -21,7 +21,7 @@ testSearchContactForExternalUsers = do testCrudOAuthClient :: HasCallStack => App () testCrudOAuthClient = do - user <- randomUser ownDomain def + user <- randomUser OwnDomain def let appName = "foobar" let url = "https://example.com/callback.html" clientId <- bindResponse (Internal.registerOAuthClient user appName url) $ \resp -> do diff --git a/integration/test/Test/Demo.hs b/integration/test/Test/Demo.hs index 63d663c045..dbdc984f4a 100644 --- a/integration/test/Test/Demo.hs +++ b/integration/test/Test/Demo.hs @@ -10,7 +10,7 @@ import Testlib.Prelude -- | Legalhold clients cannot be deleted. testCantDeleteLHClient :: HasCallStack => App () testCantDeleteLHClient = do - user <- randomUser ownDomain def + user <- randomUser OwnDomain def client <- Public.addClient user def {Public.ctype = "legalhold", Public.internal = True} >>= getJSON 201 @@ -21,7 +21,7 @@ testCantDeleteLHClient = do -- | Deleting unknown clients should fail with 404. testDeleteUnknownClient :: HasCallStack => App () testDeleteUnknownClient = do - user <- randomUser ownDomain def + user <- randomUser OwnDomain def let fakeClientId = "deadbeefdeadbeef" bindResponse (Public.deleteClient user fakeClientId) $ \resp -> do resp.status `shouldMatchInt` 404 @@ -32,14 +32,14 @@ testModifiedBrig = do withModifiedService Brig (setField "optSettings.setFederationDomain" "overridden.example.com") - $ bindResponse (Public.getAPIVersion ownDomain) + $ bindResponse (Public.getAPIVersion OwnDomain) $ \resp -> do resp.status `shouldMatchInt` 200 (resp.json %. "domain") `shouldMatch` "overridden.example.com" testModifiedGalley :: HasCallStack => App () testModifiedGalley = do - (_user, tid) <- createTeam ownDomain + (_user, tid) <- createTeam OwnDomain let getFeatureStatus = do bindResponse (Internal.getTeamFeature "searchVisibility" tid) $ \res -> do @@ -57,7 +57,7 @@ testModifiedGalley = do testWebSockets :: HasCallStack => App () testWebSockets = do - user <- randomUser ownDomain def + user <- randomUser OwnDomain def withWebSocket user $ \ws -> do client <- Public.addClient user def >>= getJSON 201 n <- awaitMatch 3 (\n -> nPayload n %. "type" `isEqual` "user.client-add") ws @@ -65,11 +65,11 @@ testWebSockets = do testMultipleBackends :: App () testMultipleBackends = do - ownDomainRes <- (Public.getAPIVersion ownDomain >>= getJSON 200) %. "domain" - otherDomainRes <- (Public.getAPIVersion otherDomain >>= getJSON 200) %. "domain" - ownDomainRes `shouldMatch` ownDomain - otherDomainRes `shouldMatch` otherDomain - ownDomain `shouldNotMatch` otherDomain + ownDomainRes <- (Public.getAPIVersion OwnDomain >>= getJSON 200) %. "domain" + otherDomainRes <- (Public.getAPIVersion OtherDomain >>= getJSON 200) %. "domain" + ownDomainRes `shouldMatch` OwnDomain + otherDomainRes `shouldMatch` OtherDomain + OwnDomain `shouldNotMatch` OtherDomain testUnrace :: App () testUnrace = do diff --git a/integration/test/Testlib/App.hs b/integration/test/Testlib/App.hs index 01c8fb168c..e3dcbed544 100644 --- a/integration/test/Testlib/App.hs +++ b/integration/test/Testlib/App.hs @@ -4,6 +4,7 @@ import Control.Monad.Reader import qualified Control.Retry as Retry import Data.Aeson hiding ((.=)) import Data.IORef +import qualified Data.Text as T import qualified Data.Yaml as Yaml import GHC.Exception import System.FilePath @@ -46,11 +47,11 @@ readServiceConfig srv = do Left err -> failApp ("Error while parsing " <> cfgFile <> ": " <> Yaml.prettyPrintParseException err) Right value -> pure value -ownDomain :: App String -ownDomain = asks (.domain1) +data Domain = OwnDomain | OtherDomain -otherDomain :: App String -otherDomain = asks (.domain2) +instance MakesValue Domain where + make OwnDomain = asks (String . T.pack . (.domain1)) + make OtherDomain = asks (String . T.pack . (.domain2)) -- | Run an action, `recoverAll`ing with exponential backoff (min step 8ms, total timeout -- ~15s). Search this package for examples how to use it. diff --git a/integration/test/Testlib/Cannon.hs b/integration/test/Testlib/Cannon.hs index 85a33b14e1..78d19c0904 100644 --- a/integration/test/Testlib/Cannon.hs +++ b/integration/test/Testlib/Cannon.hs @@ -129,7 +129,7 @@ clientApp wsChan latch conn = do -- for the connection to register with Gundeck, and return the 'Async' thread. run :: HasCallStack => WSConnect -> WS.ClientApp () -> App (Async ()) run wsConnect app = do - domain <- ownDomain + domain <- asString OwnDomain serviceMap <- getServiceMap domain let HostPort caHost caPort = serviceHostPort serviceMap Cannon @@ -166,7 +166,7 @@ run wsConnect app = do let waitForRegistry :: HasCallStack => App () waitForRegistry = unrace $ do - request <- baseRequest ownDomain Cannon Unversioned ("/i/presences/" <> wsConnect.user <> "/" <> connId) + request <- baseRequest OwnDomain Cannon Unversioned ("/i/presences/" <> wsConnect.user <> "/" <> connId) response <- submit "HEAD" request status response `shouldMatchInt` 200 diff --git a/integration/test/Testlib/ModService.hs b/integration/test/Testlib/ModService.hs index 2acf740244..ed9fab6eae 100644 --- a/integration/test/Testlib/ModService.hs +++ b/integration/test/Testlib/ModService.hs @@ -130,13 +130,12 @@ withModifiedServices services k = do waitUntilServiceUp :: HasCallStack => Service -> App () waitUntilServiceUp srv = do - d <- ownDomain isUp <- retrying (limitRetriesByCumulativeDelay (4 * 1000 * 1000) (fibonacciBackoff (200 * 1000))) (\_ isUp -> pure (not isUp)) ( \_ -> do - req <- baseRequest d srv Unversioned "/i/status" + req <- baseRequest OwnDomain srv Unversioned "/i/status" env <- ask eith <- liftIO $ diff --git a/integration/test/Testlib/PTest.hs b/integration/test/Testlib/PTest.hs index 02b8084b33..d2613fa214 100644 --- a/integration/test/Testlib/PTest.hs +++ b/integration/test/Testlib/PTest.hs @@ -1,9 +1,6 @@ module Testlib.PTest where -import Data.Aeson (Value (..)) -import qualified Data.Text as T import Testlib.App -import Testlib.JSON import Testlib.Types import Prelude @@ -15,12 +12,6 @@ class HasTests x where instance HasTests (App ()) where mkTests m n s f x = [(m, n, s, f, x)] -data Domain = OwnDomain | OtherDomain - -instance MakesValue Domain where - make OwnDomain = String . T.pack <$> ownDomain - make OtherDomain = String . T.pack <$> otherDomain - instance HasTests x => HasTests (Domain -> x) where mkTests m n s f x = mkTests m (n <> "[domain=own]") s f (x OwnDomain)