[FS-266] Fix SFT URL fecthing based on plain HTTP via IPv4

changelog.d/6-federation/sft-fix-ipv4-http

@@ -0,0 +1 @@
+Allow making HTTP-only requests to SFTs via an IPv4 address

services/brig/brig.cabal

@@ -4,7 +4,7 @@ cabal-version: 2.0
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: addf4b080e564149f44c6cdb33c824734aa68cc9ff021f41268938902e2958b0
+-- hash: 2f8a3d719633015dac9204d43e0b4c79ce5b21b022cd9d4cce3868feea9460e8
 
 name:           brig
 version:        2.0
@@ -506,6 +506,7 @@ test-suite brig-tests
     , polysemy-wire-zoo
     , retry
     , servant-client-core
+    , string-conversions
     , tasty
     , tasty-hunit
     , tasty-quickcheck

services/brig/brig.integration.yaml

@@ -182,7 +182,7 @@ optSettings:
   # to be added to the CI environment
   setSftLookup:
     domain: sftd.integration-tests.zinfra.io
-    port: 443
+    port: 80
     isTestingEnvironment: true
 
 logLevel: Warn

services/brig/package.yaml

@@ -169,6 +169,7 @@ tests:
     - polysemy-wire-zoo
     - retry
     - servant-client-core
+    - string-conversions
     - tasty
     - tasty-hunit
     - tasty-quickcheck

services/brig/src/Brig/Calling.hs

@@ -140,7 +140,9 @@ discoverSFTServers domain =
 discoverSFTServersAll :: Members [DNSLookup, TinyLog] r => DNS.Domain -> Sem r (Maybe [IPv4])
 discoverSFTServersAll domain =
   lookupA domain >>= \case
-    AIPv4s ips -> pure . Just $ ips
+    AIPv4s ips -> do
+      info (Log.msg ("Found the following IP addresses for SFT servers" :: ByteString) . Log.field "addresses" (show ips))
+      pure . Just $ ips
     AResponseError e -> do
       err (Log.msg ("DNS Lookup failed for SFT Discovery" :: ByteString) . Log.field "Error" (show e))
       pure Nothing

services/brig/src/Brig/Effects/SFT.hs

@@ -44,7 +44,7 @@ interpretSFT httpManager = interpret $ \(SFTGetClientUrl ipAddr port) -> do
   let req =
         parseRequest_ $
           mconcat
-            [ "GET https://",
+            [ "GET http://",
               show ipAddr,
               ":",
               show . portNumber $ port,

services/brig/test/integration/API/Calling.hs

@@ -54,8 +54,10 @@ tests m b opts turn turnV2 = do
             test m "multiple servers /calls/config - 200" . withTurnFile turn $ testCallsConfigMultiple b,
             test m "multiple servers /calls/config/v2 - 200" . withTurnFile turnV2 $ testCallsConfigMultipleV2 b
           ],
-        testGroup "sft" $
+        testGroup
+          "sft"
           [ test m "SFT servers /calls/config/v2 - 200" $ testSFT b opts,
+            test m "SFT servers all /calls/config/v2 - 200" $ testSFTServersAll b opts,
             test m "SFT servers static URI - 200" $ testSFTStatic b opts
           ]
       ]
@@ -122,7 +124,23 @@ testSFT b opts = do
         "when SFT discovery is enabled, sft_servers should be returned"
         (Set.fromList [sftServer server1, sftServer server2])
         (Set.fromList $ maybe [] NonEmpty.toList $ cfg1 ^. rtcConfSftServers)
-      void . for (cfg1 ^. rtcConfSftServersAll) $ \allServers -> do
+
+testSFTServersAll :: Brig -> Opts.Opts -> Http ()
+testSFTServersAll b opts = do
+  uid <- userId <$> randomUser b
+  let lookupSettings = Opts.SFTLookup (Opts.LookupDomain "sftd.integration-tests.zinfra.io") (Port 80) True
+  let newOptSettings = (Opts.optSettings opts) {Opts.setSftLookup = Just lookupSettings}
+  let opts' =
+        opts
+          { Opts.sft = Just $ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001) Nothing,
+            Opts.optSettings = newOptSettings
+          }
+  withSettingsOverrides opts' $ do
+    cfg1 <- retryWhileN 10 (isNothing . view rtcConfSftServersAll) (getTurnConfigurationV2 uid b)
+    -- These values are controlled by https://github.com/zinfra/cailleach/blob/459591512a02333e62abebe28656874cab3b4380/environments/dns-integration-tests
+    liftIO $ case cfg1 ^. rtcConfSftServersAll of
+      Nothing -> assertFailure "sft_servers_all not configured"
+      Just allServers -> do
         let Right clientUrl = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft01.avs.zinfra.io")
         assertEqual
           "when SFT discovery is enabled and SFT lookup configured, sft_servers_all should be returned"

services/brig/test/unit/Test/Brig/Calling.hs

@@ -27,6 +27,7 @@ import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.Range
 import qualified Data.Set as Set
+import Data.String.Conversions
 import Imports
 import Network.DNS
 import Polysemy
@@ -264,7 +265,14 @@ testSFTDiscoverAWhenAvailable = do
     =<< ( runM . recordLogs logRecorder . runFakeDNSLookup fakeDNSEnv $
             discoverSFTServersAll "foo.example.com"
         )
-  assertEqual "nothing should be logged" []
+  assertEqual
+    "should report discovered IP addresses"
+    [ ( Log.Info,
+        "Found the following IP addresses for SFT servers, addresses="
+          <> (cs . show $ returnedEntries)
+          <> "\n"
+      )
+    ]
     =<< readIORef (recordedLogs logRecorder)
 
 testSFTDiscoverAWhenDNSFails :: IO ()