Integration tests: use static ports

integration/integration.cabal

@@ -119,13 +119,15 @@ library
     Testlib.JSON
     Testlib.ModService
     Testlib.Options
+    Testlib.Ports
     Testlib.Prekeys
     Testlib.Prelude
     Testlib.Printing
     Testlib.PTest
     Testlib.ResourcePool
     Testlib.Run
     Testlib.RunServices
+    Testlib.Service
     Testlib.Types
 
   build-depends:

integration/test/API/Cargohold.hs

@@ -122,11 +122,8 @@ buildMultipartBody header body bodyMimeType =
           MIME.mime_val_content = MIME.Single ((decodeUtf8 . LBS.toStrict) c)
         }
 
-downloadAsset :: (HasCallStack, MakesValue user, MakesValue assetDomain, MakesValue key) => user -> assetDomain -> key -> (HTTP.Request -> HTTP.Request) -> App Response
-downloadAsset user assetDomain key trans = downloadAsset' user assetDomain key "nginz-https.example.com" trans
-
-downloadAsset' :: (HasCallStack, MakesValue user, MakesValue key, MakesValue assetDomain) => user -> assetDomain -> key -> String -> (HTTP.Request -> HTTP.Request) -> App Response
-downloadAsset' user assetDomain key zHostHeader trans = do
+downloadAsset :: (HasCallStack, MakesValue user, MakesValue key, MakesValue assetDomain) => user -> assetDomain -> key -> String -> (HTTP.Request -> HTTP.Request) -> App Response
+downloadAsset user assetDomain key zHostHeader trans = do
   uid <- objId user
   domain <- objDomain assetDomain
   key' <- asString key

integration/test/API/GalleyInternal.hs

@@ -32,9 +32,9 @@ putTeamMember user team perms = do
       ]
       req
 
-getTeamFeature :: HasCallStack => String -> String -> App Response
-getTeamFeature featureName tid = do
-  req <- baseRequest OwnDomain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName]
+getTeamFeature :: (HasCallStack, MakesValue domain_) => domain_ -> String -> String -> App Response
+getTeamFeature domain_ featureName tid = do
+  req <- baseRequest domain_ Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName]
   submit "GET" $ req
 
 getFederationStatus ::

integration/test/SetupHelpers.hs

@@ -106,7 +106,7 @@ addFullSearchFor domains val =
 fullSearchWithAll :: ServiceOverrides
 fullSearchWithAll =
   def
-    { dbBrig = \val -> do
+    { brigCfg = \val -> do
         ownDomain <- asString =<< val %. "optSettings.setFederationDomain"
         env <- ask
         let remoteDomains = List.delete ownDomain $ [env.domain1, env.domain2] <> env.dynamicDomains
@@ -120,9 +120,9 @@ withFederatingBackendsAllowDynamic n k = do
           >=> removeField "optSettings.setFederationDomainConfigs"
           >=> setField "optSettings.setFederationDomainConfigsUpdateFreq" (Aeson.Number 1)
   startDynamicBackends
-    [ def {dbBrig = setFederationConfig},
-      def {dbBrig = setFederationConfig},
-      def {dbBrig = setFederationConfig}
+    [ def {brigCfg = setFederationConfig},
+      def {brigCfg = setFederationConfig},
+      def {brigCfg = setFederationConfig}
     ]
     $ \dynDomains -> do
       domains@[domainA, domainB, domainC] <- pure dynDomains

integration/test/Test/AssetDownload.hs

@@ -15,7 +15,7 @@ testDownloadAsset = do
     resp.status `shouldMatchInt` 201
     resp.json %. "key"
 
-  bindResponse (downloadAsset user user key id) $ \resp -> do
+  bindResponse (downloadAsset user user key "nginz-https.example.com" id) $ \resp -> do
     resp.status `shouldMatchInt` 200
     assertBool
       ("Expect 'Hello World!' as text asset content. Got: " ++ show resp.body)
@@ -27,37 +27,53 @@ testDownloadAssetMultiIngressS3DownloadUrl = do
 
   -- multi-ingress disabled
   key <- doUploadAsset user
-  checkAssetDownload user key
 
-  withModifiedService Cargohold modifyConfig $ \_ -> do
-    -- multi-ingress enabled
-    key' <- doUploadAsset user
-    checkAssetDownload user key'
-  where
-    checkAssetDownload :: HasCallStack => Value -> Value -> App ()
-    checkAssetDownload user key = withModifiedService Cargohold modifyConfig $ \_ -> do
-      bindResponse (downloadAsset user user key noRedirects) $ \resp -> do
-        resp.status `shouldMatchInt` 404
-      bindResponse (downloadAsset' user user key "red.example.com" noRedirects) $ \resp -> do
-        resp.status `shouldMatchInt` 302
-        locationHeaderHost resp `shouldMatch` "s3-download.red.example.com"
-      bindResponse (downloadAsset' user user key "green.example.com" noRedirects) $ \resp -> do
-        resp.status `shouldMatchInt` 302
-        locationHeaderHost resp `shouldMatch` "s3-download.green.example.com"
-      bindResponse (downloadAsset' user user key "unknown.example.com" noRedirects) $ \resp -> do
-        resp.status `shouldMatchInt` 404
-        resp.json %. "label" `shouldMatch` "not-found"
+  bindResponse (downloadAsset user user key "nginz-https.example.com" noRedirects) $ \resp -> do
+    resp.status `shouldMatchInt` 302
+
+  bindResponse (downloadAsset user user key "red.example.com" noRedirects) $ \resp -> do
+    resp.status `shouldMatchInt` 302
+
+  bindResponse (downloadAsset user user key "green.example.com" noRedirects) $ \resp -> do
+    resp.status `shouldMatchInt` 302
+
+  bindResponse (downloadAsset user user key "unknown.example.com" noRedirects) $ \resp -> do
+    resp.status `shouldMatchInt` 302
+
+  -- multi-ingress enabled
+  withModifiedBackend modifyConfig $ \domain -> do
+    user' <- randomUser domain def
+    key' <- doUploadAsset user'
 
+    bindResponse (downloadAsset user' user' key' "nginz-https.example.com" noRedirects) $ \resp -> do
+      resp.status `shouldMatchInt` 404
+      resp.json %. "label" `shouldMatch` "not-found"
+
+    bindResponse (downloadAsset user' user' key' "red.example.com" noRedirects) $ \resp -> do
+      resp.status `shouldMatchInt` 302
+      locationHeaderHost resp `shouldMatch` "s3-download.red.example.com"
+
+    bindResponse (downloadAsset user' user' key' "green.example.com" noRedirects) $ \resp -> do
+      resp.status `shouldMatchInt` 302
+      locationHeaderHost resp `shouldMatch` "s3-download.green.example.com"
+
+    bindResponse (downloadAsset user' user' key' "unknown.example.com" noRedirects) $ \resp -> do
+      resp.status `shouldMatchInt` 404
+      resp.json %. "label" `shouldMatch` "not-found"
+  where
     noRedirects :: HTTP.Request -> HTTP.Request
     noRedirects req = (req {redirectCount = 0})
 
-    modifyConfig :: Value -> App Value
+    modifyConfig :: ServiceOverrides
     modifyConfig =
-      setField "aws.multiIngress" $
-        object
-          [ "red.example.com" .= "http://s3-download.red.example.com",
-            "green.example.com" .= "http://s3-download.green.example.com"
-          ]
+      def
+        { cargoholdCfg =
+            setField "aws.multiIngress" $
+              object
+                [ "red.example.com" .= "http://s3-download.red.example.com",
+                  "green.example.com" .= "http://s3-download.green.example.com"
+                ]
+        }
 
     doUploadAsset :: HasCallStack => Value -> App Value
     doUploadAsset user = bindResponse (uploadAsset user) $ \resp -> do

integration/test/Test/Brig.hs

@@ -30,11 +30,13 @@ testCrudFederationRemotes :: HasCallStack => App ()
 testCrudFederationRemotes = do
   otherDomain <- asString OtherDomain
   let overrides =
-        ( setField
-            "optSettings.setFederationDomainConfigs"
-            [object ["domain" .= otherDomain, "search_policy" .= "full_search"]]
-        )
-  withModifiedService Brig overrides $ \_ -> do
+        def
+          { brigCfg =
+              setField
+                "optSettings.setFederationDomainConfigs"
+                [object ["domain" .= otherDomain, "search_policy" .= "full_search"]]
+          }
+  withModifiedBackend overrides $ \ownDomain -> do
     let parseFedConns :: HasCallStack => Response -> App [Value]
         parseFedConns resp =
           -- Pick out the list of federation domain configs
@@ -45,38 +47,38 @@ testCrudFederationRemotes = do
 
         addOnce :: (MakesValue fedConn, Ord fedConn2, ToJSON fedConn2, MakesValue fedConn2, HasCallStack) => fedConn -> [fedConn2] -> App ()
         addOnce fedConn want = do
-          bindResponse (Internal.createFedConn OwnDomain fedConn) $ \res -> do
+          bindResponse (Internal.createFedConn ownDomain fedConn) $ \res -> do
             addFailureContext ("res = " <> show res) $ res.status `shouldMatchInt` 200
-            res2 <- parseFedConns =<< Internal.readFedConns OwnDomain
+            res2 <- parseFedConns =<< Internal.readFedConns ownDomain
             sort res2 `shouldMatch` sort want
 
         addFail :: HasCallStack => MakesValue fedConn => fedConn -> App ()
         addFail fedConn = do
-          bindResponse (Internal.createFedConn' OwnDomain fedConn) $ \res -> do
+          bindResponse (Internal.createFedConn' ownDomain fedConn) $ \res -> do
             addFailureContext ("res = " <> show res) $ res.status `shouldMatchInt` 533
 
         deleteOnce :: (Ord fedConn, ToJSON fedConn, MakesValue fedConn) => String -> [fedConn] -> App ()
         deleteOnce domain want = do
-          bindResponse (Internal.deleteFedConn OwnDomain domain) $ \res -> do
+          bindResponse (Internal.deleteFedConn ownDomain domain) $ \res -> do
             addFailureContext ("res = " <> show res) $ res.status `shouldMatchInt` 200
-            res2 <- parseFedConns =<< Internal.readFedConns OwnDomain
+            res2 <- parseFedConns =<< Internal.readFedConns ownDomain
             sort res2 `shouldMatch` sort want
 
         deleteFail :: HasCallStack => String -> App ()
         deleteFail del = do
-          bindResponse (Internal.deleteFedConn' OwnDomain del) $ \res -> do
+          bindResponse (Internal.deleteFedConn' ownDomain del) $ \res -> do
             addFailureContext ("res = " <> show res) $ res.status `shouldMatchInt` 533
 
         updateOnce :: (MakesValue fedConn, Ord fedConn2, ToJSON fedConn2, MakesValue fedConn2, HasCallStack) => String -> fedConn -> [fedConn2] -> App ()
         updateOnce domain fedConn want = do
-          bindResponse (Internal.updateFedConn OwnDomain domain fedConn) $ \res -> do
+          bindResponse (Internal.updateFedConn ownDomain domain fedConn) $ \res -> do
             addFailureContext ("res = " <> show res) $ res.status `shouldMatchInt` 200
-            res2 <- parseFedConns =<< Internal.readFedConns OwnDomain
+            res2 <- parseFedConns =<< Internal.readFedConns ownDomain
             sort res2 `shouldMatch` sort want
 
         updateFail :: (MakesValue fedConn, HasCallStack) => String -> fedConn -> App ()
         updateFail domain fedConn = do
-          bindResponse (Internal.updateFedConn' OwnDomain domain fedConn) $ \res -> do
+          bindResponse (Internal.updateFedConn' ownDomain domain fedConn) $ \res -> do
             addFailureContext ("res = " <> show res) $ res.status `shouldMatchInt` 533
 
     dom1 :: String <- (<> ".example.com") . UUID.toString <$> liftIO UUID.nextRandom
@@ -93,8 +95,8 @@ testCrudFederationRemotes = do
     remote1J <- make remote1
     remote1J' <- make remote1'
 
-    resetFedConns OwnDomain
-    cfgRemotes <- parseFedConns =<< Internal.readFedConns OwnDomain
+    resetFedConns ownDomain
+    cfgRemotes <- parseFedConns =<< Internal.readFedConns ownDomain
     cfgRemotes `shouldMatch` [cfgRemotesExpect]
     -- entries present in the config file can be idempotently added if identical, but cannot be
     -- updated, deleted or updated.
@@ -185,7 +187,7 @@ testRemoteUserSearch = do
         setField "optSettings.setFederationStrategy" "allowDynamic"
           >=> removeField "optSettings.setFederationDomainConfigs"
           >=> setField "optSettings.setFederationDomainConfigsUpdateFreq" (Aeson.Number 1)
-  startDynamicBackends [def {dbBrig = overrides}, def {dbBrig = overrides}] $ \dynDomains -> do
+  startDynamicBackends [def {brigCfg = overrides}, def {brigCfg = overrides}] $ \dynDomains -> do
     domains@[d1, d2] <- pure dynDomains
     connectAllDomainsAndWaitToSync 1 domains
     [u1, u2] <- createAndConnectUsers [d1, d2]

integration/test/Test/Conversation.hs

@@ -18,7 +18,7 @@ import Testlib.Prelude
 testDynamicBackendsFullyConnectedWhenAllowAll :: HasCallStack => App ()
 testDynamicBackendsFullyConnectedWhenAllowAll = do
   let overrides =
-        def {dbBrig = setField "optSettings.setFederationStrategy" "allowAll"}
+        def {brigCfg = setField "optSettings.setFederationStrategy" "allowAll"}
           <> fullSearchWithAll
   startDynamicBackends [overrides, overrides, overrides] $ \dynDomains -> do
     [domainA, domainB, domainC] <- pure dynDomains
@@ -41,7 +41,7 @@ testDynamicBackendsNotFederating :: HasCallStack => App ()
 testDynamicBackendsNotFederating = do
   let overrides =
         def
-          { dbBrig =
+          { brigCfg =
               setField "optSettings.setFederationStrategy" "allowNone"
           }
   startDynamicBackends [overrides, overrides, overrides] $
@@ -62,9 +62,9 @@ testDynamicBackendsFullyConnectedWhenAllowDynamic = do
           >=> removeField "optSettings.setFederationDomainConfigs"
           >=> setField "optSettings.setFederationDomainConfigsUpdateFreq" (Aeson.Number 1)
   startDynamicBackends
-    [ def {dbBrig = overrides},
-      def {dbBrig = overrides},
-      def {dbBrig = overrides}
+    [ def {brigCfg = overrides},
+      def {brigCfg = overrides},
+      def {brigCfg = overrides}
     ]
     $ \dynDomains -> do
       domains@[domainA, domainB, domainC] <- pure dynDomains
@@ -86,7 +86,7 @@ testDynamicBackendsNotFullyConnected :: HasCallStack => App ()
 testDynamicBackendsNotFullyConnected = do
   let overrides =
         def
-          { dbBrig =
+          { brigCfg =
               setField "optSettings.setFederationStrategy" "allowDynamic"
                 >=> removeField "optSettings.setFederationDomainConfigs"
                 >=> setField "optSettings.setFederationDomainConfigsUpdateFreq" (Aeson.Number 1)
@@ -140,9 +140,9 @@ testCreateConversationFullyConnected = do
           >=> removeField "optSettings.setFederationDomainConfigs"
           >=> setField "optSettings.setFederationDomainConfigsUpdateFreq" (Aeson.Number 1)
   startDynamicBackends
-    [ def {dbBrig = setFederationConfig},
-      def {dbBrig = setFederationConfig},
-      def {dbBrig = setFederationConfig}
+    [ def {brigCfg = setFederationConfig},
+      def {brigCfg = setFederationConfig},
+      def {brigCfg = setFederationConfig}
     ]
     $ \dynDomains -> do
       domains@[domainA, domainB, domainC] <- pure dynDomains
@@ -158,9 +158,9 @@ testCreateConversationNonFullyConnected = do
           >=> removeField "optSettings.setFederationDomainConfigs"
           >=> setField "optSettings.setFederationDomainConfigsUpdateFreq" (Aeson.Number 1)
   startDynamicBackends
-    [ def {dbBrig = setFederationConfig},
-      def {dbBrig = setFederationConfig},
-      def {dbBrig = setFederationConfig}
+    [ def {brigCfg = setFederationConfig},
+      def {brigCfg = setFederationConfig},
+      def {brigCfg = setFederationConfig}
     ]
     $ \dynDomains -> do
       domains@[domainA, domainB, domainC] <- pure dynDomains
@@ -181,8 +181,8 @@ testDefederationGroupConversation = do
           >=> removeField "optSettings.setFederationDomainConfigs"
           >=> setField "optSettings.setFederationDomainConfigsUpdateFreq" (Aeson.Number 1)
   startDynamicBackends
-    [ def {dbBrig = setFederationConfig},
-      def {dbBrig = setFederationConfig}
+    [ def {brigCfg = setFederationConfig},
+      def {brigCfg = setFederationConfig}
     ]
     $ \dynDomains -> do
       domains@[domainA, domainB] <- pure dynDomains
@@ -247,8 +247,8 @@ testDefederationOneOnOne = do
           >=> removeField "optSettings.setFederationDomainConfigs"
           >=> setField "optSettings.setFederationDomainConfigsUpdateFreq" (Aeson.Number 1)
   startDynamicBackends
-    [ def {dbBrig = setFederationConfig},
-      def {dbBrig = setFederationConfig}
+    [ def {brigCfg = setFederationConfig},
+      def {brigCfg = setFederationConfig}
     ]
     $ \dynDomains -> do
       domains@[domainA, domainB] <- pure dynDomains
@@ -342,7 +342,7 @@ testAddMembersNonFullyConnectedProteus = do
 testConvWithUnreachableRemoteUsers :: HasCallStack => App ()
 testConvWithUnreachableRemoteUsers = do
   let overrides =
-        def {dbBrig = setField "optSettings.setFederationStrategy" "allowAll"}
+        def {brigCfg = setField "optSettings.setFederationStrategy" "allowAll"}
           <> fullSearchWithAll
   ([alice, alex, bob, charlie, dylan], domains) <-
     startDynamicBackends [overrides, overrides] $ \domains -> do
@@ -363,7 +363,7 @@ testConvWithUnreachableRemoteUsers = do
 testAddReachableWithUnreachableRemoteUsers :: HasCallStack => App ()
 testAddReachableWithUnreachableRemoteUsers = do
   let overrides =
-        def {dbBrig = setField "optSettings.setFederationStrategy" "allowAll"}
+        def {brigCfg = setField "optSettings.setFederationStrategy" "allowAll"}
           <> fullSearchWithAll
   ([alex, bob], conv, domains) <-
     startDynamicBackends [overrides, overrides] $ \domains -> do
@@ -389,7 +389,7 @@ testAddReachableWithUnreachableRemoteUsers = do
 testAddUnreachable :: HasCallStack => App ()
 testAddUnreachable = do
   let overrides =
-        def {dbBrig = setField "optSettings.setFederationStrategy" "allowAll"}
+        def {brigCfg = setField "optSettings.setFederationStrategy" "allowAll"}
           <> fullSearchWithAll
   ([alex, charlie], [charlieDomain, dylanDomain], conv) <-
     startDynamicBackends [overrides, overrides] $ \domains -> do
@@ -412,7 +412,7 @@ testAddingUserNonFullyConnectedFederation :: HasCallStack => App ()
 testAddingUserNonFullyConnectedFederation = do
   let overrides =
         def
-          { dbBrig =
+          { brigCfg =
               setField "optSettings.setFederationStrategy" "allowDynamic"
                 >=> removeField "optSettings.setFederationDomainConfigs"
           }

integration/test/Test/Defederation.hs

@@ -33,9 +33,9 @@ testDefederationNonFullyConnectedGraph = do
           >=> removeField "optSettings.setFederationDomainConfigs"
           >=> setField "optSettings.setFederationDomainConfigsUpdateFreq" (Aeson.Number 1)
   startDynamicBackends
-    [ def {dbBrig = setFederationConfig},
-      def {dbBrig = setFederationConfig},
-      def {dbBrig = setFederationConfig}
+    [ def {brigCfg = setFederationConfig},
+      def {brigCfg = setFederationConfig},
+      def {brigCfg = setFederationConfig}
     ]
     $ \dynDomains -> do
       domains@[domainA, domainB, domainC] <- pure dynDomains